diff --git a/103/lib/ag/AnaDomain/AbsSyn.ag b/103/lib/ag/AnaDomain/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/AnaDomain/AbsSyn.ag @@ -0,0 +1,88 @@ +DATA TyAGItf + | AGItf relevTy : RelevTy + +DATA QualAGItf + | AGItf relevQual : RelevQual + +DATA CoeAGItf + | AGItf relevCoe : RelevCoe + +DATA AnaEval + -- variable, for propagation + | Var av : {UID} + + -- evaluated (Bot) + | WHNF + + -- unknown (Top) + | Lazy + + -- meet & join are explicitly encoded because of delayed or impossible simplification + | Meet opnds : AnaEvalL + | Join opnds : AnaEvalL + +TYPE AnaEvalL = [AnaEval] + +SET AllAna = AnaEval AnaEvalL + +DATA RelevCoe + -- no coercion + | Id + + -- err coercion + | Err str : String + + -- composition of coercion + | Comp l : RelevCoe + r : RelevCoe + + -- coercion for function + | Fun args : RelevCoeL + res : RelevCoe + + -- coercion going in the 'wrong' direction of lattice, delegating the corresponding 'cast' to the outside + | Cast coe : RelevCoe + + -- coercion casting between types + | CastTy l : RelevTy + r : RelevTy + + -- the real coercion, for each Ana lattice, may require substitutions later on + | Eval from : AnaEval + to : AnaEval + +TYPE RelevCoeL = [RelevCoe] + +SET AllCoe = RelevCoe RelevCoeL + +DATA RelevQual + -- less than or equal in AnaEval lattice + | SubEval l : AnaEval + r : AnaEval + +TYPE RelevQualL = [RelevQual] + +DATA RelevTy + -- no ty (for now) + | None + -- error ty (for now) + | Err str : String + + -- analysis info is base case of ty + | Ana eval : AnaEval + -- put others here + + -- function structure + | Fun quant : {RQuant} + quants : {[UID]} + quals : RelevQualL + args : RelevTyL + res : RelevTy + +TYPE RelevTyL = [RelevTy] +TYPE MbRelevTy = MAYBE RelevTy + +SET AllRelevTy = RelevTy RelevTyL MbRelevTy RelevQual RelevQualL + +SET AllNT = AllRelevTy AllAna AllCoe + diff --git a/103/lib/ag/Cmm/AbsSyn.ag b/103/lib/ag/Cmm/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Cmm/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/Core/AbsSyn.ag b/103/lib/ag/Core/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Core/AbsSyn.ag @@ -0,0 +1,237 @@ +DATA CodeAGItf + | AGItf module : CModule + +DATA CModule + | Mod moduleNm : {HsName} + imports : CImportL + declMetas : CDeclMetaL + expr : CExpr + -- ctagsMp : {CTagsMp} + +DATA CImport + | Import nm : {HsName} + +TYPE CImportL = [CImport] + +SET AllImport = CImportL CImport + +DATA CDeclMeta + | Data tyNm : {HsName} + dataCons : CDataConL + +TYPE CDeclMetaL = [CDeclMeta] + +SET AllDeclMeta = CDeclMeta CDeclMetaL + +-- Equivalent of data type def holding the minimal pieces of info required for codegen +DATA CDataCon + | Con conNm : {HsName} + tagNr : {Int} -- runtime tag + arity : {Int} -- nr of fields, excluding tag + +TYPE CDataConL = [CDataCon] + +SET AllDataCon = CDataCon CDataConL + +SET AllMetaNT = AllDeclMeta AllDataCon + +DATA CExpr + -- base cases + | Var ref : {ACoreBindRef} + | Int int : {Int} + | Char char : {Char} + | String str : {String} + | Integer integer : {Integer} + + -- node constructor, tuple or data constructor, determined by tag + | Tup tag : {CTag} + + -- let bindings + | Let categ : {CBindCateg} + binds : CBindL + body : CExpr + + -- application, abstraction + | App func : CExpr + arg : CBound + | Lam bind : CBind + body : CExpr + + -- case + | Case expr : CExpr + alts : CAltL + dflt : CExpr + | CaseAltFail failReason : CaseAltFailReason + errorExpr : CExpr + + -- extensible records (no longer supported, but you never know for now) + | TupDel expr : CExpr + tag : {CTag} + nm : {HsName} + offset : CExpr + | TupIns expr : CExpr + tag : {CTag} + nm : {HsName} + offset : CExpr + fldExpr : CExpr + | TupUpd expr : CExpr + tag : {CTag} + nm : {HsName} + offset : CExpr + fldExpr : CExpr + + -- FFI call + | FFI callconv : {FFIWay} + safety : {String} + impEnt : {ForeignEnt} + ty : {Ty} + + + +-- for debugging +DATA CExpr + | Dbg info : {String} + +DATA CExpr + -- coercion related + | Hole uid : {UID} + | HoleLet bindsUid : {UID} + body : CExpr + | CoeArg + | ImplsApp func : CExpr + uid : {ImplsVarId} + | ImplsLam uid : {ImplsVarId} + body : CExpr + +TYPE CMetas = (CMetaBind,CMetaVal) + +DATA CMetaBind + | Plain -- by default a binding is Plain + | Function0 -- special case of Plain, indicating it is a nullary function on top level (that is, the RHS is the computational part for a CAF) + | Function1 -- special case of Plain, indicating it is a non-nullary function on top level (that is, the RHS is a lambda) + | Apply0 -- special case of Plain, indicating it is an apply of a Function0 (intended to implement lazy behaviour for a CAF) + +DATA CMetaVal + | Val + | Dict + | DictClass tracks : {[Track]} + | DictInstance tracks : {[Track]} + | Track track : {Track} + +SET AllMetaVal = CMetaVal CMetas +SET AllMetaBind = CMetaBind CMetas +SET AllMeta = CMetaVal CMetaBind CMetas + +-- | on CExpr +DATA CExpr + | Ann ann : CExprAnn + expr : CExpr + +-- | ann for CExpr +DATA CExprAnn + | Ty ty : {Ty} + | Coe coe : {RelevCoe} + | Debug info : {String} + +-- | ann for name intro +DATA CBindAnn + | Coe coe : {RelevCoe} + +TYPE CBindAnnL = [CBindAnn] + +SET AllExprAnn = CExprAnn +SET AllBindAnn = CBindAnn CBindAnnL + +-- | The binder +DATA CBind + | Bind nm : {HsName} + bindAspects : CBoundL + +-- | That which is bound, of which may be multiple, of which exist the below varieties +DATA CBound + -- default: binding used when (1) no specialized version is available, (2) the one passed higher order + | Bind bindMeta : CMetas + expr : CExpr + + -- a (keyed) CMetas + | Meta aspectKeyS : {ACoreBindAspectKeyS} + cmetas : CMetas + + -- a (keyed) RelevTy + | RelevTy aspectKeyS : {ACoreBindAspectKeyS} + relevTy : {RelevTy} + + -- a (keyed) CExpr + | Val aspectKeyS : {ACoreBindAspectKeyS} + mlev : {MetaLev} + lbl : {CLbl} + expr : CExpr + + -- a (keyed) Ty, of the binding, (1) either the default for Bind, or (2, not yet used) for a Val with the same aspectKeyS + | Ty aspectKeyS : {ACoreBindAspectKeyS} + ty : {Ty} + + -- FFE binding (not yet implemented for all backends) + | FFE callconv : {FFIWay} + expEnt : {ForeignEnt} + expr : CExpr + ty : {Ty} + +TYPE CBindL = [CBind] +TYPE CBoundL = [CBound] + +SET AllBound = CBound CBoundL +SET AllBindOnly = CBind CBindL +SET AllBind = AllBindOnly AllBound + +DATA CAlt + | Alt pat : CPat + expr : CExpr + +TYPE CAltL = [CAlt] + +DATA CPat + | Var pnm : {HsName} + | Con tag : {CTag} + rest : CPatRest + binds : CPatFldL + | Int int : {Int} + | Char char : {Char} + +DATA CPatRest + | Var nm : {HsName} + | Empty + +DATA CPatFld + | Fld lbl : {HsName} + offset : CExpr + bind : CBind + fldAnns : CBindAnnL + +TYPE CPatFldL = [CPatFld] + +DATA CPat + | BoolExpr cexpr : {CExpr} + +SET AllAlt = CAlt CAltL +SET AllPat = CPatRest CPat AllPatFld +SET AllPatFld = CPatFld CPatFldL AllBindAnn + +SET AllCodeNT + = CModule AllExpr + +SET AllExprOnly + = CExpr -- MbCExpr + +SET AllExprBase + = AllExprOnly AllExprAnn AllBind AllAlt AllPat + +SET AllExpr + = AllExprBase + AllMeta + +SET AllNT + = AllCodeNT + AllMetaNT + AllImport + diff --git a/103/lib/ag/CoreRun/AbsSyn.ag b/103/lib/ag/CoreRun/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/CoreRun/AbsSyn.ag @@ -0,0 +1,82 @@ +DATA Mod + | Mod ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's + moduleNm : {HsName} + moduleNr : {Int} -- sequence nr, index later into global table of modules + stkDepth : {Int} -- max depth of stack for setting up globals + binds : {CRArray Bind} + body : Exp + +DATA SExp + -- base cases + | Var ref : {RRef} + | Int int : {Int} + | Char char : {Char} + | String str : {String} + | Integer integer : {Integer} + +DATA Exp + -- base cases + | SExp sexpr : SExp + + -- node constructor, tuple or data constructor, determined by tag + | Tup tag : {CTag} + args : {CRArray Exp} + + -- let bindings, recursiveness allowed, yes/no eval made explicit in rhs of binding + | Let lev : {Int} + firstOff : {Int} -- offset of first binding + ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's + binds : {CRArray Bind} + body : Exp + + -- application, abstraction + | App -- isTailRec : {Bool} + func : Exp + args : {CRArray Exp} + | Lam lev : {Int} -- lexical level + nrArgs : {Int} -- nr of arguments, 0 means it is a thunk + nrBinds : {Int} -- nr stack frame locations to be allocated (excluding arguments) for locals + stkDepth : {Int} -- max depth of stack + ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's + body : Exp + + -- thunking, forcing, partial applications + | Force expr : Exp + -- | Thunk expr : Exp -- expressed as parameterless Lam + + -- expr in a context to which must be returned (i.e. no tail rec) + | Ret expr : Exp + -- expr in a case alternative result context (with local bindings to be removed) + | RetCase nrBinds : {Int} + expr : Exp + -- Tail context + | Tail expr : Exp + + -- case + | Case expr : SExp + alts : {CRArray Alt} + + -- FFI call + | FFI prim : {RunPrim} + args : {CRArray Exp} +{- + | FFI callconv : {FFIWay} + impEnt : {ForeignEnt} + ty : {Ty} + args : {CRArray Exp} +-} + + -- Debug only + | Dbg msg : {String} + +DATA Alt + | Alt ref2nm : {Ref2Nm} -- inverse lookup of locally introduced binding RRef's + pat : Pat + expr : Exp + +DATA Pat + | Con tag : {CTag} + | BoolExpr expr : Exp + +SET AllNT + = Mod SExp Exp Alt Pat diff --git a/103/lib/ag/EH/AbsSyn.ag b/103/lib/ag/EH/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/EH/AbsSyn.ag @@ -0,0 +1,369 @@ +DATA AllNT + | * hsrange : Range + +DATA AGItf + | AGItf expr : Expr + +DATA Decl + | TySig nm : {HsName} + tyExpr : TyExpr + | Val patExpr : PatExpr + expr : Expr + +TYPE Decls = [Decl] + +SET AllDecl = Decl Decls + +DATA Decl + | Data isNewtype : {Bool} + tyNm : {HsName} + tyVars : TyVars + constrs : DataConstrs + mbGenerInfo : {Maybe Int} -- max kind arity for generic behavior, currently \in {0,1} + +DATA Decl + | KiSig nm : {HsName} + kiExpr : KiExpr + +DATA Decl + | FFI callconv : {FFIWay} + safety : {String} + impEnt : {ForeignEnt} + nm : {HsName} + tyExpr : TyExpr + +DATA Decl + | Type tyNm : {HsName} + tyExpr : TyExpr + +DATA Decl + | FFE nm : {HsName} + callconv : {FFIWay} + expEnt : {ForeignEnt} + expr : Expr + tyExpr : TyExpr + +DATA Decl + | GenerRep maxArity : {Int} -- max required unsaturated type arguments + tyNm : {HsName} -- type name + conNmL : {[HsName]} -- constructors + field names + recFldNmL : {[(HsName,[HsName])]} -- record constructors + field names + +DATA Decl + | FusionDecl fuseNm : {HsName} + -- with : {HsName} + | FusionConv conNm : {HsName} + absNm : {HsName} + +DATA TyExpr + | Con nm : {HsName} + | App func : TyExpr + arg : TyExpr + | AppTop tyExpr : TyExpr + | Parens tyExpr : TyExpr + | Ann ann : TyExprAnn + tyExpr : TyExpr + +DATA TyExpr + | Wild -- wildcard tyvar over which the TyExpr will not quantify, but later let binding will + | Mono -- same as Wild, but no quantification in the let binding either + +DATA TyExpr + | Var nm : {HsName} + +DATA TyExpr + | VarWild nm : {HsName} + +DATA TyExpr + | Quant qu : {TyQu} + tyVar : {HsName} + tyExpr : TyExpr + +DATA TyExpr + | Row rowTyExpr : RowTyExpr + +DATA TyExpr + | Pred prExpr : PrExpr + | Impls + | NoImpls + +DATA TyExpr + | Lam tyVar : {HsName} + tyExpr : TyExpr + +TYPE TyExprs = [TyExpr] + +DATA TyVar + | Var nm : {HsName} + +TYPE TyVars = [TyVar] + +SET AllTyVar = TyVar TyVars + +TYPE MbTyExpr = MAYBE TyExpr + +SET AllTyExpr + = TyExpr + -- TyExprAnn + TyExprs + RowTyExpr + PrExpr PrExprs + MbTyExpr + +DATA DataFieldExpr + | Upd dataFieldExpr : DataFieldExpr + nm : {HsName} + expr : Expr + | Con nm : {HsName} + | Expr expr : Expr + +DATA DataFieldPatExpr + | Ext dataFieldPatExpr: DataFieldPatExpr + nm : {HsName} + patExpr : PatExpr + | Con nm : {HsName} + +DATA RecExpr + | Empty + | Ext recExpr : RecExpr + mbNm : {Maybe HsName} + expr : Expr + | Upd recExpr : RecExpr + nm : {HsName} + expr : Expr + | Expr expr : Expr + +DATA RecPatExpr + | Empty + | Ext recPatExpr : RecPatExpr + mbNm : {Maybe HsName} + patExpr : PatExpr + | Expr patExpr : PatExpr + +DATA RowTyExpr + | Empty + | Ext rowTyExpr : RowTyExpr + mbNm : {Maybe HsName} + tyExpr : TyExpr + +DATA RowTyExpr + | Var nm : {HsName} + +DATA PrExpr + | Class nm : {HsName} + tyExprs : TyExprs + | Arrow arg : PrExpr + res : PrExpr + | Forall tyVar : {HsName} + prExpr : PrExpr + +TYPE PrExprs = [PrExpr] + +DATA PrExpr + | Lacks rowTyExpr : RowTyExpr + nm : {HsName} + | DynVar nm : {HsName} + tyExpr : TyExpr + +DATA PrExpr + | Eq tyExpr1 : TyExpr + tyExpr2 : TyExpr + +SET AllPrExpr = PrExpr PrExprs + +DATA KiExpr + | Con nm : {HsName} + | Var nm : {HsName} + | App func : KiExpr + arg : KiExpr + | AppTop kiExpr : KiExpr + | Parens kiExpr : KiExpr + | Ann ann : KiExprAnn + kiExpr : KiExpr + +SET AllKiExpr + = KiExpr + -- KiExprAnn + +DATA Expr + | IConst int : {Int} + | CConst char : {Char} + | Con nm : {HsName} + | Var nm : {HsName} + | App func : Expr + arg : Expr + | Let isStrict : {Bool} + decls : Decls + body : Expr + | Lam arg : PatExpr + body : Expr + | AppTop expr : Expr + | Parens expr : Expr + | TypeAs isScoped : {Bool} -- ^ Are the type vars in 'tyExpr' to be lexically scoped? Used for: f a :: t = e, rewritten to \a -> (e :: t) + tyExpr : TyExpr + expr : Expr + | Ann ann : ExprAnn + expr : Expr + +DATA Expr + | AppImpred func : Expr + arg : Expr + +DATA Expr + | SConst str : {String} + | Case expr : Expr + alts : CaseAlts + mbCaseIds : {Maybe UIDS} + caseFailS : {UIDS} -- can fail on these fail ids, encodes that this case implements a guard + isTupOfArg : {Bool} -- tupling, only done as uncurry of arguments of lambda + +DATA Expr + | DataFields dataFieldExpr : DataFieldExpr + | Rec recExpr : RecExpr + | Sel expr : Expr + lbl : {HsName} + +DATA Expr + | Undefined + | CaseAltFail caseId : {UID} + +DATA Expr + | AppImpl func : Expr + argPr : PrExpr + arg : Expr + | LamImpl argPr : PrExpr + arg : PatExpr + body : Expr + +DATA Expr + | DynVar nm : {HsName} + +DATA Expr + | IIConst integer : {Integer} + +SET AllExpr + = Expr + -- ExprAnn + RecExpr DataFieldExpr + +DATA PatExpr + | IConst int : {Int} + | CConst char : {Char} + | Con nm : {HsName} + | Var nm : {HsName} + | VarAs nm : {HsName} + patExpr : PatExpr + | App func : PatExpr + arg : PatExpr + | AppTop patExpr : PatExpr + | Parens patExpr : PatExpr + | Ann ann : PatExprAnn + patExpr : PatExpr + +DATA PatExpr + | TypeAs tyExpr : TyExpr + patExpr : PatExpr + +DATA PatExpr + | SConst str : {String} + +DATA PatExpr + | Rec recPatExpr : RecPatExpr + | DataFields dataFieldPatExpr: DataFieldPatExpr + +DATA PatExpr + | Irrefutable patExpr : PatExpr + | Bang patExpr : PatExpr + +DATA PatExpr + | Expr expr : Expr + mbConst : {Maybe SrcConst} + +SET AllPatExpr + = PatExpr + -- PatExprAnn + RecPatExpr DataFieldPatExpr + +DATA CaseAlt + | Pat patExpr : PatExpr + expr : Expr + +TYPE CaseAlts = [CaseAlt] + +SET AllCase = CaseAlt CaseAlts + +DATA DataConstr + | Constr conNm : {HsName} + mbFixityPrio : {Maybe (Int,Fixity)} -- Nothing: not infix + fields : DataFields + mbGadtTyExpr : MbTyExpr -- the constrained result ty for GADT + +TYPE DataConstrs = [DataConstr] + +DATA DataField + | Field mbLabels : {Maybe [HsName]} + tyExpr : TyExpr + +TYPE DataFields = [DataField] + +SET AllDataConstr = DataConstr DataConstrs + +SET AllDataField = DataField DataFields + +SET AllData + = AllDataConstr + AllDataField + +DATA Decl + | Class tyPrExpr : TyExpr + funcDeps : FuncDeps + mbDefaultInstNm : {Maybe HsName} + decls : Decls + generDerivs : {[(HsName,HsName)]} -- generically derivable fields, with their default + | Instance mbNmElim : {Maybe (HsName,Bool)} + instVariant : InstVariant + tyPrExpr : TyExpr + decls : Decls + | InstanceIntro mbNmElim : {Maybe (HsName)} + expr : Expr + prExpr : PrExpr + | Default nm : HsName + tyExprs : TyExprs + +DATA FuncDep + | Dep fromTvs : TyVars + toTvs : TyVars + +TYPE FuncDeps = [FuncDep] + +SET AllFuncDep = FuncDep FuncDeps + +DATA ExprAnn + | Empty + +DATA TyExprAnn + | Empty + | Strictness strictness : Strictness + +DATA PatExprAnn + | Empty + +DATA KiExprAnn + | Empty + +SET AllAnn + = ExprAnn TyExprAnn PatExprAnn + KiExprAnn + +SET AllNT + = AllTyExpr AllDecl AllPatExpr AllExpr + AllData AllCase AllTyVar + AllKiExpr + AllFuncDep + +SET NTCode + = AllDecl AllExpr AllCase AllPatExpr + +SET NTPrf + = NTCode AllData + diff --git a/103/lib/ag/Error/AbsSyn.ag b/103/lib/ag/Error/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Error/AbsSyn.ag @@ -0,0 +1,150 @@ +DATA Err + | * range : Range + +DATA Err + | PP pp : {PP_Doc} + | Str str : {String} + +DATA Err + | UnifyClash ty1 : {Ty} + ty2 : {Ty} + fiMode : {FIMode} + ty1detail : {Ty} + ty2detail : {Ty} + fiModeD : {FIMode} + +DATA Err + | NamesNotIntrod kind : String + nmL : {[ThingAndRange PP_Doc]} + +DATA Err + | PatArity ty : {Ty} + arity : {Int} + +DATA Err + | PatArity2 kind : String + what : {PP_Doc} + arity : {Int} + +DATA Err + | NamesDupIntrod kind : String + nmL : {[ThingAndRange HsName]} + | NestedIn wher : {PP_Doc} + errL : ErrL + +TYPE ErrL = [Err] + +DATA Err + | Fixity op1 : {PP_Doc} + op2 : {PP_Doc} + +DATA Err + | UnifyOccurs ty1 : {Ty} + ty2 : {Ty} + fiMode : {FIMode} + tvar : {TyVarId} + ty2detail : {Ty} + fiModeD : {FIMode} + | OccurCycle tvar : {TyVarId} + ty : {Ty} + +DATA Err + | Newtype tyNm : {HsName} + | FunPatternLengths funNm : {HsName} + +DATA Err + | MissingRowLabels nmL : {[HsName]} + ty : {Ty} + | TooManyRowLabels nmL : {[HsName]} + ty : {Ty} + +DATA Err + | InconsistentIntros kind : String + nmL : {[HsName]} + | MissingDataFields nmL : {[HsName]} + con : {HsName} + | MissingAnyDataField nmL : {[HsName]} + tyNm : {HsName} + | DuplicateDataFields nmL : {[HsName]} + +DATA Err + | FileNotFound fileName : {String} + locations : {[String]} + suffixes : {[FileSuffix]} + | AmbiguousExport name : {HsName} + entities : {[ThingAndRange HsName]} + +DATA Err + | IllegalFFIWay ffiWay : {FFIWay} + | TyCoreMatchClash ty1 : {PP_Doc} + ty2 : {PP_Doc} + ty1detail : {Maybe PP_Doc} + ty2detail : {Maybe PP_Doc} + | TyCoreSeqLevels hereLev : {Int} + mustLev : {Int} + ty : {PP_Doc} + | NoCoerceDerivation ty1 : {Ty} + ty2 : {Ty} + fiMode : {FIMode} + func : {Ty} + arg : {Ty} + +DATA Err + | PrfCutOffReached pred : {PredOcc} + depth : {Int} + | NotProvenPreds preds : {[((Pred,[Range]),PP_Doc)]} + | AmbigPreds preds : {[(Pred,[Range])]} + inQBinds : {AssocL HsName PP_Doc} -- quantified + inBinds : {AssocL HsName PP_Doc} -- unquantified + | OverlapPreds overl : {AssocL Pred [PP_Doc]} + | TyHasFreeTVars ty : {Ty} + | DeclsNotAllowed inside : String + decls : {AssocL IdOccKind [HsName]} + | ValWithoutSig nmL : {[HsName]} + | NoMostSpecificPred pred1 : {Pred} + pred2 : {Pred} + | EvidenceAltsLeft + +DATA Err + | MalformedPred pp : {PP_Doc} + +DATA Err + | TyBetaRedLimit ty : {Ty} + tyTo : {Ty} + limit : {Int} + +DATA Err + | MayOnlyHaveNrMain nrAllowed : Int -- 0 or 1, depending on option ehcOptDoExecLinking + prevModNmL : {[HsName]} -- possible previous modules in which main was defined + modNm : HsName + | MayNotHaveMain modNm : HsName + | MustHaveMain + | ModNameMismatch nmOfFile : HsName + nmFromSrc : HsName + | AmbiguousNameRef kindName : {String} + kind : {String} + nm : HsName + nmAlts : {[HsName]} + | MutRecModules mutRecL : {[[HsName]]} + +DATA Err + | MalformedTy kind : String + purpose : String + ty : Ty + | NoDerivFor pred : PP_Doc + | NoDerivForData ty : Ty + clNm : HsName + reason : String + +DATA Err + | FusionBuildInverse ty1 : {Ty} + ty2 : {Ty} + +DATA Err + | InconsistentHI modNm : String + file : String + expected : {[String]} + inHI : {[String]} + | WrongMagic modNm : String + file : String + diff --git a/103/lib/ag/Foreign/AbsSyn.ag b/103/lib/ag/Foreign/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Foreign/AbsSyn.ag @@ -0,0 +1,66 @@ +DATA ForeignAGItf + | AGItf ent : ForeignEnt + +DATA ForeignExprAGItf + | AGItf expr : ForeignExpr + +DATA ForeignEnt + | CCall ent : CCall + | PlainCall ent : PlainCall + | PrimCall ent : PrimCall + | JavaScriptCall ent : JavaScriptCall + +DATA CCall + | Id isStatic : Bool + mbInclude : {Maybe String} + asPointer : Bool + nm : String + | Dynamic + | Wrapper + +DATA PrimCall + | Id nm : String + mbKnownPrim : {Maybe KnownPrim} + +DATA JavaScriptCall + | Id -- argument which acts as receiver object (if any), starting at 1, e.g. for arg 1: + -- "%1.g", f x y ~> to x.g(y) + -- mbThisArgNr : {Maybe Int} + nm : String + + -- args which is used as index, e.g. for arg 1: + -- "g[%1]" , f x y ~> g[x](y) + -- "&%1.g[%2]", f x y ~> x.g[y] + -- mbIndexArgNr : {Maybe Int} + mbInclude : {Maybe String} + mbForeignExpr : {Maybe ForeignExpr} + | Dynamic + | Wrapper + +DATA PlainCall + | Id nm : String + +DATA ForeignExpr + | Call expr : ForeignExpr -- actual call, pasting in remaining arguments + | CallArgs expr : ForeignExpr -- actual call, explicit use of arguments + args : ForeignExprs + | Ptr expr : ForeignExpr -- as pointer, or as value, not calling anything + | Sel expr : ForeignExpr -- select + sel : ForeignExpr + | Inx expr : ForeignExpr -- index + inx : ForeignExpr + | Ent -- the named entity in the FFI spec + | EntNm nm : String -- explicitly named entity, overriding Ent + | Arg nr : Int -- an explicitly named arg, which will then not be passed as remaining arg + | AllArg -- all (remaining) args + | Empty -- nothing + | Str str : String -- string constant + | ObjData -- data export for JS objects + | NewObj expr : ForeignExpr + +TYPE ForeignExprs = [ForeignExpr] + +SET AllForeignExpr = ForeignExpr ForeignExprs + +SET AllForeign = ForeignEnt CCall PlainCall PrimCall JavaScriptCall + diff --git a/103/lib/ag/GrinByteCode/AbsSyn.ag b/103/lib/ag/GrinByteCode/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/GrinByteCode/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/GrinCode/AbsSyn.ag b/103/lib/ag/GrinCode/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/GrinCode/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/HS/AbsSyn.ag b/103/lib/ag/HS/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/HS/AbsSyn.ag @@ -0,0 +1,1068 @@ +-- Atze Dijkstra, 20051123: adapted to shuffle format, for stepwise use, extended to cater for EH extensions +-- Andres Loeh, May 21, 2002 + +-- Read using a monospaced font! + +-- At some places we still have to look at, +-- a "-- ToDo:" comment is inserted + +DATA AGItf + | AGItf + module : Module + +DATA Module + | Module + range : Range + name : MaybeName + fileheaderpragmas : Pragmas + exports : MaybeExports + body : Body + +TYPE Exports = [ Export ] + +TYPE MaybeExports = MAYBE Exports + +DATA Export + | Variable + range : Range + name : Name + | TypeOrClass + range : Range + name : Name + names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete + range : Range + name : Name + | Module + range : Range + name : Name -- this is a module name + +-- Since the parser cannot distinguish between types or constructors, +-- or between types and type classes, we do not have different cases (yet?). + +DATA Body + | Body + range : Range + importdeclarations : ImportDeclarations + declarations : Declarations + +TYPE ImportDeclarations = [ ImportDeclaration ] + +DATA ImportDeclaration + | Import + range : Range + qualified : Bool + name : Name + asname : MaybeName + importspecification : MaybeImportSpecification + | Empty + range : Range + +SET AllImportDeclaration + = ImportDeclaration ImportDeclarations + +TYPE MaybeImportSpecification = MAYBE ImportSpecification + +DATA ImportSpecification + | Import + range : Range + hiding : Bool + imports : Imports + +SET AllImportSpecification + = ImportSpecification MaybeImportSpecification + +TYPE Imports = [ Import ] + +DATA Import + | Variable + range : Range + name : Name + | TypeOrClass + range : Range + name : Name + names : MaybeNames -- constructors or field names or class methods + | TypeOrClassComplete + range : Range + name : Name + +-- cf. Export + +SET AllTopLevel + = Module Body + +SET AllModule + = AllTopLevel + AllImportDeclaration Import Imports + AllImportSpecification + Export Exports MaybeExports + +SET AllModuleDeclaration + = AllModule AllDeclaration + + +TYPE MaybeDeclarations = MAYBE Declarations + +TYPE Declarations = [ Declaration ] + +DATA Declaration {- *** -} + | FunctionBindings {- *** -} + range : Range + bindings : FunctionBindings -- should all be for the same function + | PatternBinding + range : Range + pattern : Pattern + righthandside : RightHandSide + | TypeSignature + range : Range + names : Names + type : Type -- may have context + | Fixity + range : Range + fixity : Fixity + priority : {Maybe Int} + operators : Names + -- A fusion declaration 'fuse f' triggers fusion behavior (inlining, elimination of build/unbuild pairs) for the body of 'f' + | FusionDeclaration + range : Range + fusename : Name + -- with : Name + -- A fusion conversion declaration 'convert g,h' marks this combi to be a build/unbuild pair, to be eliminated by fusion (of 'f' above). + -- Checked type constraint: g :: a->b, h :: b->a, i.e. they should be eachothers inverse. + | FusionConversion + range : Range + absname : Name + conname : Name + | Empty + range : Range + | Data {- *** -} + range : Range + context : ContextItems + typelefthandside : TypeLeftHandSide + constructors : Constructors + derivings : Derivings + | Newtype + range : Range + context : ContextItems + typelefthandside : TypeLeftHandSide + constructors : Constructor -- has only one field, no strictness + derivings : Derivings + | GADT + range : Range + context : ContextItems + typelefthandside : TypeLeftHandSide + constructors : Constructors + derivings : Derivings + | KindSignature + range : Range + names : Names + kind : Kind + | ForeignImport + range : Range + callconvention : FFIWay + safety : {Maybe String} + importname : {Maybe String} + name : Name + type : Type + | ForeignExport + range : Range + callconvention : FFIWay + exportname : {Maybe String} + name : Name + type : Type + | Class + range : Range + context : ContextItems -- is a "simple" context + typelefthandside : TypeLeftHandSide + -- simpletype : SimpleType + dependencies : FunctionalDependencies + where : MaybeDeclarations -- cannot have everything + | Instance + range : Range + instVariant : InstVariant + maybeinstancename : MaybeName + useimplicitly : Bool + context : ContextItems -- is a "simple" context + -- name : Name + -- types : Types + type : Type + where : MaybeDeclarations -- cannot have everything + | InstanceUseImplicitly + range : Range + expression : Expression + name : Name + types : Types + | Default + range : Range + name : MaybeName + types : Types -- should be instances of Num + | Type + range : Range + typelefthandside : TypeLeftHandSide + -- simpletype : SimpleType + type : Type + | Pragma + range : Range + pragma : Pragma + | Module + range : Range + name : MaybeName + exports : MaybeExports + +TYPE FunctionalDependencies = [ FunctionalDependency ] + +DATA FunctionalDependency + | Dependency + range : Range + fromtypevariables : Names + totypevariables : Names + +TYPE Derivings = [ Deriving ] + +DATA Deriving + | Deriving + range : Range + maybeinstancename : MaybeName + useimplicitly : Bool + name : Name + +SET AllDeriving + = Deriving Derivings + +SET AllDeclarationPlain + = Declaration Declarations MaybeDeclarations + +SET AllDeclaration + = AllDeclarationPlain + FunctionalDependency FunctionalDependencies + AllDeriving + +TYPE Pragmas = [ Pragma ] + +DATA Pragma + | Language + range : Range + pragmas : Names + | OptionsUHC + range : Range + options : {String} + | Derivable + range : Range + className : Name + fieldName : Name + defaultName : Name + | ExcludeIfTarget + range : Range + targetNames : {[String]} + +SET AllPragma + = Pragma Pragmas + +TYPE Kinds = [ Kind ] + +DATA Kind {- *** -} + | NormalApplication {- *** -} + range : Range + function : Kind + arguments : Kinds + | InfixApplication {- *** -} + range : Range + leftKind : Kind + operator : Kind + rightKind : Kind + | Constructor {- *** -} + range : Range + name : Name + | Parenthesized + range : Range + kind : Kind + | Variable {- *** -} + range : Range + name : Name + | Forall + range : Range + kindvariables : Names + kind : Kind + | Annotate + range : Range + annotation : KindAnnotation + kind : Kind + +SET AllKind + = Kind Kinds + KindAnnotation + +TYPE Types = [ Type ] + +TYPE MaybeType = MAYBE Type + +DATA Type {- *** -} + | NormalApplication {- *** -} + range : Range + function : Type + arguments : Types + | InfixApplication {- *** -} + range : Range + leftType : Type + operator : Type + rightType : Type + | InfixApplicationChainTop + range : Range + type : Type + | Constructor {- *** -} + range : Range + name : Name + | Parenthesized + range : Range + type : Type + | SectionApplication + range : Range + leftType : MaybeType + operator : Type + rightType : MaybeType + | Annotate + range : Range + annotation : TypeAnnotation + type : Type + | Wildcard + range : Range + | MonoWildcard + range : Range + | Variable {- *** -} + range : Range + name : Name + | NamedWildcard + range : Range + name : Name + | Forall + range : Range + typevariables : Names + type : Type + | Exists + range : Range + typevariables : Names + type : Type + | RowUpdate + range : Range + type : Type + rowTypeUpdates : RowTypeUpdates + | RowEmpty + range : Range + | RowRecUpdate + range : Range + type : Type + rowTypeUpdates : RowTypeUpdates + | RowRecEmpty + range : Range + | RowSumUpdate + range : Range + type : Type + rowTypeUpdates : RowTypeUpdates + | RowSumEmpty + range : Range + | Qualified + range : Range + context : ContextItems + type : Type + | TupleConstructor {- *** -} + range : Range + arity : Int + +TYPE ContextItems = [ ContextItem ] + +DATA ContextItem + | Class + range : Range + name : Name -- that is the class + types : Types -- in Haskell 98, this is only one type + | Forall + range : Range + typevariables : Names + context : ContextItem + | Arrow + range : Range + argument : ContextItem + result : ContextItem + | Implicits + range : Range + | NoImplicits + range : Range + | RowLacksLabel + range : Range + rowvariable : Name + name : Name + | Equal + range : Range + type1 : Type + type2 : Type + +SET AllContextItem + = ContextItem ContextItems + +TYPE Constructors = [ Constructor ] + +DATA Constructor + | Constructor + range : Range + constructor : Name + types : Types + | Infix + range : Range + leftType : Type + constructorOperator : Name + rightType : Type + | Record + range : Range + constructor : Name + fieldDeclarations : FieldDeclarations + | Contexted + range : Range + context : ContextItems + constructor : Constructor + | GADTFunction + range : Range + constructor : Name + type : Type + +SET AllConstructor + = Constructor Constructors + +TYPE FieldDeclarations = [ FieldDeclaration ] + +DATA FieldDeclaration + | FieldDeclaration + range : Range + names : Names + type : Type + +SET AllFieldDeclaration + = FieldDeclaration FieldDeclarations + +SET AllType + = Type Types MaybeType + TypeAnnotation + + AllConstructor + TypeLeftHandSide + AllFieldDeclaration + AllRowTypeUpdate + AllContextItem + +TYPE Expressions = [ Expression ] + +TYPE MaybeExpression = MAYBE Expression + +DATA Expression {- *** -} + | Literal {- *** -} + range : Range + literal : Literal + | Variable {- *** -} + range : Range + name : Name + | Constructor {- *** -} + range : Range + name : Name + | TupleConstructor {- *** -} + range : Range + arity : Int + | Parenthesized + range : Range + expression : Expression + | NormalApplication {- *** -} + range : Range + function : Expression + arguments : Expressions + | SectionApplication + range : Range + leftExpression : MaybeExpression + operator : Expression + rightExpression : MaybeExpression + | InfixApplication + range : Range + leftExpression : Expression + operator : Expression + rightExpression : Expression + | InfixApplicationChainTop + range : Range + expression : Expression + | Lambda {- *** -} + range : Range + patterns : Patterns + expression : Expression + | Let {- *** -} + range : Range + isStrict : Bool + declarations : Declarations + expression : Expression + | Tuple + range : Range + expressions : Expressions + | Typed + range : Range + expression : Expression + type : Type + | Negate + range : Range + expression : Expression + | Annotate + range : Range + annotation : ExpressionAnnotation + expression : Expression + | ImpredicativeApplication {- *** -} + range : Range + function : Expression + arguments : Expressions + | If + range : Range + guardExpression : Expression + thenExpression : Expression + elseExpression : Expression + | Case {- *** -} + range : Range + expression : Expression + alternatives : Alternatives + | List + range : Range + expressions : Expressions + | Enum + range : Range + from : Expression + then : MaybeExpression + to : MaybeExpression + | Comprehension + range : Range + expression : Expression + qualifiers : Qualifiers + | RecordConstruction + range : Range + name : Name + recordExpressionBindings : RecordExpressionBindings + | RecordUpdate + range : Range + expression : Expression + recordExpressionBindings : RecordExpressionBindings + | RowRecordUpdate + range : Range + expression : Expression + rowRecordExpressionUpdates + : RowRecordExpressionUpdates + | RowRecordEmpty + range : Range + | RowRecordSelect + range : Range + expression : Expression + name : Name + | Do + range : Range + statements : Statements + | ImplicitApplication + range : Range + function : Expression + arguments : ContextedExpressions + | ImplicitLambda + range : Range + patterns : ContextedPatterns + expression : Expression + +-- Representation examples (ranges are skipped): +-- +-- o "(+) 2 3" as +-- +-- Expression_NormalApplication +-- (Expression_SectionApplication +-- Nothing (Name_Operator [] "+") Nothing) +-- [Expression_Literal (Literal_Int "2") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- ToDo: Now that we distinguish operators from identifiers, is +-- there a good reason not to say +-- +-- Expression_NormalApplication +-- (Expression_Variable (Name_Operator [] "+")) +-- [Expression_Literal (Literal_Int "2") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- o "(+3) 2" as +-- +-- Expression_NormalApplication +-- (Expression_SectionApplication +-- Nothing (Name_Operator [] "+") +-- (Just (Expression_Literal (Literal_Int "3")))) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "(2+) 3" as +-- +-- Expression_NormalApplication +-- (Expression_SectionApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "+") Nothing) +-- [Expression_Literal (Literal_Int "3")] +-- +-- o "2 + 3" as +-- +-- Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "+") +-- (Just (Expression_Literal (Literal_Int "3"))) +-- +-- o "mod 5 2" as +-- +-- Expression_NormalApplication +-- (Expression_Variable (Name_Identifier [] "mod")) +-- [Expression_Literal (Literal_Int "5") +-- ,Expression_Literal (Literal_Int "3")] +-- +-- o "(`mod` 2) 5" as +-- +-- Expression_NormalApplication +-- (Expression_SectionApplication +-- Nothing (Name_Identifier [] "mod") +-- (Just (Expression_Literal (Literal_Int "2")))) +-- [Expression_Literal (Literal_Int "5")] +-- +-- o "(5 `mod`) 2" as +-- +-- Expression_NormalApplication +-- (Expression_SectionApplication +-- (Just (Expression_Literal (Literal_Int "5"))) +-- (Name_Identifier [] "mod") Nothing) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "(mod 5) 2" as +-- +-- Expression_NormalApplication +-- (Expression_Parenthesized +-- (Expression_NormalApplication +-- (Expression_Variable (Name_Identifier [] "mod")) +-- [Expression_Literal (Literal_Int "5")])) +-- [Expression_Literal (Literal_Int "2")] +-- +-- o "5 `mod` 2" as +-- +-- Expression_InfixApplication +-- (Just (Expression_Literal (Literal_Int "5"))) +-- (Name_Identifier [] "mod") +-- (Just (Expression_Literal (Literal_Int "2"))) +-- +-- o "-2" as +-- +-- Expression_Negate (Expression_Literal (Literal_Int "2")) +-- +-- o "(-2)" as +-- +-- Expression_Parenthesized +-- (Expression_Negate (Expression_Literal (Literal_Int "2"))) +-- +-- o "(2-)" as +-- +-- Expression_SectionApplication +-- (Just (Expression_Literal (Literal_Int "2"))) +-- (Name_Operator [] "-") Nothing +-- +-- Summary: +-- Sections are represented as partial infix applications. Backquotes +-- and parentheses that originate from pre/in-fixing an operator/identifier +-- are not stored explicitly. + + +TYPE ContextedExpressions = [ ContextedExpression ] + +DATA ContextedExpression + | Contexted + range : Range + expression : Expression + context : ContextItem + +TYPE Statements = [ Statement ] + +DATA Statement + | Expression + range : Range + expression : Expression + | Let + range : Range + declarations : Declarations + | Generator + range : Range + pattern : Pattern + expression : Expression + | Empty + range : Range + +SET AllStatement + = Statement Statements + +TYPE Qualifiers = [ Qualifier ] + +DATA Qualifier + | Guard + range : Range + guard : Expression -- type: Boolean + | Let + range : Range + declarations : Declarations + | Generator + range : Range + pattern : Pattern + expression : Expression + | Empty + range : Range + +SET AllQualifier + = Qualifier Qualifiers + +TYPE Alternatives = [ Alternative ] + +DATA Alternative + | Alternative + range : Range + pattern : Pattern + righthandside : RightHandSide + | Empty + range : Range + +SET AllAlternative + = Alternative Alternatives + +TYPE GuardedExpressions = [ GuardedExpression ] + +DATA GuardedExpression -- ToDo: or _Guard? + | GuardedExpression + range : Range + guard : Expression -- type: Boolean + expression : Expression + +SET AllGuardedExpression + = GuardedExpression GuardedExpressions + +TYPE RecordExpressionBindings = [ RecordExpressionBinding ] + +DATA RecordExpressionBinding + | Binding + range : Range + name : Name + expression : Expression + +SET AllRecordExpressionBinding + = RecordExpressionBinding RecordExpressionBindings + +TYPE RowRecordExpressionUpdates = [ RowRecordExpressionUpdate ] + +DATA RowRecordExpressionUpdate + | Update + range : Range + name : Name + expression : Expression + | Extends + range : Range + name : MaybeName + expression : Expression + +SET AllRowRecordExpressionUpdate + = RowRecordExpressionUpdate RowRecordExpressionUpdates + +TYPE RowTypeUpdates = [ RowTypeUpdate ] + +DATA RowTypeUpdate + | Extends + range : Range + name : MaybeName + type : Type + +SET AllRowTypeUpdate + = RowTypeUpdate RowTypeUpdates + +TYPE FunctionBindings = [ FunctionBinding ] + +DATA FunctionBinding + | FunctionBinding + range : Range + lefthandside : LeftHandSide + righthandside : RightHandSide + +SET AllFunctionBinding + = FunctionBinding FunctionBindings + +DATA LeftHandSide + | Function + range : Range + name : Name + patterns : Patterns + | Infix + range : Range + leftPattern : Pattern + operator : Name + rightPattern : Pattern + | Parenthesized + range : Range + lefthandside : LeftHandSide + patterns : Patterns + | Typed + range : Range + lefthandside : LeftHandSide + type : Type + +DATA TypeLeftHandSide + | Function + range : Range + name : Name + patterns : TypePatterns + | Infix + range : Range + leftPattern : TypePattern + operator : Name + rightPattern : TypePattern + | Parenthesized + range : Range + lefthandside : TypeLeftHandSide + patterns : TypePatterns + +DATA RightHandSide + | Expression + range : Range + expression : Expression + where : MaybeDeclarations + | Guarded + range : Range + guardedexpressions : GuardedExpressions + where : MaybeDeclarations + +SET AllExpression + = Expression Expressions MaybeExpression + ExpressionAnnotation + AllFunctionBinding + LeftHandSide RightHandSide + AllAlternative + AllGuardedExpression + AllQualifier + AllRecordExpressionBinding + AllRowRecordExpressionUpdate + AllStatement + ContextedExpression ContextedExpressions + +TYPE Patterns = [ Pattern ] + +DATA Pattern + | Literal + range : Range + sign : Int + literal : Literal + | Variable + range : Range + name : Name + | Constructor + range : Range + name : Name + patterns : Patterns + | Parenthesized + range : Range + pattern : Pattern + | As + range : Range + name : Name + pattern : Pattern + | Wildcard + range : Range + | Tuple + range : Range + arity : Int + patterns : Patterns + | Annotate + range : Range + annotation : PatternAnnotation + pattern : Pattern + + | Typed + range : Range + pattern : Pattern + type : Type + | InfixConstructor + range : Range + leftPattern : Pattern + constructorOperator : Name + rightPattern : Pattern + | List + range : Range + patterns : Patterns + | Record + range : Range + name : Name + recordPatternBindings : RecordPatternBindings + | RowRecordBinding + range : Range + pattern : Pattern + rowRecordPattternBindings: RowRecordPatternBindings + | RowRecordEmpty + range : Range + | Irrefutable + range : Range + pattern : Pattern + | Bang + range : Range + pattern : Pattern +TYPE ContextedPatterns = [ ContextedPattern ] + +DATA ContextedPattern + | Contexted + range : Range + pattern : Pattern + context : ContextItem + +SET AllContextedPattern + = ContextedPattern ContextedPatterns + +SET AllPattern + = Pattern Patterns + PatternAnnotation + AllRowRecordPatternBinding + AllRecordPatternBinding + AllContextedPattern + +TYPE RecordPatternBindings = [ RecordPatternBinding ] + +DATA RecordPatternBinding + | Binding + range : Range + name : Name + pattern : Pattern + | Pun + range : Range + name : Name + +SET AllRecordPatternBinding + = RecordPatternBinding RecordPatternBindings + +DATA RowRecordPatternBinding + | Binding + range : Range + name : MaybeName + pattern : Pattern + +TYPE RowRecordPatternBindings = [ RowRecordPatternBinding ] + +SET AllRowRecordPatternBinding + = RowRecordPatternBinding RowRecordPatternBindings + +TYPE TypePatterns = [ TypePattern ] + +DATA TypePattern + | Variable + range : Range + name : Name + +SET AllTypePattern + = TypePattern TypePatterns + +DATA TypeAnnotation + | Strict + | AnnotationName + name : Name + | AnnotationVar + name : Name + var : Name + +DATA ExpressionAnnotation + | Empty + +DATA PatternAnnotation + | Empty + +DATA KindAnnotation + | Empty + +DATA Literal {- *** -} + | Int {- *** -} + range : Range + base : Int + value : String + | Char {- *** -} + range : Range + value : String -- without the quotes + | String {- ??? -} + range : Range + value : String -- without the quotes + | Float + range : Range + value : String + +TYPE Strings = [ String ] + +SET AllBasics + = Strings Literal + +SET AllNT + = AllModuleDeclaration + AllType + AllPattern AllExpression + AllBasics + AllTypePattern + AllKind + AllPragma + +{- + +Documented Design Decisions: + + o All names are spelt out. + + o All constructor names are prefixed with the type name followed by + an underscore. This preserves uniqueness, and the AG system can + do that automatically. + + o Ranges are included everywhere as the first field, except + in list and maybe types. + + o Naming convention for list types: append an `s' to the name of + the element type. + + o Naming convention for maybe types: prepend base type with `Maybe'. + + o All of Haskell should be expressible without too much reinterpretation. + That means that the syntax contains cases for ugly constructs such + as the `default' statement or n+k/successor patterns. + + o We keep a few extensions in mind and are thus more general than + Haskell in many places. For instance, the abstract syntax allows: + <> multi-parameter type classes + <> existential types + <> rank-n polymorphic and qualified types + <> hierarchical module names + <> Haskell toplevel declarations everywhere + + o `Expression_InfixApplication' is used to store + prefixed operators. + + o `Expression_SectionApplication' is used to store sections. + + o General where rule: A "where" with no declarations is represented + as "Just []". A missing "where" clause is represented as "Nothing". + + o If two different cases can be joined into one by using a `Bool' + to distinguish or by using maybe types, then they _usually_ should. + + o Literals are stored as strings rather than in their corresponding + Haskell types, leaving it to each project to do conversions if + necessary. The strings should store the literal in the same + way as it appears in the source, but without the single or double + quotes for character or string literals. + + o We do not include nonterminals that do not have resemblance in the + concrete syntax, although they might be convenient for AG usage. + Examples discussed were special root-like nonterminals for expressions + and types, or a `BindingGroup' nonterminal. + + o Although parentheses can be represented in the abstract syntax, + the program using it will probably not always do so. For instance, + most compilers will work on type expressions and not insert parentheses + at the correct positions. There might be different pretty printers needed: + literal and optimizing. + + ToDo: Create different levels of the abstract syntax. + Types, constructors, maybe even fields should be categorised. + There should be a really small core, and different standardised + extensions levels. Some of the extensions might even be not + yet discussed at all (kinds, functional dependencies, ...) + Andres has started marking some types and some constructors + he thinks are most important with {- *** -}. + +-} diff --git a/103/lib/ag/JVMClass/AbsSyn.ag b/103/lib/ag/JVMClass/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/JVMClass/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/JavaScript/AbsSyn.ag b/103/lib/ag/JavaScript/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/JavaScript/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/LLVM/AbsSyn.ag b/103/lib/ag/LLVM/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/LLVM/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/Silly/AbsSyn.ag b/103/lib/ag/Silly/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Silly/AbsSyn.ag @@ -0,0 +1,1 @@ + diff --git a/103/lib/ag/Ty/AbsSyn.ag b/103/lib/ag/Ty/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/Ty/AbsSyn.ag @@ -0,0 +1,162 @@ +{ +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} +} +DATA TyAGItf + | AGItf ty : Ty + +DATA LabelAGItf + | AGItf lab : Label + +{ +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} +} +DATA Ty + | Con nm : {HsName} + | App func : Ty + arg : Ty + +DATA Ty + | Ann ann : TyAnn + ty : Ty + +DATA Ty + | Dbg info : {String} + +DATA TyAnn + | Empty + | Strictness s : Strictness + | Mono -- enforce predicative binding when matching + +DATA Ty + | Any + +DATA Ty + | Var tv : {TyVarId} + categ : TyVarCateg + +DATA TyVarCateg + | Plain -- plain type variables + | Fixed -- fixed, i.e. cannot be bound during type matching/fitsIn + | Meta -- tvar for reasoning about the typelevel, not on/in the typelevel; for CHR rules + +DATA Ty + | TBind + qu : TyQu + tv : {TyVarId} + l1 : {Ty} -- 1 (or more, if MetaLev > 0) meta level higher, and its kind/sort/... + ty : Ty + +DATA Ty + | Ext ty : Ty + nm : {HsName} + extTy : Ty + +DATA Ty + | Pred pr : Pred + +DATA Ty + | Lam tv : {TyVarId} + ty : Ty + +DATA TyQu + | Forall mlev : MetaLev + | Exists mlev : MetaLev + | Plain mlev : MetaLev + +DATA Pred + | Class ty : Ty + | Pred ty : Ty + +DATA Label + | Lab nm : HsName + +DATA Pred + | Lacks ty : Ty + lab : Label + +DATA Pred + | Arrow args : PredSeq + res : Pred + +DATA PredSeq + | Cons hd : Pred + tl : PredSeq + | Nil + +DATA Pred + | Eq tyL : Ty + tyR : Ty + +DATA Ty + | Impls impls : Impls + +DATA Impls + | Tail iv : {ImplsVarId} + proveOccs : {[ImplsProveOcc]} + | Cons iv : {ImplsVarId} + pr : Pred + pv : {PredOccId} + prange : {Range} + proveOccs : {[ImplsProveOcc]} + tl : Impls + | Nil + +DATA Pred + | Var pv : TyVarId + +DATA Label + | Var lv : LabelVarId + +DATA PredSeq + | Var av : TyVarId + +DATA Pred + | Preds seq : PredSeq + + + +SET AllTyTy + = Ty + +SET AllTy + = AllTyTy + Pred Impls + PredSeq + +SET AllTyAndFlds + = AllTy + TyAnn + TyVarCateg + TyQu + Label + +SET AllTyAGItf + = TyAGItf + LabelAGItf + diff --git a/103/lib/ag/TyCore/AbsSyn.ag b/103/lib/ag/TyCore/AbsSyn.ag new file mode 100644 --- /dev/null +++ b/103/lib/ag/TyCore/AbsSyn.ag @@ -0,0 +1,11 @@ +DATA Expr + | HoleLet bindsUid : {UID} + body : Expr + | ImplsApp func : Expr + uid : {ImplsVarId} + | ImplsLam uid : {ImplsVarId} + body : Expr + +DATA Pat + | BoolExpr expr : Expr + diff --git a/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr b/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr differ diff --git a/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi b/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi differ diff --git a/103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config b/103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config new file mode 100644 --- /dev/null +++ b/103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config @@ -0,0 +1,2 @@ +exposed-modules: Data.Array +build-depends: uhcbase-1.1.7.0 base-3.0.0.0 diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll b/103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll new file mode 100644 --- /dev/null +++ b/103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi differ diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h b/103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h @@ -0,0 +1,12 @@ +/* + * (c) The University of Glasgow, 2000-2002 + * + * Win32 Console API helpers. + */ +#ifndef __CONSUTILS_H__ +#define __CONSUTILS_H__ +extern int set_console_buffering__(int fd, int cooked); +extern int set_console_echo__(int fd, int on); +extern int get_console_echo__(int fd); +extern int flush_input_console__ (int fd); +#endif diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config b/103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config new file mode 100644 --- /dev/null +++ b/103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config @@ -0,0 +1,2 @@ +exposed-modules: Control.Applicative Control.Arrow Control.Category Control.Monad.Fix Control.Monad.Instances Control.Monad.ST.Lazy Control.Monad.ST Data.Bool Data.Complex Data.Dynamic Data.Eq Data.Foldable Data.Function Data.Ix Data.Monoid Data.Ord Data.Ratio Data.String Data.Traversable Numeric Prelude System.Console.GetOpt System.Environment System.Exit Text.ParserCombinators.ReadP Text.ParserCombinators.ReadPrec Text.Read.Lex Text.Read Text.Show.Functions Text.Show +build-depends: uhcbase-1.1.7.0 diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.cr b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.hi b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/CTypes.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/CTypes.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/CTypes.h @@ -0,0 +1,231 @@ +{- -------------------------------------------------------------------------- +// Dirty CPP hackery for CTypes/CTypesISO +// +// (c) The FFI task force, 2000 +// -------------------------------------------------------------------------- +-} + +#ifndef CTYPES__H +#define CTYPES__H + +#include "Typeable.h" + +{- +// As long as there is no automatic derivation of classes for newtypes we resort +// to extremely dirty cpp-hackery. :-P Some care has to be taken when the +// macros below are modified, otherwise the layout rule will bite you. +-} + +-- // A hacked version for GHC follows the Haskell 98 version... +#ifndef __GLASGOW_HASKELL__ + +#define NEWTYPE_TYPE_NODERIVING(T,B) \ +newtype T = T B ; + +#define NEWTYPE_TYPE(T,B) \ +newtype T = T B deriving (Eq, Ord) ; + +#define ARITHMETIC_TYPE_INSTANCES(T,C,S,B) \ +INSTANCE_NUM(T) ; \ +INSTANCE_REAL(T) ; \ +INSTANCE_READ(T,B) ; \ +INSTANCE_SHOW(T,B) ; \ +INSTANCE_ENUM(T) ; \ +INSTANCE_STORABLE(T) ; \ +INSTANCE_TYPEABLE0(T,C,S) ; + +#define INTEGRAL_TYPE_INSTANCES(T,C,S,B) \ +INSTANCE_BOUNDED(T) ; \ +INSTANCE_INTEGRAL(T) ; \ +INSTANCE_BITS(T) + +#define ARITHMETIC_TYPE(T,C,S,B) \ +NEWTYPE_TYPE(T,B) ; \ +ARITHMETIC_TYPE_INSTANCES(T,C,S,B) ; + +#define INTEGRAL_TYPE(T,C,S,B) \ +ARITHMETIC_TYPE(T,C,S,B) ; \ +INTEGRAL_TYPE_INSTANCES(T,C,S,B) + +#define FLOATING_TYPE(T,C,S,B) \ +ARITHMETIC_TYPE(T,C,S,B) ; \ +INSTANCE_FRACTIONAL(T) ; \ +INSTANCE_FLOATING(T) ; \ +INSTANCE_REALFRAC(T) ; \ +INSTANCE_REALFLOAT(T) + +#ifndef __GLASGOW_HASKELL__ +#define fakeMap map +#endif + +#define INSTANCE_READ(T,B) \ +instance Read T where { \ + readsPrec p s = fakeMap (\(x, t) -> (T x, t)) (readsPrec p s) } + +#define INSTANCE_SHOW(T,B) \ +instance Show T where { \ + showsPrec p (T x) = showsPrec p x } + +#define INSTANCE_NUM(T) \ +instance Num T where { \ + (T i) + (T j) = T (i + j) ; \ + (T i) - (T j) = T (i - j) ; \ + (T i) * (T j) = T (i * j) ; \ + negate (T i) = T (negate i) ; \ + abs (T i) = T (abs i) ; \ + signum (T i) = T (signum i) ; \ + fromInteger x = T (fromInteger x) } + +#define INSTANCE_EQ(T) \ +instance Eq T where { \ + (T x1) == (T x2) = x1 == x2 } + +#define INSTANCE_ORD(T) \ +instance Ord T where { \ + (T x1) `compare` (T x2) = x1 `compare` x2 } + +#define INSTANCE_BOUNDED(T) \ +instance Bounded T where { \ + minBound = T minBound ; \ + maxBound = T maxBound } + +#define INSTANCE_ENUM(T) \ +instance Enum T where { \ + succ (T i) = T (succ i) ; \ + pred (T i) = T (pred i) ; \ + toEnum x = T (toEnum x) ; \ + fromEnum (T i) = fromEnum i ; \ + enumFrom (T i) = fakeMap T (enumFrom i) ; \ + enumFromThen (T i) (T j) = fakeMap T (enumFromThen i j) ; \ + enumFromTo (T i) (T j) = fakeMap T (enumFromTo i j) ; \ + enumFromThenTo (T i) (T j) (T k) = fakeMap T (enumFromThenTo i j k) } + +#define INSTANCE_REAL(T) \ +instance Real T where { \ + toRational (T i) = toRational i } + +#define INSTANCE_INTEGRAL(T) \ +instance Integral T where { \ + (T i) `quot` (T j) = T (i `quot` j) ; \ + (T i) `rem` (T j) = T (i `rem` j) ; \ + (T i) `div` (T j) = T (i `div` j) ; \ + (T i) `mod` (T j) = T (i `mod` j) ; \ + (T i) `quotRem` (T j) = let (q,r) = i `quotRem` j in (T q, T r) ; \ + (T i) `divMod` (T j) = let (d,m) = i `divMod` j in (T d, T m) ; \ + toInteger (T i) = toInteger i } + +#define INSTANCE_BITS(T) \ +instance Bits T where { \ + (T x) .&. (T y) = T (x .&. y) ; \ + (T x) .|. (T y) = T (x .|. y) ; \ + (T x) `xor` (T y) = T (x `xor` y) ; \ + complement (T x) = T (complement x) ; \ + shift (T x) n = T (shift x n) ; \ + rotate (T x) n = T (rotate x n) ; \ + bit n = T (bit n) ; \ + setBit (T x) n = T (setBit x n) ; \ + clearBit (T x) n = T (clearBit x n) ; \ + complementBit (T x) n = T (complementBit x n) ; \ + testBit (T x) n = testBit x n ; \ + bitSize (T x) = bitSize x ; \ + isSigned (T x) = isSigned x } + +#define INSTANCE_FRACTIONAL(T) \ +instance Fractional T where { \ + (T x) / (T y) = T (x / y) ; \ + recip (T x) = T (recip x) ; \ + fromRational r = T (fromRational r) } + +#define INSTANCE_FLOATING(T) \ +instance Floating T where { \ + pi = pi ; \ + exp (T x) = T (exp x) ; \ + log (T x) = T (log x) ; \ + sqrt (T x) = T (sqrt x) ; \ + (T x) ** (T y) = T (x ** y) ; \ + (T x) `logBase` (T y) = T (x `logBase` y) ; \ + sin (T x) = T (sin x) ; \ + cos (T x) = T (cos x) ; \ + tan (T x) = T (tan x) ; \ + asin (T x) = T (asin x) ; \ + acos (T x) = T (acos x) ; \ + atan (T x) = T (atan x) ; \ + sinh (T x) = T (sinh x) ; \ + cosh (T x) = T (cosh x) ; \ + tanh (T x) = T (tanh x) ; \ + asinh (T x) = T (asinh x) ; \ + acosh (T x) = T (acosh x) ; \ + atanh (T x) = T (atanh x) } + +#define INSTANCE_REALFRAC(T) \ +instance RealFrac T where { \ + properFraction (T x) = let (m,y) = properFraction x in (m, T y) ; \ + truncate (T x) = truncate x ; \ + round (T x) = round x ; \ + ceiling (T x) = ceiling x ; \ + floor (T x) = floor x } + +#define INSTANCE_REALFLOAT(T) \ +instance RealFloat T where { \ + floatRadix (T x) = floatRadix x ; \ + floatDigits (T x) = floatDigits x ; \ + floatRange (T x) = floatRange x ; \ + decodeFloat (T x) = decodeFloat x ; \ + encodeFloat m n = T (encodeFloat m n) ; \ + exponent (T x) = exponent x ; \ + significand (T x) = T (significand x) ; \ + scaleFloat n (T x) = T (scaleFloat n x) ; \ + isNaN (T x) = isNaN x ; \ + isInfinite (T x) = isInfinite x ; \ + isDenormalized (T x) = isDenormalized x ; \ + isNegativeZero (T x) = isNegativeZero x ; \ + isIEEE (T x) = isIEEE x ; \ + (T x) `atan2` (T y) = T (x `atan2` y) } + +#define INSTANCE_STORABLE(T) \ +instance Storable T where { \ + sizeOf (T x) = sizeOf x ; \ + alignment (T x) = alignment x ; \ + peekElemOff a i = liftM T (peekElemOff (castPtr a) i) ; \ + pokeElemOff a i (T x) = pokeElemOff (castPtr a) i x } + +#else /* __GLASGOW_HASKELL__ */ + +-- // GHC can derive any class for a newtype, so we make use of that here... + +#define ARITHMETIC_CLASSES Eq,Ord,Num,Enum,Storable,Real +#define INTEGRAL_CLASSES Bounded,Integral,Bits +#define FLOATING_CLASSES Fractional,Floating,RealFrac,RealFloat + +#define ARITHMETIC_TYPE(T,C,S,B) \ +newtype T = T B deriving (ARITHMETIC_CLASSES); \ +INSTANCE_READ(T,B); \ +INSTANCE_SHOW(T,B); \ +INSTANCE_TYPEABLE0(T,C,S) ; + +#define INTEGRAL_TYPE(T,C,S,B) \ +newtype T = T B deriving (ARITHMETIC_CLASSES, INTEGRAL_CLASSES); \ +INSTANCE_READ(T,B); \ +INSTANCE_SHOW(T,B); \ +INSTANCE_TYPEABLE0(T,C,S) ; + +#define FLOATING_TYPE(T,C,S,B) \ +newtype T = T B deriving (ARITHMETIC_CLASSES, FLOATING_CLASSES); \ +INSTANCE_READ(T,B); \ +INSTANCE_SHOW(T,B); \ +INSTANCE_TYPEABLE0(T,C,S) ; + +#define INSTANCE_READ(T,B) \ +instance Read T where { \ + readsPrec = unsafeCoerce# (readsPrec :: Int -> ReadS B); \ + readList = unsafeCoerce# (readList :: ReadS [B]); } + +#define INSTANCE_SHOW(T,B) \ +instance Show T where { \ + showsPrec = unsafeCoerce# (showsPrec :: Int -> B -> ShowS); \ + show = unsafeCoerce# (show :: B -> String); \ + showList = unsafeCoerce# (showList :: [B] -> ShowS); } + +#endif /* __GLASGOW_HASKELL__ */ + +#endif diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBase.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBase.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBase.h @@ -0,0 +1,757 @@ +/* ----------------------------------------------------------------------------- + * + * (c) The University of Glasgow 2001-2004 + * + * Definitions for package `base' which are visible in Haskell land. + * + * Adapted for use in EHC + * + * ---------------------------------------------------------------------------*/ + +#ifndef __HSBASE_H__ +#define __HSBASE_H__ + +#include "HsBaseConfig.h" +#ifdef __UHC_BUILDS_O__ +#include "rts.h" +#endif + +/* ultra-evil... */ +#undef PACKAGE_BUGREPORT +#undef PACKAGE_NAME +#undef PACKAGE_STRING +#undef PACKAGE_TARNAME +#undef PACKAGE_VERSION + +/* Needed to get the macro version of errno on some OSs (eg. Solaris). + We must do this, because these libs are only compiled once, but + must work in both single-threaded and multi-threaded programs. */ +#define _REENTRANT 1 + +#ifndef __UHC__ +#include "HsFFI.h" +#endif /* !__UHC__ */ + +#include +#include +#include + +#if HAVE_SYS_TYPES_H +#include +#endif +#if HAVE_UNISTD_H +#include +#endif +#if HAVE_SYS_STAT_H +#include +#endif +#if HAVE_FCNTL_H +# include +#endif +#if HAVE_TERMIOS_H +#include +#endif +#if HAVE_SIGNAL_H +#include +/* Ultra-ugly: OpenBSD uses broken macros for sigemptyset and sigfillset (missing casts) */ +#if __OpenBSD__ +#undef sigemptyset +#undef sigfillset +#endif +#endif +#if HAVE_ERRNO_H +#include +#endif +#if HAVE_STRING_H +#include +#endif +#if HAVE_DIRENT_H +#include +#endif +#if HAVE_UTIME_H +#include +#endif +#if HAVE_SYS_UTSNAME_H +#include +#endif +#if HAVE_GETTIMEOFDAY +# if HAVE_SYS_TIME_H +# include +# endif +#elif HAVE_GETCLOCK +# if HAVE_SYS_TIMERS_H +# define POSIX_4D9 1 +# include +# endif +#endif +#if HAVE_TIME_H +#include +#endif +#if HAVE_SYS_TIMEB_H +#include +#endif +#if HAVE_WINDOWS_H +#include +#endif +#if HAVE_SYS_TIMES_H +#include +#endif +#if HAVE_WINSOCK_H && defined(__MINGW32__) +#include +#endif +#if HAVE_LIMITS_H +#include +#endif +#if HAVE_WCTYPE_H +#include +#endif +#if HAVE_INTTYPES_H +# include +#elif HAVE_STDINT_H +# include +#endif + +#if !defined(__MINGW32__) && !defined(irix_HOST_OS) +# if HAVE_SYS_RESOURCE_H +# include +# endif +#endif + +#if !HAVE_GETRUSAGE && HAVE_SYS_SYSCALL_H +# include +# if defined(SYS_GETRUSAGE) /* hpux_HOST_OS */ +# define getrusage(a, b) syscall(SYS_GETRUSAGE, a, b) +# define HAVE_GETRUSAGE 1 +# endif +#endif + +/* For System */ +#if HAVE_SYS_WAIT_H +#include +#endif +#if HAVE_VFORK_H +#include +#endif + +#ifndef __UHC__ +#include "dirUtils.h" +#endif +#ifndef __UHC__ +#include "WCsubst.h" +#endif /* !__UHC__ */ + +#if defined(__MINGW32__) +/* in Win32Utils.c */ +extern void maperrno (void); +extern HsWord64 getUSecOfDay(void); +#endif + +#if defined(__MINGW32__) +#include +#include +#include +#include +#endif + +#if HAVE_SYS_SELECT_H +#include +#endif + +/* in inputReady.c */ +extern int fdReady(int fd, int write, int msecs, int isSock); + +#ifndef __UHC__ +/* in Signals.c */ +extern HsInt nocldstop; +#endif /* !__UHC__ */ + +#ifndef __UHC__ +/* ----------------------------------------------------------------------------- + 64-bit operations, defined in longlong.c + -------------------------------------------------------------------------- */ + +#ifdef SUPPORT_LONG_LONGS + +HsBool hs_gtWord64 (HsWord64, HsWord64); +HsBool hs_geWord64 (HsWord64, HsWord64); +HsBool hs_eqWord64 (HsWord64, HsWord64); +HsBool hs_neWord64 (HsWord64, HsWord64); +HsBool hs_ltWord64 (HsWord64, HsWord64); +HsBool hs_leWord64 (HsWord64, HsWord64); + +HsBool hs_gtInt64 (HsInt64, HsInt64); +HsBool hs_geInt64 (HsInt64, HsInt64); +HsBool hs_eqInt64 (HsInt64, HsInt64); +HsBool hs_neInt64 (HsInt64, HsInt64); +HsBool hs_ltInt64 (HsInt64, HsInt64); +HsBool hs_leInt64 (HsInt64, HsInt64); + +HsWord64 hs_remWord64 (HsWord64, HsWord64); +HsWord64 hs_quotWord64 (HsWord64, HsWord64); + +HsInt64 hs_remInt64 (HsInt64, HsInt64); +HsInt64 hs_quotInt64 (HsInt64, HsInt64); +HsInt64 hs_negateInt64 (HsInt64); +HsInt64 hs_plusInt64 (HsInt64, HsInt64); +HsInt64 hs_minusInt64 (HsInt64, HsInt64); +HsInt64 hs_timesInt64 (HsInt64, HsInt64); + +HsWord64 hs_and64 (HsWord64, HsWord64); +HsWord64 hs_or64 (HsWord64, HsWord64); +HsWord64 hs_xor64 (HsWord64, HsWord64); +HsWord64 hs_not64 (HsWord64); + +HsWord64 hs_uncheckedShiftL64 (HsWord64, HsInt); +HsWord64 hs_uncheckedShiftRL64 (HsWord64, HsInt); +HsInt64 hs_uncheckedIShiftL64 (HsInt64, HsInt); +HsInt64 hs_uncheckedIShiftRA64 (HsInt64, HsInt); +HsInt64 hs_uncheckedIShiftRL64 (HsInt64, HsInt); + +HsInt64 hs_intToInt64 (HsInt); +HsInt hs_int64ToInt (HsInt64); +HsWord64 hs_int64ToWord64 (HsInt64); +HsWord64 hs_wordToWord64 (HsWord); +HsWord hs_word64ToWord (HsWord64); +HsInt64 hs_word64ToInt64 (HsWord64); + +HsWord64 hs_integerToWord64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da); +HsInt64 hs_integerToInt64 (HsInt sa, StgByteArray /* Really: mp_limb_t* */ da); + +#endif /* SUPPORT_LONG_LONGS */ +#endif /* !__UHC__ */ + +/* ----------------------------------------------------------------------------- + INLINE functions. + + These functions are given as inlines here for when compiling via C, + but we also generate static versions into the cbits library for + when compiling to native code. + -------------------------------------------------------------------------- */ + +#ifndef INLINE +# if defined(_MSC_VER) +# define INLINE extern __inline +# else +# define INLINE static inline +# endif +#endif + +INLINE int __hscore_get_errno(void) { return errno; } +INLINE void __hscore_set_errno(int e) { errno = e; } + +#if !defined(_MSC_VER) +INLINE int __hscore_s_isreg(mode_t m) { return S_ISREG(m); } +INLINE int __hscore_s_isdir(mode_t m) { return S_ISDIR(m); } +INLINE int __hscore_s_isfifo(mode_t m) { return S_ISFIFO(m); } +INLINE int __hscore_s_isblk(mode_t m) { return S_ISBLK(m); } +INLINE int __hscore_s_ischr(mode_t m) { return S_ISCHR(m); } +#if !defined(mingw32_HOST_OS) && !defined(__MINGW32__) +INLINE int __hscore_s_issock(mode_t m) { return S_ISSOCK(m); } +#endif +#endif + +#if ( !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) ) || defined(__CYGWIN__) +INLINE int +__hscore_sigemptyset( sigset_t *set ) +{ return sigemptyset(set); } + +INLINE int +__hscore_sigfillset( sigset_t *set ) +{ return sigfillset(set); } + +INLINE int +__hscore_sigaddset( sigset_t * set, int s ) +{ return sigaddset(set,s); } + +INLINE int +__hscore_sigdelset( sigset_t * set, int s ) +{ return sigdelset(set,s); } + +INLINE int +__hscore_sigismember( sigset_t * set, int s ) +{ return sigismember(set,s); } +#endif + +INLINE void * +__hscore_memcpy_dst_off( char *dst, int dst_off, char *src, size_t sz ) +{ return memcpy(dst+dst_off, src, sz); } + +INLINE void * +__hscore_memcpy_src_off( char *dst, char *src, int src_off, size_t sz ) +{ return memcpy(dst, src+src_off, sz); } + +INLINE HsBool +__hscore_supportsTextMode() +{ +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) + return HS_BOOL_FALSE; +#else + return HS_BOOL_TRUE; +#endif +} + +INLINE HsInt +__hscore_bufsiz() +{ + return BUFSIZ; +} + +INLINE int +__hscore_seek_cur() +{ + return SEEK_CUR; +} + +INLINE int +__hscore_o_binary() +{ +#if defined(_MSC_VER) + return O_BINARY; +#else + return CONST_O_BINARY; +#endif +} + +INLINE int +__hscore_o_rdonly() +{ +#ifdef O_RDONLY + return O_RDONLY; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_wronly( void ) +{ +#ifdef O_WRONLY + return O_WRONLY; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_rdwr( void ) +{ +#ifdef O_RDWR + return O_RDWR; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_append( void ) +{ +#ifdef O_APPEND + return O_APPEND; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_creat( void ) +{ +#ifdef O_CREAT + return O_CREAT; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_excl( void ) +{ +#ifdef O_EXCL + return O_EXCL; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_trunc( void ) +{ +#ifdef O_TRUNC + return O_TRUNC; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_noctty( void ) +{ +#ifdef O_NOCTTY + return O_NOCTTY; +#else + return 0; +#endif +} + +INLINE int +__hscore_o_nonblock( void ) +{ +#ifdef O_NONBLOCK + return O_NONBLOCK; +#else + return 0; +#endif +} + +INLINE int +__hscore_seek_set( void ) +{ + return SEEK_SET; +} + +INLINE int +__hscore_seek_end( void ) +{ + return SEEK_END; +} + +INLINE int +__hscore_ftruncate( int fd, off_t where ) +{ +#if defined(HAVE_FTRUNCATE) + return ftruncate(fd,where); +#elif defined(HAVE__CHSIZE) + return _chsize(fd,where); +#else +// ToDo: we should use _chsize_s() on Windows which allows a 64-bit +// offset, but it doesn't seem to be available from mingw at this time +// --SDM (01/2008) +#error at least ftruncate or _chsize functions are required to build +#endif +} + +#ifndef __UHC__ +INLINE int +__hscore_setmode( int fd, HsBool toBin ) +{ +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) + return setmode(fd,(toBin == HS_BOOL_TRUE) ? _O_BINARY : _O_TEXT); +#else + return 0; +#endif +} +#endif /* !__UHC__ */ + +#if __GLASGOW_HASKELL__ + +INLINE int +__hscore_PrelHandle_write( int fd, void *ptr, HsInt off, int sz ) +{ + return write(fd,(char *)ptr + off, sz); +} + +INLINE int +__hscore_PrelHandle_read( int fd, void *ptr, HsInt off, int sz ) +{ + return read(fd,(char *)ptr + off, sz); + +} + +#if defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) +INLINE int +__hscore_PrelHandle_send( int fd, void *ptr, HsInt off, int sz ) +{ + return send(fd,(char *)ptr + off, sz, 0); +} + +INLINE int +__hscore_PrelHandle_recv( int fd, void *ptr, HsInt off, int sz ) +{ + return recv(fd,(char *)ptr + off, sz, 0); +} +#endif + +#endif /* __GLASGOW_HASKELL__ */ + +INLINE int +__hscore_mkdir( char *pathName, int mode ) +{ +#if ( defined(_MSC_VER) || defined(__MINGW32__) || defined(_WIN32) ) && !defined(__CYGWIN__) + return mkdir(pathName); +#else + return mkdir(pathName,mode); +#endif +} + +INLINE int +__hscore_lstat( const char *fname, struct stat *st ) +{ +#if HAVE_LSTAT + return lstat(fname, st); +#else + return stat(fname, st); +#endif +} + +INLINE char * +__hscore_d_name( struct dirent* d ) +{ + return (d->d_name); +} + +INLINE int +__hscore_end_of_dir( void ) +{ + return READDIR_ERRNO_EOF; +} + +INLINE void +__hscore_free_dirent(struct dirent *dEnt) +{ +#if HAVE_READDIR_R + free(dEnt); +#endif +} + +#if defined(__MINGW32__) +// We want the versions of stat/fstat/lseek that use 64-bit offsets, +// and you have to ask for those explicitly. Unfortunately there +// doesn't seem to be a 64-bit version of truncate/ftruncate, so while +// hFileSize and hSeek will work with large files, hSetFileSize will not. +#define stat(file,buf) _stati64(file,buf) +#define fstat(fd,buf) _fstati64(fd,buf) +typedef struct _stati64 struct_stat; +typedef off64_t stsize_t; +#else +typedef struct stat struct_stat; +typedef off_t stsize_t; +#endif + +INLINE HsInt +__hscore_sizeof_stat( void ) +{ + return sizeof(struct_stat); +} + +INLINE time_t __hscore_st_mtime ( struct_stat* st ) { return st->st_mtime; } +INLINE stsize_t __hscore_st_size ( struct_stat* st ) { return st->st_size; } +#if !defined(_MSC_VER) +INLINE mode_t __hscore_st_mode ( struct_stat* st ) { return st->st_mode; } +INLINE dev_t __hscore_st_dev ( struct_stat* st ) { return st->st_dev; } +INLINE ino_t __hscore_st_ino ( struct_stat* st ) { return st->st_ino; } +#endif + +#if HAVE_TERMIOS_H +INLINE tcflag_t __hscore_lflag( struct termios* ts ) { return ts->c_lflag; } + +INLINE void +__hscore_poke_lflag( struct termios* ts, tcflag_t t ) { ts->c_lflag = t; } + +INLINE unsigned char* +__hscore_ptr_c_cc( struct termios* ts ) +{ return (unsigned char*) &ts->c_cc; } + +INLINE HsInt +__hscore_sizeof_termios( void ) +{ +#ifndef __MINGW32__ + return sizeof(struct termios); +#else + return 0; +#endif +} +#endif + +//sizeof_sigset_t is also use on windows systems which define tcflat_t. Why exclude it? +// #if !defined(_MSC_VER) && !defined(__MINGW32__) && !defined(_WIN32) +INLINE HsInt +__hscore_sizeof_sigset_t( void ) +{ + return sizeof(sigset_t); +} +// #endif + +INLINE int +__hscore_echo( void ) +{ +#ifdef ECHO + return ECHO; +#else + return 0; +#endif + +} + +INLINE int +__hscore_tcsanow( void ) +{ +#ifdef TCSANOW + return TCSANOW; +#else + return 0; +#endif + +} + +INLINE int +__hscore_icanon( void ) +{ +#ifdef ICANON + return ICANON; +#else + return 0; +#endif +} + +INLINE int __hscore_vmin( void ) +{ +#ifdef VMIN + return VMIN; +#else + return 0; +#endif +} + +INLINE int __hscore_vtime( void ) +{ +#ifdef VTIME + return VTIME; +#else + return 0; +#endif +} + +INLINE int __hscore_sigttou( void ) +{ +#ifdef SIGTTOU + return SIGTTOU; +#else + return 0; +#endif +} + +INLINE int __hscore_sig_block( void ) +{ +#ifdef SIG_BLOCK + return SIG_BLOCK; +#else + return 0; +#endif +} + +INLINE int __hscore_sig_setmask( void ) +{ +#ifdef SIG_SETMASK + return SIG_SETMASK; +#else + return 0; +#endif +} + +INLINE int +__hscore_f_getfl( void ) +{ +#ifdef F_GETFL + return F_GETFL; +#else + return 0; +#endif +} + +INLINE int +__hscore_f_setfl( void ) +{ +#ifdef F_SETFL + return F_SETFL; +#else + return 0; +#endif +} + +// defined in rts/RtsStartup.c. +extern void* __hscore_get_saved_termios(int fd); +extern void __hscore_set_saved_termios(int fd, void* ts); + +INLINE int __hscore_hs_fileno (FILE *f) { return fileno (f); } + +INLINE int __hscore_open(char *file, int how, mode_t mode) { +#ifdef __MINGW32__ + if ((how & O_WRONLY) || (how & O_RDWR) || (how & O_APPEND)) + return _sopen(file,how,_SH_DENYRW,mode); + else + return _sopen(file,how,_SH_DENYWR,mode); +#else + return open(file,how,mode); +#endif +} + +// These are wrapped because on some OSs (eg. Linux) they are +// macros which redirect to the 64-bit-off_t versions when large file +// support is enabled. +// +#if defined(__MINGW32__) +INLINE off64_t __hscore_lseek(int fd, off64_t off, int whence) { + return (_lseeki64(fd,off,whence)); +} +#else +INLINE off_t __hscore_lseek(int fd, off_t off, int whence) { + return (lseek(fd,off,whence)); +} +#endif + +INLINE HsInt __hscore_stat(char *file, struct_stat *buf) { + return (stat(file,buf)); +} + +INLINE HsInt __hscore_fstat(int fd, struct_stat *buf) { + return (fstat(fd,buf)); +} + +// select-related stuff + +#if !defined(__MINGW32__) +INLINE int hsFD_SETSIZE(void) { return FD_SETSIZE; } +INLINE int hsFD_ISSET(int fd, fd_set *fds) { return FD_ISSET(fd, fds); } +INLINE void hsFD_SET(int fd, fd_set *fds) { FD_SET(fd, fds); } +INLINE HsInt sizeof_fd_set(void) { return sizeof(fd_set); } +extern void hsFD_ZERO(fd_set *fds); +#endif + +// gettimeofday()-related + +#if !defined(__MINGW32__) + +INLINE HsInt sizeofTimeVal(void) { return sizeof(struct timeval); } + +INLINE HsWord64 getUSecOfDay(void) +{ + struct timeval tv; + gettimeofday(&tv, (struct timezone *) NULL); + // Don't forget to cast *before* doing the arithmetic, otherwise + // the arithmetic happens at the type of tv_sec, which is probably + // only 'int'. + return ((HsWord64)tv.tv_sec * 1000000 + (HsWord64)tv.tv_usec); +} + +INLINE void setTimevalTicks(struct timeval *p, HsWord64 usecs) +{ + p->tv_sec = usecs / 1000000; + p->tv_usec = usecs % 1000000; +} +#endif /* !defined(__MINGW32__) */ + +/* ToDo: write a feature test that doesn't assume 'environ' to + * be in scope at link-time. */ +extern char** environ; +INLINE char **__hscore_environ() { return environ; } + +/* lossless conversions between pointers and integral types */ +INLINE void * __hscore_from_uintptr(uintptr_t n) { return (void *)n; } +INLINE void * __hscore_from_intptr (intptr_t n) { return (void *)n; } +INLINE uintptr_t __hscore_to_uintptr (void *p) { return (uintptr_t)p; } +INLINE intptr_t __hscore_to_intptr (void *p) { return (intptr_t)p; } + +void errorBelch2(const char*s, char *t); +void debugBelch2(const char*s, char *t); + +#endif /* __HSBASE_H__ */ + diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBaseConfig.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBaseConfig.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBaseConfig.h @@ -0,0 +1,944 @@ +/* ehclib/uhcbase/include/HsBaseConfig.h. Generated from HsBaseConfig.h.in by configure. */ +#ifndef HSBASECONFIG_H +#define HSBASECONFIG_H + +#include "MachDeps.h" + +/********************************************************************/ +/**** Sizes ****/ +/********************************************************************/ + +#if SIZEOF_INTPTR_T == 8 +#define HTYPE_INTPTR_T Int64 +#define HTYPE_UINTPTR_T Word64 +#else +#define HTYPE_INTPTR_T Int32 +#define HTYPE_UINTPTR_T Word32 +#endif + +/* also here: typedef int sig_atomic_t + */ +#if SIZEOF_INT == 8 +#define HTYPE_INT Int64 +#define HTYPE_UNSIGNED_INT Word64 +#define HTYPE_SIG_ATOMIC_T Word64 +#else +#define HTYPE_INT Int32 +#define HTYPE_UNSIGNED_INT Word32 +#define HTYPE_SIG_ATOMIC_T Word32 +#endif + +#if SIZEOF_LONG == 8 +#define HTYPE_LONG Int64 +#define HTYPE_UNSIGNED_LONG Word64 +#else +#define HTYPE_LONG Int32 +#define HTYPE_UNSIGNED_LONG Word32 +#endif + +#if SIZEOF_VOID_P == 8 +#define HTYPE_PTRDIFF_T Int64 +#else +#define HTYPE_PTRDIFF_T Int32 +#endif + +#if SIZEOF_CLOCK_T == 8 +#define HTYPE_CLOCK_T Word64 +#else +#define HTYPE_CLOCK_T Word32 +#endif + +#if SIZEOF_TIME_T == 8 +#define HTYPE_TIME_T Word64 +#else +#define HTYPE_TIME_T Word32 +#endif + +#if SIZEOF_USECONDS_T == 8 +#define HTYPE_USECONDS_T Word64 +#else +#define HTYPE_USECONDS_T Word32 +#endif + +#if SIZEOF_SIZE_T == 8 +#define HTYPE_SIZE_T Word64 +#else +#define HTYPE_SIZE_T Word32 +#endif + +#if SIZEOF_WCHAR_T == 1 +#define HTYPE_WCHAR_T Word8 +#elif SIZEOF_WCHAR_T == 2 +#define HTYPE_WCHAR_T Word16 +#else +#define HTYPE_WCHAR_T Word32 +#endif + + + +/* Define to Haskell type for char */ +#define HTYPE_CHAR Int8 + +/* Define to Haskell type for double */ +#define HTYPE_DOUBLE Double + +/* Define to Haskell type for float */ +#define HTYPE_FLOAT Float + +/* Define to Haskell type for intmax_t */ +#define HTYPE_INTMAX_T Int64 + +/* Define to Haskell type for long long */ +#define HTYPE_LONG_LONG Int64 + +/* Define to Haskell type for short */ +#define HTYPE_SHORT Int16 + +/* Define to Haskell type for signed char */ +#define HTYPE_SIGNED_CHAR Int8 + +/* Define to Haskell type for uintmax_t */ +#define HTYPE_UINTMAX_T Word64 + +/* Define to Haskell type for unsigned char */ +#define HTYPE_UNSIGNED_CHAR Word8 + +/* Define to Haskell type for unsigned long long */ +#define HTYPE_UNSIGNED_LONG_LONG Word64 + +/* Define to Haskell type for unsigned short */ +#define HTYPE_UNSIGNED_SHORT Word16 + + + +/********************************************************************/ +/**** System tupes ****/ +/********************************************************************/ + +#ifdef SIZEOF_DEV_T +# if SIZEOF_DEV_T == 8 +# define HTYPE_DEV_T Word64 +# elif SIZEOF_DEV_T == 4 +# define HTYPE_DEV_T Word32 +# elif SIZEOF_DEV_T == 2 +# define HTYPE_DEV_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_INO_T +# if SIZEOF_INO_T == 8 +# define HTYPE_INO_T Word64 +# elif SIZEOF_INO_T == 4 +# define HTYPE_INO_T Word32 +# elif SIZEOF_INO_T == 2 +# define HTYPE_INO_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_MODE_T +# if SIZEOF_MODE_T == 8 +# define HTYPE_MODE_T Word64 +# elif SIZEOF_MODE_T == 4 +# define HTYPE_MODE_T Word32 +# elif SIZEOF_MODE_T == 2 +# define HTYPE_MODE_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_OFF_T +# if SIZEOF_OFF_T == 8 +# define HTYPE_OFF_T Word64 +# elif SIZEOF_OFF_T == 4 +# define HTYPE_OFF_T Word32 +# elif SIZEOF_OFF_T == 2 +# define HTYPE_OFF_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_PID_T +# if SIZEOF_PID_T == 8 +# define HTYPE_PID_T Word64 +# elif SIZEOF_PID_T == 4 +# define HTYPE_PID_T Word32 +# elif SIZEOF_PID_T == 2 +# define HTYPE_PID_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_SSIZE_T +# if SIZEOF_SSIZE_T == 8 +# define HTYPE_SSIZE_T Word64 +# elif SIZEOF_SSIZE_T == 4 +# define HTYPE_SSIZE_T Word32 +# elif SIZEOF_SSIZE_T == 2 +# define HTYPE_SSIZE_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_GID_T +# if SIZEOF_GID_T == 8 +# define HTYPE_GID_T Word64 +# elif SIZEOF_GID_T == 4 +# define HTYPE_GID_T Word32 +# elif SIZEOF_GID_T == 2 +# define HTYPE_GID_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_NLINK_T +# if SIZEOF_NLINK_T == 8 +# define HTYPE_NLINK_T Word64 +# elif SIZEOF_NLINK_T == 4 +# define HTYPE_NLINK_T Word32 +# elif SIZEOF_NLINK_T == 2 +# define HTYPE_NLINK_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_UID_T +# if SIZEOF_UID_T == 8 +# define HTYPE_UID_T Word64 +# elif SIZEOF_UID_T == 4 +# define HTYPE_UID_T Word32 +# elif SIZEOF_UID_T == 2 +# define HTYPE_UID_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_CC_T +# if SIZEOF_CC_T == 8 +# define HTYPE_CC_T Word64 +# elif SIZEOF_CC_T == 4 +# define HTYPE_CC_T Word32 +# elif SIZEOF_CC_T == 2 +# define HTYPE_CC_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_SPEED_T +# if SIZEOF_SPEED_T == 8 +# define HTYPE_SPEED_T Word64 +# elif SIZEOF_SPEED_T == 4 +# define HTYPE_SPEED_T Word32 +# elif SIZEOF_SPEED_T == 2 +# define HTYPE_SPEED_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_TCFLAG_T +# if SIZEOF_TCFLAG_T == 8 +# define HTYPE_TCFLAG_T Word64 +# elif SIZEOF_TCFLAG_T == 4 +# define HTYPE_TCFLAG_T Word32 +# elif SIZEOF_TCFLAG_T == 2 +# define HTYPE_TCFLAG_T Word16 +# else +# endif +#endif + +#ifdef SIZEOF_RLIM_T +# if SIZEOF_RLIM_T == 8 +# define HTYPE_RLIM_T Word64 +# elif SIZEOF_RLIM_T == 4 +# define HTYPE_RLIM_T Word32 +# elif SIZEOF_RLIM_T == 2 +# define HTYPE_RLIM_T Word16 +# else +# endif +#endif + +/********************************************************************/ +/**** Presence of include files ****/ +/********************************************************************/ + +#define HAVE_DIRENT_H 1 +#define HAVE_ERRNO_H 1 +#define HAVE_FCNTL_H 1 +#define HAVE_INTTYPES_H 1 +#define HAVE_LIMITS_H 1 +#define HAVE_SIGNAL_H 1 +#define HAVE_STDINT_H 1 +#define HAVE_STRING_H 1 +#define HAVE_SYS_RESOURCE_H 1 +#define HAVE_SYS_SELECT_H 1 +#define HAVE_SYS_STAT_H 1 +#define HAVE_SYS_SYSCALL_H 1 +#define HAVE_SYS_TIME_H 1 +#define HAVE_SYS_TIMEB_H 1 +/* #undef HAVE_SYS_TIMERS_H */ +#define HAVE_SYS_TIMES_H 1 +#define HAVE_SYS_TYPES_H 1 +#define HAVE_SYS_UTSNAME_H 1 +#define HAVE_SYS_WAIT_H 1 +#define HAVE_TERMIOS_H 1 +#define HAVE_TIME_H 1 +#define HAVE_UNISTD_H 1 +#define HAVE_UTIME_H 1 +/* #undef HAVE_VFORK_H */ +#define HAVE_WCTYPE_H 1 +/* #undef HAVE_WINDOWS_H */ +/* #undef HAVE_WINSOCK_H */ + +/* #undef HAVE__CHSIZE */ +#define HAVE_FTRUNCATE 1 +/* #undef HAVE_GETCLOCK */ +#define HAVE_GETRUSAGE 1 +#define HAVE_GETTIMEOFDAY 1 +#define HAVE_LSTAT 1 +#define HAVE_READDIR_R 1 + +/********************************************************************/ +/**** Runtime types ****/ +/********************************************************************/ + +#ifdef __UHC_BUILDS_O__ + +#if defined(__UHC_TARGET_BC__) || defined(__UHC_TARGET_C__) +// # define HsBool Word +// # define HsInt Word +// # define HsWord64 Word64 +// # define HsWord32 Word32 +// # define HsWord16 Word16 +// # define HsWord8 Word8 +// # ifdef __UHC_TARGET_BC__ +// # define HS_BOOL_FALSE gb_False +// # define HS_BOOL_TRUE gb_True +// # else +// # define HS_BOOL_FALSE 0 +// # define HS_BOOL_TRUE 1 +// # endif +#endif /* __UHC_TARGET_BC__ */ + +#endif /* __UHC_BUILDS_O__ */ + +/********************************************************************/ +/**** Read dir EOF error ****/ +/********************************************************************/ + +/* See remarks in GHC, libraries/base/aclocal.m4: MinGW platform returns non 0 value. We ignore that */ +#define READDIR_ERRNO_EOF 0 + +/********************************************************************/ +/**** C errors ****/ +/********************************************************************/ + +/* (1) Assume errno.h is already included */ +/* (2) Error codes like EADV are not present on all platforms, so a dummy value is provided, this should be done for all codes */ + +/* The value of E2BIG. */ +#if !defined(E2BIG) +#define E2BIG 10000 +#endif +#define CONST_E2BIG E2BIG + +/* The value of EACCES. */ +#if !defined(EACCES) +#define EACCES 10000 +#endif +#define CONST_EACCES EACCES + +/* The value of EADDRINUSE. */ +#if !defined(EADDRINUSE) +#define EADDRINUSE 10000 +#endif +#define CONST_EADDRINUSE EADDRINUSE + +/* The value of EADDRNOTAVAIL. */ +#define CONST_EADDRNOTAVAIL EADDRNOTAVAIL + +/* The value of EADV. */ +#if !defined(EADV) +#define EADV 10000 +#endif +#define CONST_EADV EADV + +/* The value of EAFNOSUPPORT. */ +#if !defined(EAFNOSUPPORT) +#define EAFNOSUPPORT 10000 +#endif +#define CONST_EAFNOSUPPORT EAFNOSUPPORT + +/* The value of EAGAIN. */ +#if !defined(EAGAIN) +#define EAGAIN 10000 +#endif +#define CONST_EAGAIN EAGAIN + +/* The value of EALREADY. */ +#if !defined(EALREADY) +#define EALREADY 10000 +#endif +#define CONST_EALREADY EALREADY + +/* The value of EBADF. */ +#if !defined(EBADF) +#define EBADF 10000 +#endif +#define CONST_EBADF EBADF + +/* The value of EBADMSG. */ +#if !defined(EBADMSG) +#define EBADMSG 10000 +#endif +#define CONST_EBADMSG EBADMSG + +/* The value of EBADRPC. */ +#if !defined(EBADRPC) +#define EBADRPC 10000 +#endif +#define CONST_EBADRPC EBADRPC + +/* The value of EBUSY. */ +#if !defined(EBUSY) +#define EBUSY 10000 +#endif +#define CONST_EBUSY EBUSY + +/* The value of ECHILD. */ +#if !defined(ECHILD) +#define ECHILD 10000 +#endif +#define CONST_ECHILD ECHILD + +/* The value of ECOMM. */ +#if !defined(ECOMM) +#define ECOMM 10000 +#endif +#define CONST_ECOMM ECOMM + +/* The value of ECONNABORTED. */ +#if !defined(ECONNABORTED) +#define ECONNABORTED 10000 +#endif +#define CONST_ECONNABORTED ECONNABORTED + +/* The value of ECONNREFUSED. */ +#if !defined(ECONNREFUSED) +#define ECONNREFUSED 10000 +#endif +#define CONST_ECONNREFUSED ECONNREFUSED + +/* The value of ECONNRESET. */ +#if !defined(ECONNRESET) +#define ECONNRESET 10000 +#endif +#define CONST_ECONNRESET ECONNRESET + +/* The value of EDEADLK. */ +#if !defined(EDEADLK) +#define EDEADLK 10000 +#endif +#define CONST_EDEADLK EDEADLK + +/* The value of EDESTADDRREQ. */ +#if !defined(EDESTADDRREQ) +#define EDESTADDRREQ 10000 +#endif +#define CONST_EDESTADDRREQ EDESTADDRREQ + +/* The value of EDIRTY. */ +#if !defined(EDIRTY) +#define EDIRTY 10000 +#endif +#define CONST_EDIRTY EDIRTY + +/* The value of EDOM. */ +#if !defined(EDOM) +#define EDOM 10000 +#endif +#define CONST_EDOM EDOM + +/* The value of EDQUOT. */ +#if !defined(EDQUOT) +#define EDQUOT 10000 +#endif +#define CONST_EDQUOT EDQUOT + +/* The value of EEXIST. */ +#if !defined(EEXIST) +#define EEXIST 10000 +#endif +#define CONST_EEXIST EEXIST + +/* The value of EFAULT. */ +#if !defined(EFAULT) +#define EFAULT 10000 +#endif +#define CONST_EFAULT EFAULT + +/* The value of EFBIG. */ +#if !defined(EFBIG) +#define EFBIG 10000 +#endif +#define CONST_EFBIG EFBIG + +/* The value of EFTYPE. */ +#if !defined(EFTYPE) +#define EFTYPE 10000 +#endif +#define CONST_EFTYPE EFTYPE + +/* The value of EHOSTDOWN. */ +#if !defined(EHOSTDOWN) +#define EHOSTDOWN 10000 +#endif +#define CONST_EHOSTDOWN EHOSTDOWN + +/* The value of EHOSTUNREACH. */ +#if !defined(EHOSTUNREACH) +#define EHOSTUNREACH 10000 +#endif +#define CONST_EHOSTUNREACH EHOSTUNREACH + +/* The value of EIDRM. */ +#if !defined(EIDRM) +#define EIDRM 10000 +#endif +#define CONST_EIDRM EIDRM + +/* The value of EILSEQ. */ +#if !defined(EILSEQ) +#define EILSEQ 10000 +#endif +#define CONST_EILSEQ EILSEQ + +/* The value of EINPROGRESS. */ +#if !defined(EINPROGRESS) +#define EINPROGRESS 10000 +#endif +#define CONST_EINPROGRESS EINPROGRESS + +/* The value of EINTR. */ +#if !defined(EINTR) +#define EINTR 10000 +#endif +#define CONST_EINTR EINTR + +/* The value of EINVAL. */ +#if !defined(EINVAL) +#define EINVAL 10000 +#endif +#define CONST_EINVAL EINVAL + +/* The value of EIO. */ +#if !defined(EIO) +#define EIO 10000 +#endif +#define CONST_EIO EIO + +/* The value of EISCONN. */ +#if !defined(EISCONN) +#define EISCONN 10000 +#endif +#define CONST_EISCONN EISCONN + +/* The value of EISDIR. */ +#if !defined(EISDIR) +#define EISDIR 10000 +#endif +#define CONST_EISDIR EISDIR + +/* The value of ELOOP. */ +#if !defined(ELOOP) +#define ELOOP 10000 +#endif +#define CONST_ELOOP ELOOP + +/* The value of EMFILE. */ +#if !defined(EMFILE) +#define EMFILE 10000 +#endif +#define CONST_EMFILE EMFILE + +/* The value of EMLINK. */ +#if !defined(EMLINK) +#define EMLINK 10000 +#endif +#define CONST_EMLINK EMLINK + +/* The value of EMSGSIZE. */ +#if !defined(EMSGSIZE) +#define EMSGSIZE 10000 +#endif +#define CONST_EMSGSIZE EMSGSIZE + +/* The value of EMULTIHOP. */ +#if !defined(EMULTIHOP) +#define EMULTIHOP 10000 +#endif +#define CONST_EMULTIHOP EMULTIHOP + +/* The value of ENAMETOOLONG. */ +#if !defined(ENAMETOOLONG) +#define ENAMETOOLONG 10000 +#endif +#define CONST_ENAMETOOLONG ENAMETOOLONG + +/* The value of ENETDOWN. */ +#if !defined(ENETDOWN) +#define ENETDOWN 10000 +#endif +#define CONST_ENETDOWN ENETDOWN + +/* The value of ENETRESET. */ +#if !defined(ENETRESET) +#define ENETRESET 10000 +#endif +#define CONST_ENETRESET ENETRESET + +/* The value of ENETUNREACH. */ +#if !defined(ENETUNREACH) +#define ENETUNREACH 10000 +#endif +#define CONST_ENETUNREACH ENETUNREACH + +/* The value of ENFILE. */ +#if !defined(ENFILE) +#define ENFILE 10000 +#endif +#define CONST_ENFILE ENFILE + +/* The value of ENOBUFS. */ +#if !defined(ENOBUFS) +#define ENOBUFS 10000 +#endif +#define CONST_ENOBUFS ENOBUFS + +/* The value of ENOCIGAR. */ +#if !defined(ENOCIGAR) +#define ENOCIGAR 10000 +#endif +#define CONST_ENOCIGAR ENOCIGAR + +/* The value of ENODATA. */ +#if !defined(ENODATA) +#define ENODATA 10000 +#endif +#define CONST_ENODATA ENODATA + +/* The value of ENODEV. */ +#if !defined(ENODEV) +#define ENODEV 10000 +#endif +#define CONST_ENODEV ENODEV + +/* The value of ENOENT. */ +#if !defined(ENOENT) +#define ENOENT 10000 +#endif +#define CONST_ENOENT ENOENT + +/* The value of ENOEXEC. */ +#if !defined(ENOEXEC) +#define ENOEXEC 10000 +#endif +#define CONST_ENOEXEC ENOEXEC + +/* The value of ENOLCK. */ +#if !defined(ENOLCK) +#define ENOLCK 10000 +#endif +#define CONST_ENOLCK ENOLCK + +/* The value of ENOLINK. */ +#if !defined(ENOLINK) +#define ENOLINK 10000 +#endif +#define CONST_ENOLINK ENOLINK + +/* The value of ENOMEM. */ +#if !defined(ENOMEM) +#define ENOMEM 10000 +#endif +#define CONST_ENOMEM ENOMEM + +/* The value of ENOMSG. */ +#if !defined(ENOMSG) +#define ENOMSG 10000 +#endif +#define CONST_ENOMSG ENOMSG + +/* The value of ENONET. */ +#if !defined(ENONET) +#define ENONET 10000 +#endif +#define CONST_ENONET ENONET + +/* The value of ENOPROTOOPT. */ +#if !defined(ENOPROTOOPT) +#define ENOPROTOOPT 10000 +#endif +#define CONST_ENOPROTOOPT ENOPROTOOPT + +/* The value of ENOSPC. */ +#if !defined(ENOSPC) +#define ENOSPC 10000 +#endif +#define CONST_ENOSPC ENOSPC + +/* The value of ENOSR. */ +#if !defined(ENOSR) +#define ENOSR 10000 +#endif +#define CONST_ENOSR ENOSR + +/* The value of ENOSTR. */ +#if !defined(ENOSTR) +#define ENOSTR 10000 +#endif +#define CONST_ENOSTR ENOSTR + +/* The value of ENOSYS. */ +#if !defined(ENOSYS) +#define ENOSYS 10000 +#endif +#define CONST_ENOSYS ENOSYS + +/* The value of ENOTBLK. */ +#if !defined(ENOTBLK) +#define ENOTBLK 10000 +#endif +#define CONST_ENOTBLK ENOTBLK + +/* The value of ENOTCONN. */ +#if !defined(ENOTCONN) +#define ENOTCONN 10000 +#endif +#define CONST_ENOTCONN ENOTCONN + +/* The value of ENOTDIR. */ +#if !defined(ENOTDIR) +#define ENOTDIR 10000 +#endif +#define CONST_ENOTDIR ENOTDIR + +/* The value of ENOTEMPTY. */ +#if !defined(ENOTEMPTY) +#define ENOTEMPTY 10000 +#endif +#define CONST_ENOTEMPTY ENOTEMPTY + +/* The value of ENOTSOCK. */ +#if !defined(ENOTSOCK) +#define ENOTSOCK 10000 +#endif +#define CONST_ENOTSOCK ENOTSOCK + +/* The value of ENOTTY. */ +#if !defined(ENOTTY) +#define ENOTTY 10000 +#endif +#define CONST_ENOTTY ENOTTY + +/* The value of ENXIO. */ +#if !defined(ENXIO) +#define ENXIO 10000 +#endif +#define CONST_ENXIO ENXIO + +/* The value of EOPNOTSUPP. */ +#if !defined(EOPNOTSUPP) +#define EOPNOTSUPP 10000 +#endif +#define CONST_EOPNOTSUPP EOPNOTSUPP + +/* The value of EPERM. */ +#if !defined(EPERM) +#define EPERM 10000 +#endif +#define CONST_EPERM EPERM + +/* The value of EPFNOSUPPORT. */ +#if !defined(EPFNOSUPPORT) +#define EPFNOSUPPORT 10000 +#endif +#define CONST_EPFNOSUPPORT EPFNOSUPPORT + +/* The value of EPIPE. */ +#if !defined(EPIPE) +#define EPIPE 10000 +#endif +#define CONST_EPIPE EPIPE + +/* The value of EPROCLIM. */ +#if !defined(EPROCLIM) +#define EPROCLIM 10000 +#endif +#define CONST_EPROCLIM EPROCLIM + +/* The value of EPROCUNAVAIL. */ +#if !defined(EPROCUNAVAIL) +#define EPROCUNAVAIL 10000 +#endif +#define CONST_EPROCUNAVAIL EPROCUNAVAIL + +/* The value of EPROGMISMATCH. */ +#if !defined(EPROGMISMATCH) +#define EPROGMISMATCH 10000 +#endif +#define CONST_EPROGMISMATCH EPROGMISMATCH + +/* The value of EPROGUNAVAIL. */ +#if !defined(EPROGUNAVAIL) +#define EPROGUNAVAIL 10000 +#endif +#define CONST_EPROGUNAVAIL EPROGUNAVAIL + +/* The value of EPROTO. */ +#if !defined(EPROTO) +#define EPROTO 10000 +#endif +#define CONST_EPROTO EPROTO + +/* The value of EPROTONOSUPPORT. */ +#if !defined(EPROTONOSUPPORT) +#define EPROTONOSUPPORT 10000 +#endif +#define CONST_EPROTONOSUPPORT EPROTONOSUPPORT + +/* The value of EPROTOTYPE. */ +#if !defined(EPROTOTYPE) +#define EPROTOTYPE 10000 +#endif +#define CONST_EPROTOTYPE EPROTOTYPE + +/* The value of ERANGE. */ +#if !defined(ERANGE) +#define ERANGE 10000 +#endif +#define CONST_ERANGE ERANGE + +/* The value of EREMCHG. */ +#if !defined(EREMCHG) +#define EREMCHG 10000 +#endif +#define CONST_EREMCHG EREMCHG + +/* The value of EREMOTE. */ +#if !defined(EREMOTE) +#define EREMOTE 10000 +#endif +#define CONST_EREMOTE EREMOTE + +/* The value of EROFS. */ +#if !defined(EROFS) +#define EROFS 10000 +#endif +#define CONST_EROFS EROFS + +/* The value of ERPCMISMATCH. */ +#if !defined(ERPCMISMATCH) +#define ERPCMISMATCH 10000 +#endif +#define CONST_ERPCMISMATCH ERPCMISMATCH + +/* The value of ERREMOTE. */ +#if !defined(ERREMOTE) +#define ERREMOTE 10000 +#endif +#define CONST_ERREMOTE ERREMOTE + +/* The value of ESHUTDOWN. */ +#if !defined(ESHUTDOWN) +#define ESHUTDOWN 10000 +#endif +#define CONST_ESHUTDOWN ESHUTDOWN + +/* The value of ESOCKTNOSUPPORT. */ +#if !defined(ESOCKTNOSUPPORT) +#define ESOCKTNOSUPPORT 10000 +#endif +#define CONST_ESOCKTNOSUPPORT ESOCKTNOSUPPORT + +/* The value of ESPIPE. */ +#if !defined(ESPIPE) +#define ESPIPE 10000 +#endif +#define CONST_ESPIPE ESPIPE + +/* The value of ESRCH. */ +#if !defined(ESRCH) +#define ESRCH 10000 +#endif +#define CONST_ESRCH ESRCH + +/* The value of ESRMNT. */ +#if !defined(ESRMNT) +#define ESRMNT 10000 +#endif +#define CONST_ESRMNT ESRMNT + +/* The value of ESTALE. */ +#if !defined(ESTALE) +#define ESTALE 10000 +#endif +#define CONST_ESTALE ESTALE + +/* The value of ETIME. */ +#if !defined(ETIME) +#define ETIME 10000 +#endif +#define CONST_ETIME ETIME + +/* The value of ETIMEDOUT. */ +#if !defined(ETIMEDOUT) +#define ETIMEDOUT 10000 +#endif +#define CONST_ETIMEDOUT ETIMEDOUT + +/* The value of ETOOMANYREFS. */ +#if !defined(ETOOMANYREFS) +#define ETOOMANYREFS 10000 +#endif +#define CONST_ETOOMANYREFS ETOOMANYREFS + +/* The value of ETXTBSY. */ +#if !defined(ETXTBSY) +#define ETXTBSY 10000 +#endif +#define CONST_ETXTBSY ETXTBSY + +/* The value of EUSERS. */ +#if !defined(EUSERS) +#define EUSERS 10000 +#endif +#define CONST_EUSERS EUSERS + +/* The value of EWOULDBLOCK. */ +#if !defined(EWOULDBLOCK) +#define EWOULDBLOCK 10000 +#endif +#define CONST_EWOULDBLOCK EWOULDBLOCK + +/* The value of EXDEV. */ +#if !defined(EXDEV) +#define EXDEV 10000 +#endif +#define CONST_EXDEV EXDEV + +/* The value of O_BINARY. */ +#if !defined(O_BINARY) +#define O_BINARY 10000 +#endif +#define CONST_O_BINARY O_BINARY + +/* The value of SIGINT. */ +#if !defined(SIGINT) +#define SIGINT 10000 +#endif +#define CONST_SIGINT SIGINT + + +#endif + diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/IntLikeInstance.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/IntLikeInstance.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/IntLikeInstance.h @@ -0,0 +1,242 @@ +{- -------------------------------------------------------------------------- +// Macros to help make various instances for Int like types (Int8, ...). +// +// Primitives are defined by 2 forms of macros: +// - starting with PRIMS_ : name of Haskell function and primitive is the same +// - starting with PRIMS2_ : name of primitive is given explicitly, to allow sharing between primitives +// -------------------------------------------------------------------------- +-} + +-- define conversion primitives +#define PRIMS_CONVERSION_INTEGER(tycon,primIntegerTo,primToInteger) \ +foreign import prim primIntegerTo :: Integer -> tycon ; \ +foreign import prim primToInteger :: tycon -> Integer + +#define PRIMS2_CONVERSION_INTEGER(tycon,primIntegerTo,primIntegerToNm,primToInteger,primToIntegerNm) \ +foreign import prim primIntegerToNm primIntegerTo :: Integer -> tycon ; \ +foreign import prim primToIntegerNm primToInteger :: tycon -> Integer + +#define PRIMS_CONVERSION_INT(tycon,primIntTo,primToInt) \ +foreign import prim primIntTo :: Int -> tycon ; \ +foreign import prim primToInt :: tycon -> Int + + +-- define Eq primitives +#define PRIMS_EQ(tycon,primEq,primNe) \ +foreign import prim primEq :: tycon -> tycon -> Bool ; \ +foreign import prim primNe :: tycon -> tycon -> Bool + +#define PRIMS2_EQ(tycon,primEq,primEqNm,primNe,primNeNm) \ +foreign import prim primEqNm primEq :: tycon -> tycon -> Bool ; \ +foreign import prim primNeNm primNe :: tycon -> tycon -> Bool + + +-- define Eq instance +#define INSTANCE_EQ(tycon,primEq,primNe) \ +instance Eq tycon where \ + { (==) = primEq ; \ + (/=) = primNe \ + } + + +-- define Ord primitives + +#define PRIMS_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \ +foreign import prim primCmp :: tycon -> tycon -> Ordering ; \ +foreign import prim primLt :: tycon -> tycon -> Bool ; \ +foreign import prim primGt :: tycon -> tycon -> Bool ; \ +foreign import prim primLe :: tycon -> tycon -> Bool ; \ +foreign import prim primGe :: tycon -> tycon -> Bool + +#define PRIMS2_ORD(tycon,primCmp,primCmpNm,primLt,primLtNm,primGt,primGtNm,primLe,primLeNm,primGe,primGeNm) \ +foreign import prim primCmpNm primCmp :: tycon -> tycon -> Ordering ; \ +foreign import prim primLtNm primLt :: tycon -> tycon -> Bool ; \ +foreign import prim primGtNm primGt :: tycon -> tycon -> Bool ; \ +foreign import prim primLeNm primLe :: tycon -> tycon -> Bool ; \ +foreign import prim primGeNm primGe :: tycon -> tycon -> Bool + + +-- define Ord instance + +#define INSTANCE_ORD(tycon,primCmp,primLt,primGt,primLe,primGe) \ +instance Ord tycon where \ + { compare = primCmp \ + ; (<) = primLt \ + ; (>) = primGt \ + ; (<=) = primLe \ + ; (>=) = primGe \ + } + + +-- define Bounded primitives +#define PRIMS_BOUNDED(tycon,primMin,primMax) \ +foreign import prim primMin :: tycon ; \ +foreign import prim primMax :: tycon + + +-- define Bounded instance +#define INSTANCE_BOUNDED(tycon,primMin,primMax) \ +instance Bounded tycon where \ + { minBound = primMin \ + ; maxBound = primMax \ + } + + +-- define Num primitives +#define PRIMS_NUM(tycon,primAdd,primSub,primMul,primNeg) \ +foreign import prim primAdd :: tycon -> tycon -> tycon ; \ +foreign import prim primSub :: tycon -> tycon -> tycon ; \ +foreign import prim primMul :: tycon -> tycon -> tycon ; \ +foreign import prim primNeg :: tycon -> tycon + +#define PRIMS2_NUM(tycon,primAdd,primAddNm,primSub,primSubNm,primMul,primMulNm,primNeg,primNegNm) \ +foreign import prim primAddNm primAdd :: tycon -> tycon -> tycon ; \ +foreign import prim primSubNm primSub :: tycon -> tycon -> tycon ; \ +foreign import prim primMulNm primMul :: tycon -> tycon -> tycon ; \ +foreign import prim primNegNm primNeg :: tycon -> tycon + + +-- define Num instance +#define INSTANCE_NUM(tycon,primAdd,primSub,primMul,primNeg,primIntegerTo,primIntTo) \ +instance Num tycon where \ + { (+) = primAdd \ + ; (-) = primSub \ + ; (*) = primMul \ + ; negate = primNeg \ + ; fromInteger = primIntegerTo \ + ; fromInt = primIntTo \ + ; abs = absReal \ + ; signum = signumReal \ + } + + +-- define Enum instance +#define INSTANCE_ENUM(tycon,primToEnum,primFromEnum) \ +instance Enum tycon where \ + { succ = boundedSucc \ + ; pred = boundedPred \ + ; toEnum = primToEnum \ + ; fromEnum = primFromEnum \ + ; enumFrom = boundedEnumFrom \ + ; enumFromTo = boundedEnumFromTo \ + ; enumFromThen = boundedEnumFromThen \ + ; enumFromThenTo = boundedEnumFromThenTo \ + } + + +-- define Real instance +#define INSTANCE_REAL(tycon) \ +instance Real tycon where \ + { toRational x = toInteger x % 1 \ + } + + +-- define Integral primitives +#define PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) \ +foreign import prim primDiv :: tycon -> tycon -> tycon ; \ +foreign import prim primMod :: tycon -> tycon -> tycon ; \ +foreign import prim primQuot :: tycon -> tycon -> tycon ; \ +foreign import prim primRem :: tycon -> tycon -> tycon + +#define PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primRemNm) \ +foreign import prim primDivNm primDiv :: tycon -> tycon -> tycon ; \ +foreign import prim primModNm primMod :: tycon -> tycon -> tycon ; \ +foreign import prim primQuotNm primQuot :: tycon -> tycon -> tycon ; \ +foreign import prim primRemNm primRem :: tycon -> tycon -> tycon + +#define PRIMS_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem) \ +PRIMS_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem) ; \ +foreign import prim primDivMod :: tycon -> tycon -> (tycon,tycon) ; \ +foreign import prim primQuotRem :: tycon -> tycon -> (tycon,tycon) + +#define PRIMS2_INTEGRAL2(tycon,primDiv,primDivNm,primMod,primModNm,primDivMod,primDivModNm,primQuot,primQuotNm,primRem,primRemNm,primQuotRem,primQuotRemNm) \ +PRIMS2_INTEGRAL1(tycon,primDiv,primDivNm,primMod,primModNm,primQuot,primQuotNm,primRem,primQuotRemNm) ; \ +foreign import prim primDivModNm primDivMod :: tycon -> tycon -> (tycon,tycon) ; \ +foreign import prim primQuotRemNm primQuotRem :: tycon -> tycon -> (tycon,tycon) + + +-- define Integral instance, assume default for divMod +#define INSTANCE_INTEGRAL1(tycon,primDiv,primMod,primQuot,primRem,primToInteger,primToInt) \ +instance Integral tycon where \ + { quotRem d m \ + = (primQuot d m, primRem d m) \ + ; div = primDiv \ + ; quot = primQuot \ + ; rem = primRem \ + ; mod = primMod \ + ; toInteger = primToInteger \ + ; toInt = primToInt \ + } + +#define INSTANCE_INTEGRAL2(tycon,primDiv,primMod,primDivMod,primQuot,primRem,primQuotRem,primToInteger,primToInt) \ +instance Integral tycon where \ + { divMod = primDivMod \ + ; quotRem = primQuotRem \ + ; div = primDiv \ + ; quot = primQuot \ + ; rem = primRem \ + ; mod = primMod \ + ; toInteger = primToInteger \ + ; toInt = primToInt \ + } + + +-- define Show instance +#define INSTANCE_SHOW(tycon) \ +instance Show tycon where \ + { show = show . toInteger \ + } + + +-- define Read instance +#define INSTANCE_READ(tycon) \ +instance Read tycon where \ + { readsPrec p = readSigned readDec \ + } + + +-- define Bits primitives +#define PRIMS_BITLOGIC(tycon,primAnd,primOr,primXor) \ +foreign import prim primAnd :: tycon -> tycon -> tycon ; \ +foreign import prim primOr :: tycon -> tycon -> tycon ; \ +foreign import prim primXor :: tycon -> tycon -> tycon + +#define PRIMS_BITSHIFT(tycon,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \ +foreign import prim primComplement :: tycon -> tycon ; \ +foreign import prim primShiftLeft :: tycon -> Int -> tycon ; \ +foreign import prim primShiftRight :: tycon -> Int -> tycon ; \ +foreign import prim primRotateLeft :: tycon -> Int -> tycon ; \ +foreign import prim primRotateRight :: tycon -> Int -> tycon + +#define PRIMS2_BITLOGIC(tycon,primAnd,primAndNm,primOr,primOrNm,primXor,primXorNm) \ +foreign import prim primAndNm primAnd :: tycon -> tycon -> tycon ; \ +foreign import prim primOrNm primOr :: tycon -> tycon -> tycon ; \ +foreign import prim primXorNm primXor :: tycon -> tycon -> tycon + +#define PRIMS2_BITSHIFT(tycon,primComplement,primComplementNm,primShiftLeft,primShiftLeftNm,primShiftRight,primShiftRightNm,primRotateLeft,primRotateLeftNm,primRotateRight,primRotateRightNm) \ +foreign import prim primComplementNm primComplement :: tycon -> tycon ; \ +foreign import prim primShiftLeftNm primShiftLeft :: tycon -> Int -> tycon ; \ +foreign import prim primShiftRightNm primShiftRight :: tycon -> Int -> tycon ; \ +foreign import prim primRotateLeftNm primRotateLeft :: tycon -> Int -> tycon ; \ +foreign import prim primRotateRightNm primRotateRight :: tycon -> Int -> tycon + +-- define Bits instance +#define INSTANCE_BITS1(tycon,size,signed,primAnd,primOr,primXor,primComplement,primShiftLeft,primShiftRight,primRotateLeft,primRotateRight) \ +instance Bits tycon where \ + { (.&.) = primAnd \ + ; (.|.) = primOr \ + ; xor = primXor \ + ; complement = primComplement \ + ; shiftL = primShiftLeft \ + ; shiftR = primShiftRight \ + ; rotateL = primRotateLeft \ + ; rotateR = primRotateRight \ + ; bitSize _ = size \ + ; isSigned _ = signed \ + } + + + + + + diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/MachDeps.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/MachDeps.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/MachDeps.h @@ -0,0 +1,125 @@ +/* ehclib/uhcbase/include/MachDeps.h. Generated from MachDeps.h.in by configure. */ +#ifndef MACHDEPS_H +#define MACHDEPS_H + +#define SIZEOF_INTPTR_T 8 +#define SIZEOF_CHAR 1 +#define SIZEOF_SHORT 2 +#define SIZEOF_INT 4 +#define SIZEOF_LONG 8 +#define SIZEOF_LONG_LONG 8 +#define SIZEOF_FLOAT 4 +#define SIZEOF_DOUBLE 8 +#define SIZEOF_UNSIGNED_CHAR 1 +#define SIZEOF_UNSIGNED_SHORT 2 +#define SIZEOF_UNSIGNED_INT 4 +#define SIZEOF_UNSIGNED_LONG 8 +#define SIZEOF_UNSIGNED_LONG_LONG 8 +#define SIZEOF_VOID_P 8 + +#define SIZEOF_DEV_T 4 +#define SIZEOF_INO_T 8 +#define SIZEOF_OFF_T 8 +#define SIZEOF_MODE_T 2 +#define SIZEOF_PID_T 4 +#define SIZEOF_SSIZE_T 8 +#define SIZEOF_GID_T 4 +#define SIZEOF_NLINK_T 2 +#define SIZEOF_UID_T 4 +#define SIZEOF_RLIM_T 8 +#define SIZEOF_CLOCK_T 8 +#define SIZEOF_TIME_T 8 +#define SIZEOF_SIZE_T 8 +#define SIZEOF_WCHAR_T 4 + +#define SIZEOF_CC_T 1 +#define SIZEOF_SPEED_T 8 +#define SIZEOF_TCFLAG_T 8 + +#define ALIGNOF_INTPTR_T 8 +#define ALIGNOF_CHAR 1 +#define ALIGNOF_SHORT 2 +#define ALIGNOF_INT 4 +#define ALIGNOF_LONG 8 +#define ALIGNOF_LONG_LONG 8 +#define ALIGNOF_FLOAT 4 +#define ALIGNOF_DOUBLE 8 +#define ALIGNOF_UNSIGNED_CHAR 1 +#define ALIGNOF_UNSIGNED_SHORT 2 +#define ALIGNOF_UNSIGNED_INT 4 +#define ALIGNOF_UNSIGNED_LONG 8 +#define ALIGNOF_UNSIGNED_LONG_LONG 8 +#define ALIGNOF_VOID_P 8 + +#define ALIGNOF_UINT8_T 1 +#define ALIGNOF_UINT16_T 2 +#define ALIGNOF_UINT32_T 4 +#define ALIGNOF_UINT64_T 8 + +#if SIZEOF_INTPTR_T == 8 +#define USE_64_BITS 1 +#define USE_32_BITS 0 +#else +#define USE_64_BITS 0 +#define USE_32_BITS 1 +#endif + +#ifdef __UHC_TARGET_BC__ +#define BITSIZEOF_WORDTAG 1 +#else +#define BITSIZEOF_WORDTAG 0 +#endif + +#define SIZEOF_HSCHAR SIZEOF_INTPTR_T +#define ALIGNMENT_HSCHAR ALIGNOF_UINT32_T + +#define SIZEOF_HSINT SIZEOF_INTPTR_T +#define ALIGNMENT_HSINT ALIGNOF_INTPTR_T + +#define SIZEOF_HSWORD SIZEOF_INTPTR_T +#define ALIGNMENT_HSWORD ALIGNOF_INTPTR_T + +#define SIZEOF_HSDOUBLE SIZEOF_DOUBLE +#define ALIGNMENT_HSDOUBLE ALIGNOF_DOUBLE + +#define SIZEOF_HSFLOAT SIZEOF_FLOAT +#define ALIGNMENT_HSFLOAT ALIGNOF_FLOAT + +#define SIZEOF_HSPTR SIZEOF_VOID_P +#define ALIGNMENT_HSPTR ALIGNOF_VOID_P + +#define SIZEOF_HSFUNPTR SIZEOF_VOID_P +#define ALIGNMENT_HSFUNPTR ALIGNOF_VOID_P + +#define SIZEOF_HSFOREIGNPTR SIZEOF_VOID_P +#define ALIGNMENT_HSFOREIGNPTR ALIGNOF_VOID_P + +#define SIZEOF_HSSTABLEPTR SIZEOF_VOID_P +#define ALIGNMENT_HSSTABLEPTR ALIGNOF_VOID_P + +#define SIZEOF_INT8 8 +#define ALIGNMENT_INT8 ALIGNOF_UINT8_T + +#define SIZEOF_WORD8 8 +#define ALIGNMENT_WORD8 ALIGNOF_UINT8_T + +#define SIZEOF_INT16 16 +#define ALIGNMENT_INT16 ALIGNOF_UINT16_T + +#define SIZEOF_WORD16 16 +#define ALIGNMENT_WORD16 ALIGNOF_UINT16_T + +#define SIZEOF_INT32 32 +#define ALIGNMENT_INT32 ALIGNOF_UINT32_T + +#define SIZEOF_WORD32 32 +#define ALIGNMENT_WORD32 ALIGNOF_UINT32_T + +#define SIZEOF_INT64 64 +#define ALIGNMENT_INT64 ALIGNOF_UINT64_T + +#define SIZEOF_WORD64 64 +#define ALIGNMENT_WORD64 ALIGNOF_UINT64_T + + +#endif diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/TupleInstance.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/TupleInstance.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/TupleInstance.h @@ -0,0 +1,147 @@ +{- -------------------------------------------------------------------------- +// Macros to help make various instances for tuples. +// A kind of poor mans deriving. +// +// -------------------------------------------------------------------------- +-} + +#define COMMA , + +{- -------------------------------------------------------------------------- +// 2 tuple, 1 unary op +// -------------------------------------------------------------------------- +-} +#define TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +instance (clscon a, clscon b) => clscon (a,b) where \ + { op1 op1preArg (a,b) op1postArg \ + = pre \ + op1subop a \ + sep op1subop b \ + post \ + } + +{- -------------------------------------------------------------------------- +// 3 tuple, 1 unary op +// -------------------------------------------------------------------------- +-} +#define TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \ + { op1 op1preArg (a,b,c) op1postArg \ + = pre \ + op1subop a \ + sep op1subop b \ + sep op1subop c \ + post \ + } + +{- -------------------------------------------------------------------------- +// 4 tuple, 1 unary op +// -------------------------------------------------------------------------- +-} +#define TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \ + { op1 op1preArg (a,b,c,d) op1postArg \ + = pre \ + op1subop a \ + sep op1subop b \ + sep op1subop c \ + sep op1subop d \ + post \ + } + +{- -------------------------------------------------------------------------- +// 5 tuple, 1 unary op +// -------------------------------------------------------------------------- +-} +#define TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \ + { op1 op1preArg (a,b,c,d,e) op1postArg \ + = pre \ + op1subop a \ + sep op1subop b \ + sep op1subop c \ + sep op1subop d \ + sep op1subop e \ + post \ + } + +{- -------------------------------------------------------------------------- +// Set of 2..n tuple, 1 unary op +// -------------------------------------------------------------------------- +-} +#define TUPLE_UNOP1_INSTANCES(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +{ TUPLE2_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\ + TUPLE3_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\ + TUPLE4_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) ;\ + TUPLE5_UNOP1_INSTANCE(clscon,op1,op1preArg,op1postArg,op1subop,pre,sep,post) \ +} + +{- -------------------------------------------------------------------------- +// 2 tuple, 1 binary op +// -------------------------------------------------------------------------- +-} +#define TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \ +instance (clscon a, clscon b) => clscon (a,b) where \ + { (a1,b1) op1 (a2,b2) \ + = pre \ + a1 op1subop a2 \ + sep b1 op1subop b2 \ + post \ + } + +{- -------------------------------------------------------------------------- +// 3 tuple, 1 binary op +// -------------------------------------------------------------------------- +-} +#define TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c) => clscon (a,b,c) where \ + { (a1,b1,c1) op1 (a2,b2,c2) \ + = pre \ + a1 op1subop a2 \ + sep b1 op1subop b2 \ + sep c1 op1subop c2 \ + post \ + } + +{- -------------------------------------------------------------------------- +// 4 tuple, 1 binary op +// -------------------------------------------------------------------------- +-} +#define TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c, clscon d) => clscon (a,b,c,d) where \ + { (a1,b1,c1,d1) op1 (a2,b2,c2,d2) \ + = pre \ + a1 op1subop a2 \ + sep b1 op1subop b2 \ + sep c1 op1subop c2 \ + sep d1 op1subop d2 \ + post \ + } + +{- -------------------------------------------------------------------------- +// 5 tuple, 1 binary op +// -------------------------------------------------------------------------- +-} +#define TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \ +instance (clscon a, clscon b, clscon c, clscon d, clscon e) => clscon (a,b,c,d,e) where \ + { (a1,b1,c1,d1,e1) op1 (a2,b2,c2,d2,e2) \ + = pre \ + a1 op1subop a2 \ + sep b1 op1subop b2 \ + sep c1 op1subop c2 \ + sep d1 op1subop d2 \ + sep e1 op1subop e2 \ + post \ + } + +{- -------------------------------------------------------------------------- +// Set of 2..n tuple, 1 binary op +// -------------------------------------------------------------------------- +-} +#define TUPLE_BINOP1_INSTANCES(clscon,op1,op1subop,pre,sep,post) \ +{ TUPLE2_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\ + TUPLE3_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\ + TUPLE4_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) ;\ + TUPLE5_BINOP1_INSTANCE(clscon,op1,op1subop,pre,sep,post) \ +} + diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/Typeable.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/Typeable.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/Typeable.h @@ -0,0 +1,149 @@ +{- -------------------------------------------------------------------------- +// Macros to help make Typeable instances. +// +// INSTANCE_TYPEABLEn(tc,tcname,"tc") defines +// +// instance Typeable/n/ tc +// instance Typeable a => Typeable/n-1/ (tc a) +// instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b) +// ... +// instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an) +// -------------------------------------------------------------------------- +-} + +#ifndef TYPEABLE_H +#define TYPEABLE_H + +#define INSTANCE_TYPEABLE0(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable tycon where { typeOf _ = mkTyConApp tcname [] } + +#ifdef __GLASGOW_HASKELL__ + +-- // For GHC, the extra instances follow from general instance declarations +-- // defined in Data.Typeable. + +#define INSTANCE_TYPEABLE1(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE2(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE3(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE4(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE5(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE6(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] } + +#define INSTANCE_TYPEABLE7(tycon,tcname,str) \ +tcname :: TyCon; \ +tcname = mkTyCon str; \ +instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] } + +#else /* !__GLASGOW_HASKELL__ */ + +#define INSTANCE_TYPEABLE1(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable1 tycon where { typeOf1 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable (tycon a) where { typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE2(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable2 tycon where { typeOf2 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable1 (tycon a) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b) => Typeable (tycon a b) where { \ + typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE3(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable3 tycon where { typeOf3 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable2 (tycon a) where { \ + typeOf2 = typeOf2Default }; \ +instance (Typeable a, Typeable b) => Typeable1 (tycon a b) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b, Typeable c) => Typeable (tycon a b c) where { \ + typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE4(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable4 tycon where { typeOf4 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable3 (tycon a) where { \ + typeOf3 = typeOf3Default }; \ +instance (Typeable a, Typeable b) => Typeable2 (tycon a b) where { \ + typeOf2 = typeOf2Default }; \ +instance (Typeable a, Typeable b, Typeable c) => Typeable1 (tycon a b c) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable (tycon a b c d) where { \ + typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE5(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable5 tycon where { typeOf5 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable4 (tycon a) where { \ + typeOf4 = typeOf4Default }; \ +instance (Typeable a, Typeable b) => Typeable3 (tycon a b) where { \ + typeOf3 = typeOf3Default }; \ +instance (Typeable a, Typeable b, Typeable c) => Typeable2 (tycon a b c) where { \ + typeOf2 = typeOf2Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable1 (tycon a b c d) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable (tycon a b c d e) where { \ + typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE6(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable6 tycon where { typeOf6 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable5 (tycon a) where { \ + typeOf5 = typeOf5Default }; \ +instance (Typeable a, Typeable b) => Typeable4 (tycon a b) where { \ + typeOf4 = typeOf4Default }; \ +instance (Typeable a, Typeable b, Typeable c) => Typeable3 (tycon a b c) where { \ + typeOf3 = typeOf3Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable2 (tycon a b c d) where { \ + typeOf2 = typeOf2Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable1 (tycon a b c d e) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable (tycon a b c d e f) where { \ + typeOf = typeOfDefault } + +#define INSTANCE_TYPEABLE7(tycon,tcname,str) \ +tcname = mkTyCon str; \ +instance Typeable7 tycon where { typeOf7 _ = mkTyConApp tcname [] }; \ +instance Typeable a => Typeable6 (tycon a) where { \ + typeOf6 = typeOf6Default }; \ +instance (Typeable a, Typeable b) => Typeable5 (tycon a b) where { \ + typeOf5 = typeOf5Default }; \ +instance (Typeable a, Typeable b, Typeable c) => Typeable4 (tycon a b c) where { \ + typeOf4 = typeOf4Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d) => Typeable3 (tycon a b c d) where { \ + typeOf3 = typeOf3Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e) => Typeable2 (tycon a b c d e) where { \ + typeOf2 = typeOf2Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f) => Typeable1 (tycon a b c d e f) where { \ + typeOf1 = typeOf1Default }; \ +instance (Typeable a, Typeable b, Typeable c, Typeable d, Typeable e, Typeable f, Typeable g) => Typeable (tycon a b c d e f g) where { \ + typeOf = typeOfDefault } + +#endif /* !__GLASGOW_HASKELL__ */ + +#endif diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/dirUtils.h b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/dirUtils.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/dirUtils.h @@ -0,0 +1,11 @@ +/* + * (c) The University of Glasgow 2002 + * + * Directory Runtime Support + */ +#ifndef __DIRUTILS_H__ +#define __DIRUTILS_H__ + +extern int __hscore_readdir(DIR *dirPtr, struct dirent **pDirEnt); + +#endif /* __DIRUTILS_H__ */ diff --git a/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/installed-pkg-config b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/installed-pkg-config new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/installed-pkg-config @@ -0,0 +1,2 @@ +exposed-modules: Control.Monad Data.Bits Data.Char Data.Either Data.Int Data.IORef Data.List Data.Maybe Data.Typeable Data.Word Debug.Trace Foreign.C.Error Foreign.C.String Foreign.C.Types Foreign.C Foreign.ForeignPtr Foreign.Marshal.Alloc Foreign.Marshal.Array Foreign.Marshal.Error Foreign.Marshal.Pool Foreign.Marshal.Utils Foreign.Marshal Foreign.Ptr Foreign.StablePtr Foreign.Storable Foreign System.IO.Error System.IO.Fix System.IO.Unsafe System.IO System.Posix.Internals System.Posix.Types UHC.Array UHC.Base UHC.Bits UHC.Bounded UHC.BoxArray UHC.ByteArray UHC.Char UHC.Conc UHC.Enum UHC.Eq UHC.Float UHC.ForeignPtr UHC.GC UHC.Generics.Tuple UHC.Generics UHC.Handle UHC.Int UHC.IO UHC.IOBase UHC.Ix UHC.LazyST UHC.MutVar UHC.MVar UHC.OldException UHC.OldIO UHC.Ord UHC.Prims UHC.Ptr UHC.Read UHC.Real UHC.Run UHC.Show UHC.ST UHC.StablePtr UHC.StackTrace UHC.Storable UHC.STRef UHC.Types UHC.Weak UHC.WeakPtr UHC.Word Unsafe.Coerce +build-depends: diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,41 @@ +The Utrecht Haskell Compiler (UHC) License +========================================== + +UHC follows the advertisement free BSD license, of which the basic +template can be found here: + + http://www.opensource.org/licenses/bsd-license.php + +UHC uses the following libraries with their own license: +- Library code from the GHC distribution, see comment in the modules in ehclib + +License text +============ + +Copyright (c) 2009-2010, Utrecht University, Department of Information +and Computing Sciences, Software Technology group + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS +IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/src/EHC.hs b/src/EHC.hs new file mode 100644 --- /dev/null +++ b/src/EHC.hs @@ -0,0 +1,396 @@ +module Main +where +import System.Console.GetOpt +import System.IO +import System.Exit +import System.Process +import System.Environment +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.Environment +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import UHC.Light.Compiler.EHC.InitialSetup +import UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases +import qualified Debug.Trace +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad.State +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Optimize (allOptimizeMp) +import qualified UHC.Light.Compiler.SourceCodeSig as Sig +import UHC.Light.Compiler.EHC.CompilePhase.Module +import UHC.Light.Compiler.Module.ImportExport (modBuiltin) +import UHC.Light.Compiler.Module.ImportExport +import System.Directory +import UHC.Light.Compiler.Base.PackageDatabase +import UHC.Light.Compiler.Base.Parser2 +import qualified UHC.Light.Compiler.ConfigCabal as Cfg (getDataDir) + + + + + + + + + + + + +{-# LINE 90 "src/ehc/EHC.chs" #-} +main :: IO () +main + = do { args <- getArgs + ; progName <- getProgName + ; curDir <- getCurrentDirectory + -- an empty data dir means we are running as cabal installed exec + ; mbDataDir <- Cfg.getDataDir >>= \d -> return $ if null d then Nothing else Just d + ; let opts1 = defaultEHCOpts + { ehcOptEnvironment = defaultEHCEnvironment + , ehcProgName = p + , ehcCurDir = curDir + } + where p = mkFPath progName + oo@(o,n,errs) = ehcCmdLineOptsApply (maybe [] (\d -> [\o -> o {ehcOptCfgInstallRoot = Just d}]) mbDataDir) args opts1 + opts2 = maybe opts1 id o + ; case opts2 of + o | isNotOk (ehcOptMbTarget o) -> err $ "non existent target `" ++ fromNotOk (ehcOptMbTarget o) ++ "'" + | isNotOk (ehcOptMbTargetFlavor o) -> err $ "non existent target flavor `" ++ fromNotOk (ehcOptMbTargetFlavor o) ++ "'" + where err x + = do { hPutStrLn stderr ("option error: " ++ x) + ; exitFailure + } + _ -> return () + ; userDir <- ehcenvDir (envkey opts2) + ; let opts3 = opts2 { ehcOptUserDir = userDir + , ehcOptOutputDir = + let outputDir = maybe "." id (ehcOptOutputDir opts2) + in case ehcOptPkgOpt opts2 of + Just (PkgOption {pkgoptName=s}) + -> case parsePkgKey s of + Just k -> Just $ + outputDir ++ "/" ++ + mkInternalPkgFileBase k (Cfg.installVariant opts2) + (ehcOptTarget opts2) (ehcOptTargetFlavor opts2) + _ -> ehcOptOutputDir opts2 + _ -> ehcOptOutputDir opts2 + } + ; case ehcOptImmQuit opts3 of + Just immq -> handleImmQuitOption immq opts3 + _ | null errs -> + unless (null n) (doCompileRun n opts3) + | otherwise -> do { putStr (head errs) + ; exitFailure + } + } + where envkey opts = mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant + +{-# LINE 177 "src/ehc/EHC.chs" #-} +defaultEHCEnvironment :: EHCEnvironment +defaultEHCEnvironment + = EHCEnvironment Cfg.ehcDefaultVariant Cfg.ehcDefaultInplaceInstallDir + +{-# LINE 187 "src/ehc/EHC.chs" #-} +handleImmQuitOption :: ImmediateQuitOption -> EHCOpts -> IO () +handleImmQuitOption immq opts + = case immq of + ImmediateQuitOption_Help + -> do { + let progName = fpathToStr (ehcProgName opts) + ; let inputSuffixes = catMaybes $ map fst $ mkFileSuffMpHs opts + ; putStrLn (usageInfo ( "version: " ++ Cfg.verInfo Cfg.version ++ ", aspects: " ++ ehcOptAspects opts + ++ "\n\nUsage: " ++ progName ++ " [options] [file[" ++ (concat $ intersperse "|" $ map ('.':) inputSuffixes) ++ "] ...]\n\noptions:" + ) + ehcCmdLineOpts) + } + where + ImmediateQuitOption_Version + -> putStrLn $ Cfg.verInfo Cfg.version + ++ ", timestamp " ++ Sig.timestamp + ImmediateQuitOption_Meta_Variant + -> putStrLn Cfg.ehcDefaultVariant + ImmediateQuitOption_Meta_Targets + -> putStr showSupportedTargets + ImmediateQuitOption_Meta_TargetDefault + -> putStr (show defaultTarget) + ImmediateQuitOption_Meta_Optimizations + -> putStr (showStringMapKeys allOptimizeMp " ") + ImmediateQuitOption_VersionDotted + -> putStrLn (Cfg.verFull Cfg.version) + ImmediateQuitOption_VersionAsNumber + -> putStrLn (Cfg.verAsNumber Cfg.version) +{- + ImmediateQuitOption_Meta_ExportEnv mvEnvOpt + -> exportEHCEnvironment + (mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant) + (env {ehcenvInstallRoot = installRootDir, ehcenvVariant = variant}) + where env = ehcOptEnvironment opts + (installRootDir,variant) + = case fmap (wordsBy (`elem` ",;")) mvEnvOpt of + Just (d:v:_) -> (d,v) + Just (d:_) -> (d,ehcenvVariant env) + _ -> (ehcenvInstallRoot env,ehcenvVariant env) + ImmediateQuitOption_Meta_DirEnv + -> do { d <- ehcenvDir (mkEhcenvKey (Cfg.verFull Cfg.version) (fpathToStr $ ehcProgName opts) Cfg.ehcDefaultVariant) + ; putStrLn d + } +-} + ImmediateQuitOption_Meta_Pkgdir_System + -> do { let d = Cfg.mkInstallPkgdirSystem opts + ; putStrLn d + } + ImmediateQuitOption_Meta_Pkgdir_User + -> do { let d = Cfg.mkInstallPkgdirUser opts + ; putStrLn d + } + +{-# LINE 271 "src/ehc/EHC.chs" #-} +type FileSuffMp = [(FileSuffix,EHCompileUnitState)] + +mkFileSuffMpHs :: EHCOpts -> FileSuffMp +mkFileSuffMpHs opts + = [ ( Just "hs" , ECUS_Haskell HSStart ) + , ( Just "lhs" , ECUS_Haskell LHSStart ) + , ( Just "eh" , ECUS_Eh EHStart ) + , ( Just "hi" , ECUS_Haskell HIStart ) + , ( Just Cfg.suffixDotlessInputOutputTextualCore, ECUS_Core CRStartText ) + , ( Just Cfg.suffixDotlessInputOutputBinaryCore , ECUS_Core CRStartBinary ) + , ( Just Cfg.suffixDotlessBinaryCore , ECUS_Core CRStartBinary ) + ] + ++ (if targetIsOnUnixAndOrC (ehcOptTarget opts) + then [ ( Just "c" , ECUS_C CStart ) + , ( Just "o" , ECUS_O OStart ) + ] + else [] + ) + +{-# LINE 306 "src/ehc/EHC.chs" #-} +-- Suffix map for empty suffix, defaults to .hs +fileSuffMpHsNoSuff :: FileSuffMp +fileSuffMpHsNoSuff + = [ ( Nothing , ECUS_Haskell HSStart ) + ] + +{-# LINE 386 "src/ehc/EHC.chs" #-} +doCompilePrepare :: [String] -> EHCOpts -> IO (Maybe (EHCOpts,[FPath],[HsName],EHCompileRun)) +doCompilePrepare fnL@(fn:_) opts + = do { let fpL@(fp:_) = map (mkTopLevelFPath "hs") fnL + topModNmL@(topModNm:_) = map (mkHNm . fpathBase) fpL + installVariant = Cfg.installVariant opts + ; installRoot <- Cfg.installRootM opts + -- ; userDir <- ehcenvDir (Cfg.verFull Cfg.version) + -- ; let opts2 = opts -- {ehcOptUserDir = userDir} + ; pkgDb1 <- pkgDbFromDirs opts + ({- + [ filePathCoalesceSeparator $ filePathUnPrefix + $ Cfg.mkDirbasedInstallPrefix (filelocDir d) Cfg.INST_LIB_PKG "" (show (ehcOptTarget opts)) "" + | d <- ehcOptPkgdirLocPath opts + ] + ++ [ filePathUnPrefix + $ Cfg.mkDirbasedTargetVariantPkgPrefix installRoot installVariant (show (ehcOptTarget opts)) "" + ] + -} + {- + -} + [ filePathUnPrefix d + | d <- nub $ ehcOptPkgdirLocPath opts ++ [Cfg.mkInstallPkgdirUser opts, Cfg.mkInstallPkgdirSystem opts] + ] + ) + ; let (pkgDb2,pkgErrs) = pkgDbSelectBySearchFilter (pkgSearchFilter Just PackageSearchFilter_ExposePkg (map tup123to1 $ pkgExposedPackages pkgDb1) + ++ sort (ehcOptPackageSearchFilter opts) + ) pkgDb1 + pkgDb3 = pkgDbFreeze pkgDb2 + -- ; putStrLn $ "db1 " ++ show pkgDb1 + -- ; putStrLn $ "db2 " ++ show pkgDb2 + -- ; putStrLn $ "db3 " ++ show pkgDb3 + -- ; putStrLn (show $ ehcOptPackageSearchFilter opts) + ; ehcioinfo <- newEHCIOInfo + ; let searchPath = [emptyFileLoc] + ++ ehcOptImportFileLocPath opts + {- + ++ [ mkPkgFileLoc (p, Nothing) $ filePathUnPrefix + $ Cfg.mkDirbasedLibVariantTargetPkgPrefix (filelocDir d) "" (show (ehcOptTarget opts)) p + | d <- ehcOptLibFileLocPath opts + , p <- ehcOptLibPackages opts + ] + ++ [ mkPkgFileLoc p $ filePathUnPrefix + $ Cfg.mkDirbasedTargetVariantPkgPrefix installRoot installVariant (show (ehcOptTarget opts)) p + | p <- ( ehcOptLibPackages opts + ++ (if ehcOptHideAllPackages opts then [] else Cfg.ehcAssumedPackages) + ) + ] + -} + ++ [fileLocPkgDb] + opts3 = opts { ehcOptImportFileLocPath = searchPath + , ehcOptPkgDb = pkgDb3 + } +{- this does not work in ghc 6.8.2 + crsi = emptyEHCompileRunStateInfo + { crsiOpts = opts3 + , crsiHSInh = initialHSSem opts3 + , crsiEHInh = initialEHSem opts3 fp + , crsiCoreInh = initialCore2GrSem opts3 + -- , crsiHIInh = initialHISem opts3 + , crsiHSModInh = initialHSSemMod opts3 + } +-} + crsi = (EHCompileRunStateInfo opts3 + uidStart uidStart + (initialHSSem opts3) (initialEHSem opts3 fp) + (initialCore2GrSem opts3) + Nothing + -- (initialHISem opts3) + (initialHSSemMod opts3) + Map.empty Map.empty defaultOptim + Map.empty + ehcioinfo [] + ) + initialState = mkEmptyCompileRun topModNm crsi + ; return $ Just (opts3,fpL,topModNmL,initialState) + } + +doCompileRun :: [String] -> EHCOpts -> IO () +doCompileRun fnL@(fn:_) opts + = do { mbPrep <- doCompilePrepare fnL opts + ; if isJust mbPrep + then do { let ( opts + , fpL@(fp:_) + , topModNmL@(topModNm:_) + , initialState + ) = fromJust mbPrep + searchPath = ehcOptImportFileLocPath opts + fileSuffMpHs = mkFileSuffMpHs opts + ; when (ehcOptVerbosity opts >= VerboseDebug) + (putStrLn $ "search path: " ++ show searchPath) + ; _ <- if False -- ehcOptPriv opts + then runStateT (compile2 opts fileSuffMpHs searchPath fpL topModNmL) initialState + else runStateT (compile opts fileSuffMpHs searchPath fpL topModNmL) initialState + ; return () + } + else exitFailure + } + where compile2 :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase () + compile2 opts fileSuffMpHs searchPath fpL topModNmL + = do { + -- start with directly importing top modules, providing the filepath directly + topModNmL' <- toplayer fpL topModNmL + ; cpPP "topModNmL'" + ; oneModNmL <- onelayer + ; cpPP "oneModNmL" + ; return () + } + where toplayer fpL topModNmL + = zipWithM (\fp topModNm -> imp1 opts fileSuffMpHs searchPath (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL + onelayer + = do { cr <- get + ; let modNmS = Map.keysSet $ crCUCache cr + ms = Set.unions + [ case cuState e of + -- ECUS_Haskell HIOnlyImports -> ecuTransClosedOrphanModS ecu + _ -> ecuImpNmS e + | m <- Set.toList modNmS, let e = crCU m cr + ] + `Set.difference` modNmS + ; sequence -- or: cpSeq + return () + [ do { i@(m',_) <- imp1 opts fileSuffMpHs searchPath (ECUS_Haskell HSOnlyImports) Nothing Nothing m + -- ; cpEhcFullProgModuleDetermineNeedsCompile m' + ; return i + } + | m <- Set.toList ms + ] + } + + -- dbg + {- + showCompileOrder + = do { cr <- get + ; lift $ putStrLn $ "compile order: " ++ show (crCompileOrder cr) + } + -} + + compile :: EHCOpts -> FileSuffMp -> FileLocPath -> [FPath] -> [HsName] -> EHCompilePhase () + compile opts fileSuffMpHs searchPath fpL topModNmL + = do { + -- check module import relationship for builtin module + cpCheckMods' (const emptyModMpInfo) [modBuiltin] + + -- start with directly importing top modules, providing the filepath directly + ; topModNmL' <- zipWithM (\fp topModNm -> imp (ECUS_Haskell HSOnlyImports) (Just fp) Nothing topModNm) fpL topModNmL + + -- follow the import relation to chase modules which have to be analysed + ; cpImportGatherFromModsWithImp + (if ehcOptPriv opts + then \ecu -> case ecuState ecu of + -- ECUS_Haskell HIStart -> Set.toList $ ecuTransClosedOrphanModS ecu + ECUS_Haskell HIOnlyImports -> [] -- Set.toList $ ecuTransClosedOrphanModS ecu + _ -> ecuImpNmL ecu + else ecuImpNmL + ) + (imp (ECUS_Haskell HSOnlyImports) Nothing) (map fst topModNmL') + + -- import orphans + ; when (ehcOptPriv opts) + (do { + -- import orphans + importAlso (ECUS_Haskell HSOnlyImports) ecuTransClosedOrphanModS + + -- import used remaining modules, but just minimally + ; importAlso (ECUS_Haskell HMOnlyMinimal) (Set.unions . Map.elems . ecuTransClosedUsedModMp) + }) + + -- inhibit mutual recursiveness + ; cpEhcCheckAbsenceOfMutRecModules + + -- and compile it all + ; cpEhcFullProgCompileAllModules + -- cleanup + ; unless (ehcOptKeepIntermediateFiles opts) cpRmFilesToRm + } + where -- abbrev for imp1 + imp = imp1 opts fileSuffMpHs searchPath + + -- import others, but then in a (slightly) different way + importAlso :: EHCompileUnitState -> (EHCompileUnit -> Set.Set HsName) -> EHCompilePhase () + importAlso how getNms + = do { cr <- get + ; let allAnalysedModS = Map.keysSet $ crCUCache cr + allNewS = Set.unions [ getNms $ crCU m cr | m <- Set.toList allAnalysedModS ] `Set.difference` allAnalysedModS + ; cpImportGatherFromModsWithImp + (const []) + (imp how Nothing) (Set.toList allNewS) + } + + imp1 :: EHCOpts -> FileSuffMp -> FileLocPath -> EHCompileUnitState -> Maybe FPath -> Maybe (HsName,(FPath,FileLoc)) -> HsName -> EHCompilePhase (HsName,Maybe (HsName,(FPath,FileLoc))) + imp1 opts fileSuffMpHs searchPath desiredState mbFp mbPrev nm + = do { let isTopModule = isJust mbFp + fileSuffMpHs' = (if isTopModule then fileSuffMpHsNoSuff else []) ++ fileSuffMpHs + ; let searchPath' = adaptedSearchPath mbPrev + ; fpsFound <- cpFindFilesForFPathInLocations (fileLocSearch opts) (\(x,_,_) -> x) False fileSuffMpHs' searchPath' (Just nm) mbFp + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { lift $ putStrLn $ show nm ++ ": " ++ show (fmap fpathToStr mbFp) ++ ": " ++ show (map fpathToStr fpsFound) + ; lift $ putStrLn $ "searchPath: " ++ show searchPath' + }) + ; when isTopModule + (cpUpdCU nm (ecuSetIsTopMod True)) + ; cpUpdCU nm (ecuSetTarget (ehcOptTarget opts)) + ; case fpsFound of + (fp:_) + -> do { nm' <- cpEhcModuleCompile1 (Just desiredState) nm + ; cr <- get + ; let (ecu,_,_,_) = crBaseInfo nm' cr + ; return (nm',Just (nm',(fp, ecuFileLocation ecu))) + } + _ -> return (nm,Nothing) + } + where -- strip tail part corresponding to module name, and use it to search as well + adaptedSearchPath (Just (prevNm,(prevFp,prevLoc))) + = case (fpathMbDir (mkFPath prevNm), fpathMbDir prevFp, prevLoc) of + (_, _, p) | filelocIsPkg p + -> p : searchPath + (Just n, Just p, _) + -> mkDirFileLoc (filePathUnPrefix prefix) : searchPath + where (prefix,_) = splitAt (length p - length n) p + _ -> searchPath + adaptedSearchPath _ = searchPath + diff --git a/src/UHC/Light/Compiler/API.hs b/src/UHC/Light/Compiler/API.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/API.hs @@ -0,0 +1,9 @@ +{-# LINE 2 "src/ehc/API.chs" #-} +module UHC.Light.Compiler.API + ( + module UHC.Light.Compiler.Core.API + ) + where + +import UHC.Light.Compiler.Core.API + diff --git a/src/UHC/Light/Compiler/AbstractCore.hs b/src/UHC/Light/Compiler/AbstractCore.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AbstractCore.hs @@ -0,0 +1,1316 @@ +module UHC.Light.Compiler.AbstractCore +( AbstractCore (..) +, ACoreAppLikeMetaBound +, acoreMetaLift +, ACoreBindAspectKey (..), ACoreBindAspectKeyS, ACoreBindAspMp +, acbaspkeyMetaLev +, acbaspkeyDefaultTy, acbaspkeyTy, acbaspkeyDefaultCore, acbaspkeyNone, acbaspkeyDefault, acbaspkeyDefaultRelevTy, acbaspkeyStrict, acbaspkeyDebug +, ppACBaspKeyS +, hsnUniqifyACoreBindAspectKeyS +, ACoreBindRef (..), acoreMkRef, acoreMkAspRef +, acbrefAspAnd +, ppACoreBindRef +, acore1App, acoreApp, acoreAppBound +, acoreLamBind, acoreLam1Ty, acoreLam1, acoreLamTy, acoreLam +, acoreTagTupTy, acoreTagTup, acoreTupTy, acoreTup, acoreTag +, acoreBind1CatLevMetaTyWith, acoreBind1CatLevMetaTy, acoreBind1CatLevTy, acoreBind1CatMetaTy, acoreBind1CatTy, acoreBind1Cat, acoreBind1LevTy, acoreBind1Ty, acoreBind1 +, acoreBind1MetasTy, acoreBind1CatMeta, acoreBind1MetaTy +, acoreBind1Asp1, acoreBind1NmLevTy1, acoreBind1Nm1 +, acoreBoundVal1CatLevMetaTy, acoreBoundVal1CatLevTy, acoreBoundVal1CatMetaTy, acoreBoundVal1CatTy, acoreBoundVal1Cat +, acoreBoundVal1Metas, acoreBoundVal1Meta +, acoreBound1AspkeyVal, acoreBound1Val +, acoreTyErrLift +, acoreLetMerge, acoreLet, acoreLetRec +, acoreLetN +, acoreLet1PlainTy, acoreLet1Plain +, acoreLet1StrictTy, acoreLet1Strict +, acoreLet1StrictInMetaTyWith, acoreLet1StrictInMetaTy, acoreLet1StrictInMeta, acoreLet1StrictIn, acoreLet1StrictInTy +, acoreBindcategDflt +, acoreChar, acoreInt, acoreInt2 +, acoreBuiltinApp +, acoreBuiltinAddInt +, acoreBuiltinGtInt +, acoreBuiltinString +, acoreBuiltinError, acoreBuiltinUndefined +, acorePatConMbTag, acoreAltMbTag +, acoreBindNm +, acorePatFldTy +, acoreUnBoundVal +, Coe' (..) +, CoeCtx (..) +, acoreCoeId, acoreCoeMap +, acoreCoeApp1, acoreCoeAppN, acoreCoeAppNbyName +, acoreCoeLam1Ty, acoreCoeLam1 +, acoreCoeCompose +, acoreCoeIsId +, CSubstKey (..) +, CSubstInfo' (..) +, CSubst', emptyCSubst +, acoreCSubstFromNmTyL +, acoreCSubstFromRefExprL +, acoreCSubstFromUidExprL +, cSubstAppSubst +, CSubstitutable (..) +, RAlt' (..), RPat' (..), RPatConBind' (..), RPatFld' (..), RCEAltL' +, rcaPat, raltLPatNms +, rcaTag +, raltIsVar, raltIsConst +, raltIsConMany +, raltIsIrrefutable +, rpatConBindUnFlatten +, acoreRPat2Pat +, ctagTrue, ctagFalse +, ctagCons, ctagNil +, CaseAltFailReason (..) +, cafailHasId +, AppFunKind (..) +, WhatExpr (..) +, whatExprMbVar, whatExprMbApp, whatExprMbLam, whatExprAppArity +, whatExprIsWHNF +, whatExprIsLam, whatExprIsTup +, whatExprIsFFI +, acoreMetaLiftDict +, acoreNmHolePred, acoreNmHole +, acoreCoeLamLetTy, acoreCoeLamLet, acoreCoeLetRec +, acoreCoePoiLApp, acoreCoeImplsApp +, acoreCoePoiLLamTy, acoreCoeImplsLam +, acoreCSubstFromUidImplsL, acoreCSubstFromUidBindLL +, acoreIf +, acbaspkeyFusionRole +, acoreBuiltinInteger +, raltMbBoolExpr, raltIsBoolExpr +, acoreBuiltinEqChar +, acoreBuiltinListSingleton +, acoreMatchChar ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Ty +import UHC.Util.Pretty +import UHC.Util.Utils +import Data.List +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Applicative ((<|>),(<$>)) +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Typeable (Typeable) +import Data.Generics (Data) + + + + +{-# LINE 38 "src/ehc/AbstractCore.chs" #-} +class AbstractCore expr metaval bind bound boundmeta bindcateg metabind ty pat patrest patfld alt + | expr -> metaval bind bound boundmeta bindcateg metabind ty pat patrest patfld alt + , metaval -> expr + , bind -> expr + , bound -> expr + , boundmeta -> expr + , bindcateg -> expr + , metabind -> expr + , ty -> expr + , pat -> expr + , patrest -> expr + , patfld -> expr + , alt -> expr + where + ------------------------- constructing: expr ------------------------- + -- | 1 arg application, together with meta info about the argument, packaged in the bind + acoreLam1Bind :: bind -> expr -> expr + + -- | 1 arg application, together with meta info about the argument + -- acoreLam1Ty :: HsName -> ty -> expr -> expr + + -- | 1 lam abstraction, together with meta info about, and type of the argument + acore1AppBound :: expr -> bound -> expr + + -- | a tuple, with tag, and ty + acoreTagTyTupBound :: CTag -> ty -> [bound] -> expr + + -- | a value binding, for a name to value + type + metas + meta level + acoreBind1CatLevMetasTy :: bindcateg -> HsName -> MetaLev -> (metabind,metaval) -> ty -> expr -> bind + + -- | a value binding aspect, for a name + value, optionally type + metas + meta level + acoreBoundVal1CatLevMetasTy :: bindcateg -> HsName -> MetaLev -> (metabind,metaval) -> ty -> expr -> bound + + -- | a type for value binding aspect, for a name + type, optionally meta level + acoreBoundValTy1CatLev :: bindcateg -> HsName -> MetaLev -> ty -> bound + + -- | meta for something bound; for a name, meta level and label + acoreBoundmeta :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> boundmeta + + -- | a expr binding aspect, for a name, meta level and label + acoreBound1MetaVal :: boundmeta -> expr -> bound + + -- | a binding, for/from a single aspect (for now, later multiple) + acoreBind1Asp :: HsName -> [bound] -> bind + + -- | basic let binding + acoreLetBase :: bindcateg -> [bind] -> expr -> expr + + -- | cast, defaults to noop + acoreCast :: ty -> expr -> expr + acoreCast _ e = e + + -- | case, with possible default + acoreCaseDflt :: expr -> [alt] -> Maybe expr -> expr + + -- | var + acoreVar :: HsName -> expr + + -- | string + acoreStringTy :: ty -> String -> expr + + -- | char + acoreCharTy :: ty -> Char -> expr + + -- | int as Int + acoreIntTy :: ty -> Int -> expr + + -- | int as Integer + acoreIntTy2 :: ty -> Integer -> expr + + -- | hole: placeholder for CSubst to fill in + acoreUidHole :: UID -> expr + + -- | hole: let with hole for bindings to be filled in later by means of a CSubst + acoreHoleLet :: UID -> expr -> expr + + -- | a default, fallback + -- acoreDflt :: expr + + -- | get error/default expr + acoreExprErr :: String -> expr + acoreExprErr s = panic $ "AbstractCore.acoreExprErr: " ++ s + + + ------------------------- constructing: ty constants ------------------------- + -- Int + -- acoreTyInt2 :: ty + + -- Bool + acoreTyBool :: EHCOpts -> ty + + ------------------------- constructing: pat ------------------------- + -- | pat var, with type + acorePatVarTy :: HsName -> ty -> pat + + -- | pat con + acorePatCon :: CTag -> patrest -> [patfld] -> pat + + -- | pat int + acorePatIntTy :: ty -> Int -> pat + + -- | pat Integer + acorePatIntTy2 :: ty -> Integer -> pat + + -- | pat char + acorePatCharTy :: ty -> Char -> pat + + -- | pat boolean guard + acorePatBoolExpr :: expr -> pat + ------------------------- constructing: pat field ------------------------- + -- | pat field + acorePatFldBind :: (HsName,expr) -> bind -> patfld + -- acorePatFldTy :: ty -> (HsName,expr) -> HsName -> patfld + + ------------------------- constructing: patrest ------------------------- + -- | patrest, empty + acorePatRestEmpty :: patrest + + -- | patrest, var + acorePatRestVar :: HsName -> patrest + + ------------------------- constructing: alt ------------------------- + -- | 1 arg application, together with meta info about the argument + acoreAlt :: pat -> expr -> alt + + ------------------------- type related ------------------------- + -- | construct ty from Ty, usable in Core context + acoreTy2ty :: EHCOpts -> Ty -> ty + + ------------------------- defaults ------------------------- + -- | get default for metaval + acoreMetavalDflt :: metaval + + -- | get default for metaval, for dicts + acoreMetavalDfltDict :: metaval + + -- | get default for metabind + acoreMetabindDflt :: metabind + + -- | get default for metabind + acoreDfltBoundmeta :: boundmeta + acoreDfltBoundmeta = panic "AbstractCore.acoreDfltBoundmeta not implemented" + + -- | get error/default ty, type indexed by ty + acoreTyErr :: String -> ty + acoreTyErr s = panic $ "AbstractCore.acoreTyErr: " ++ s + + -- | get the ty representing the absent type, no type info + acoreTyNone :: ty + + -- | get char ty + acoreTyChar :: EHCOpts -> ty + + -- | get int ty + acoreTyInt :: EHCOpts -> ty + + -- | get String ty + acoreTyString :: EHCOpts -> ty + + ------------------------- bindcateg values ------------------------- + -- | get recursive bindcateg + acoreBindcategRec :: bindcateg + + -- | get strict bindcateg + acoreBindcategStrict :: bindcateg + + -- | get plain bindcateg + acoreBindcategPlain :: bindcateg + + ------------------------- inspecting/deconstructing ------------------------- + -- | is expr an application? + acoreExprMbApp :: expr -> Maybe (expr,bound) + + + -- | is expr a lambda? + acoreExprMbLam :: expr -> Maybe (bind,expr) + + -- | is expr a let? + acoreExprMbLet :: expr -> Maybe (bindcateg,[bind],expr) + + -- | is expr a var? + acoreExprMbVar :: expr -> Maybe HsName + + -- | is expr a int? + acoreExprMbInt :: expr -> Maybe (ty,Integer) + + -- | is bindcateg recursive? + acoreBindcategMbRec :: bindcateg -> Maybe bindcateg + + -- | is bindcateg strict? + acoreBindcategMbStrict :: bindcateg -> Maybe bindcateg + + -- | is pat a con? + acorePatMbCon :: pat -> Maybe(CTag,patrest,[patfld]) + + -- | is pat a int? + acorePatMbInt :: pat -> Maybe(ty,Integer) + + -- | is pat a char? + acorePatMbChar :: pat -> Maybe(ty,Char) + + -- | 'un' alt + acoreUnAlt :: alt -> (pat,expr) + + -- | 'un' patfld + acoreUnPatFld :: patfld -> ((HsName,expr),bind) + + -- | 'un' patfld + -- acoreUnPatFld :: patfld -> (ty,(HsName,expr),HsName) + + -- | 'un' bind + acoreUnBind :: bind -> (HsName,[bound]) + + -- | is bound a expr? + acoreBoundMbVal :: bound -> Maybe (boundmeta,expr) + + ------------------------- transforming ------------------------- + -- | thunk expr, i.e. turn into delayed computation + acoreExprThunk :: expr -> expr + acoreExprThunk = id + + -- | thunk ty, i.e. ty of 'acoreExprThunk'-ed expr + acoreTyThunk :: ty -> ty + acoreTyThunk = id + + -- | unthunk expr, i.e. force computation of delayed computation + acoreExprUnThunk :: expr -> expr + acoreExprUnThunk = id + + -- | unthunk ty, i.e. ty of 'acoreExprUnThunk'-ed expr + acoreTyUnThunk :: ty -> ty + acoreTyUnThunk = id + + ------------------------- coercion related: construction ------------------------- + -- | coercion arg placeholder + acoreCoeArg :: expr + + ------------------------- coercion related: inspecting/deconstructing ------------------------- + -- | coercion arg placeholder + acoreExprIsCoeArg :: expr -> Bool + + +{-# LINE 301 "src/ehc/AbstractCore.chs" #-} +type ACoreAppLikeMetaBound = (ACoreBindAspectKeyS,MetaLev,CLbl) + +{-# LINE 305 "src/ehc/AbstractCore.chs" #-} +instance AbstractCore e m b bound boundmeta bcat mbind t p pr pf a => AppLike e boundmeta {- () () -} where + app1App = acore1App + appTop = id + appCon = acoreVar . mkHNm + appPar = id + appVar = acoreVar . mkHNm + + -- appDflt = + appDfltBoundmeta x = acoreDfltBoundmeta + appDbg = acoreExprErr + + appMbCon = acoreExprMbVar + appMbApp1 e = do (f,b) <- acoreExprMbApp e + (_,a) <- acoreBoundMbVal b + return (f,a) + +{-# LINE 336 "src/ehc/AbstractCore.chs" #-} +instance AbstractCore e m b bound boundmeta bcat mbind t p pr pf a => RecLike e boundmeta {- () () -} where + recRow _ fs = acoreTagTyTupBound CTagRec (acoreTyErr "AbstractCore.RecLike.recRow") [ acoreBound1MetaVal (acoreBoundmeta acbaspkeyDefault 0 (CLbl_Nm n)) e | (n,e) <- fs ] + + recMbRecRow _= Nothing -- tyMbRecRowWithLkup (const Nothing) + recUnRowExts e= (e,[]) + +{-# LINE 348 "src/ehc/AbstractCore.chs" #-} +acoreMetaLift :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, Functor f) => f x -> f (x,m) +acoreMetaLift = fmap2Tuple acoreMetavalDflt + +{-# LINE 353 "src/ehc/AbstractCore.chs" #-} +acoreMetaLiftDict :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, Functor f) => f x -> f (x,m) +acoreMetaLiftDict = fmap2Tuple acoreMetavalDfltDict + +{-# LINE 363 "src/ehc/AbstractCore.chs" #-} +-- | A ACoreBindAspectKeyS formed out of multiple ACoreBindAspectKey identifies a particular binding aspect +data ACoreBindAspectKey + = ACoreBindAspectKey_Default -- identifies the default binding, if omitted in a reference this aspect is the one chosen. + | ACoreBindAspectKey_Ty -- the normal ty + | ACoreBindAspectKey_RelevTy -- the relevance ty + | ACoreBindAspectKey_Strict -- the as strict as possible variant + | ACoreBindAspectKey_Debug -- internal debugging only + | ACoreBindAspectKey_Core -- core + | ACoreBindAspectKey_FusionRole -- fusion role + deriving (Eq,Ord) + +instance Show ACoreBindAspectKey where + show ACoreBindAspectKey_Default = "dft" + show ACoreBindAspectKey_Strict = "str" + show ACoreBindAspectKey_Ty = "ty" + show ACoreBindAspectKey_RelevTy = "rty" + show ACoreBindAspectKey_Debug = "dbg" + show ACoreBindAspectKey_Core = "core" + show ACoreBindAspectKey_FusionRole = "fusionrole" + +instance PP ACoreBindAspectKey where + pp = pp . show + +type ACoreBindAspectKeyS = Set.Set ACoreBindAspectKey +type ACoreBindAspMp x = Map.Map ACoreBindAspectKeyS x + +acbaspkeyMk :: [ACoreBindAspectKey] -> ACoreBindAspectKeyS +acbaspkeyMk = Set.fromList + +{-# LINE 404 "src/ehc/AbstractCore.chs" #-} +acbaspkeyMetaLev :: MetaLev -> ACoreBindAspectKeyS -> MetaLev +acbaspkeyMetaLev mlev _ = mlev + +{-# LINE 415 "src/ehc/AbstractCore.chs" #-} +-- | predefined: +acbaspkeyNone :: ACoreBindAspectKeyS +acbaspkeyNone = acbaspkeyMk + [ ] + +-- | predefined: +acbaspkeyDefault :: ACoreBindAspectKeyS +acbaspkeyDefault = acbaspkeyMk + [ ACoreBindAspectKey_Default ] + +-- | predefined: +acbaspkeyTy :: ACoreBindAspectKeyS +acbaspkeyTy = acbaspkeyMk + [ ACoreBindAspectKey_Ty ] + +-- | predefined: +acbaspkeyDefaultTy :: ACoreBindAspectKeyS +acbaspkeyDefaultTy = acbaspkeyMk + [ ACoreBindAspectKey_Default, ACoreBindAspectKey_Ty ] + +-- | predefined: +acbaspkeyDefaultCore :: ACoreBindAspectKeyS +acbaspkeyDefaultCore = acbaspkeyMk + [ ACoreBindAspectKey_Default, ACoreBindAspectKey_Core ] + +-- | predefined: +acbaspkeyDefaultRelevTy :: ACoreBindAspectKeyS +acbaspkeyDefaultRelevTy = acbaspkeyMk + [ ACoreBindAspectKey_Default, ACoreBindAspectKey_RelevTy ] + +-- | predefined: +acbaspkeyStrict :: ACoreBindAspectKeyS +acbaspkeyStrict = acbaspkeyMk + [ ACoreBindAspectKey_Strict ] + +-- | predefined: +acbaspkeyDebug :: ACoreBindAspectKeyS +acbaspkeyDebug = acbaspkeyMk + [ ACoreBindAspectKey_Debug ] + +{-# LINE 474 "src/ehc/AbstractCore.chs" #-} +-- | predefined: +acbaspkeyFusionRole :: ACoreBindAspectKeyS +acbaspkeyFusionRole = acbaspkeyMk + [ ACoreBindAspectKey_FusionRole ] + +{-# LINE 481 "src/ehc/AbstractCore.chs" #-} +ppACBaspKeyS :: ACoreBindAspectKeyS -> PP_Doc +ppACBaspKeyS = ppCurlysCommas . Set.toList + +{-# LINE 486 "src/ehc/AbstractCore.chs" #-} +-- | uniqify with ACoreBindAspectKeyS, omitting the default +hsnUniqifyACoreBindAspectKeyS :: ACoreBindAspectKeyS -> HsName -> HsName +hsnUniqifyACoreBindAspectKeyS as n + = foldr mk n $ Set.toList as + where mk ACoreBindAspectKey_Strict = hsnUniqify HsNameUniqifier_Strict + mk a = hsnUniqifyStr HsNameUniqifier_BindAspect (show a) + +{-# LINE 495 "src/ehc/AbstractCore.chs" #-} +deriving instance Typeable ACoreBindAspectKey +deriving instance Data ACoreBindAspectKey + +{-# LINE 504 "src/ehc/AbstractCore.chs" #-} +-- | reference to binding aspect: name + aspect keys +data ACoreBindRef + = ACoreBindRef + { acbrefNm :: !HsName + , acbrefMbAspKey :: !(Maybe ACoreBindAspectKeyS) + } + deriving (Eq,Ord) + +acoreMkRef :: HsName -> ACoreBindRef +acoreMkRef n = ACoreBindRef n Nothing + +acoreMkAspRef :: ACoreBindAspectKeyS -> HsName -> ACoreBindRef +acoreMkAspRef a n = ACoreBindRef n (Just a) + +instance HSNM ACoreBindRef where + mkHNm (ACoreBindRef n ma) = maybe n (\a -> hsnUniqifyACoreBindAspectKeyS a n) ma + +instance Show ACoreBindRef where + show = show . mkHNm + +{-# LINE 526 "src/ehc/AbstractCore.chs" #-} +acbrefAspKey :: ACoreBindRef -> ACoreBindAspectKeyS +acbrefAspKey = maybe acbaspkeyNone id . acbrefMbAspKey +{-# INLINE acbrefAspKey #-} + +{-# LINE 532 "src/ehc/AbstractCore.chs" #-} +-- | narrow down aspects by adding more to ref; assume extra aspects non empty +acbrefAspAnd :: ACoreBindAspectKeyS -> ACoreBindRef -> ACoreBindRef +acbrefAspAnd a r = r {acbrefMbAspKey = Just $ a `Set.union` acbrefAspKey r } + +{-# LINE 538 "src/ehc/AbstractCore.chs" #-} +ppACoreBindRef :: (HsName -> PP_Doc) -> ACoreBindRef -> PP_Doc +ppACoreBindRef ppN r = ppN (acbrefNm r) >|< (maybe empty (ppCurlysCommas . Set.toList) $ acbrefMbAspKey r) + +instance PP ACoreBindRef where + pp = ppACoreBindRef pp + +{-# LINE 546 "src/ehc/AbstractCore.chs" #-} +deriving instance Typeable ACoreBindRef +deriving instance Data ACoreBindRef + +{-# LINE 555 "src/ehc/AbstractCore.chs" #-} +acore1App :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> e -> e +acore1App f a = acore1AppBound f (acoreBound1Val a) +{-# INLINE acore1App #-} + +acoreApp :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> [e] -> e +acoreApp f as = foldl (\f a -> acore1App f a) f as + +acoreAppBound :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> [bound] -> e +acoreAppBound f as = foldl (\f a -> acore1AppBound f a) f as + +{-# LINE 571 "src/ehc/AbstractCore.chs" #-} +acoreLamBind :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [b] -> e -> e +acoreLamBind = flip (foldr acoreLam1Bind) +{-# INLINE acoreLamBind #-} + +acoreLam1Ty :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> e -> e +acoreLam1Ty a t e = acoreLam1Bind (acoreBind1NmTy1 a t) e +-- acoreLam1Ty a t e = acoreLam1Bind (acoreBind1Nm1 a) e +-- acoreLam1Ty a t e = acoreLam1Bind (acoreBind1Ty a t) e -- 20120418, TBD: ignore type for now +{-# INLINE acoreLam1Ty #-} + +acoreLam1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> e -> e +acoreLam1 a e = acoreLam1Ty a (acoreTyErr "acoreLam1") e +{-# INLINE acoreLam1 #-} + +acoreLamTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [(HsName,t)] -> e -> e +acoreLamTy as e = foldr (\(n,t) e -> acoreLam1Ty n t e) e as + +acoreLam :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [HsName] -> e -> e +acoreLam as e = foldr (\(n) e -> acoreLam1 n e) e as + +{-# LINE 593 "src/ehc/AbstractCore.chs" #-} +acoreTagTupTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => CTag -> t -> [e] -> e +acoreTagTupTy tg t es = acoreTagTyTupBound tg t $ map acoreBound1Val es + +acoreTagTup :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => CTag -> [e] -> e +acoreTagTup tg es = acoreTagTupTy tg (acoreTyErr "acoreTupTy") es + +acoreTupTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => t -> [e] -> e +acoreTupTy t es = acoreTagTupTy CTagRec t es +{-# INLINE acoreTupTy #-} + +acoreTup :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [e] -> e +acoreTup es = acoreTagTup CTagRec es +{-# INLINE acoreTup #-} + +acoreTag :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => CTag -> e +acoreTag tg = acoreTagTup tg [] +{-# INLINE acoreTag #-} + +{-# LINE 624 "src/ehc/AbstractCore.chs" #-} +acoreBind1CatLevMetaTyWith :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => (t->t) -> (e->e) -> bcat -> HsName -> MetaLev -> m -> t -> e -> b +acoreBind1CatLevMetaTyWith mkT mkE cat n l m t e = acoreBind1CatLevMetasTy cat n l (acoreMetabindDflt,m) (mkT t) (mkE e) +{-# INLINE acoreBind1CatLevMetaTyWith #-} + +acoreBind1CatLevMetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> MetaLev -> m -> t -> e -> b +acoreBind1CatLevMetaTy = acoreBind1CatLevMetaTyWith id id +{-# INLINE acoreBind1CatLevMetaTy #-} + +acoreBind1CatLevTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> MetaLev -> t -> e -> b +acoreBind1CatLevTy cat n l t e = acoreBind1CatLevMetaTy cat n l acoreMetavalDflt t e +{-# INLINE acoreBind1CatLevTy #-} + +acoreBind1CatMetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> m -> t -> e -> b +acoreBind1CatMetaTy cat n m t e = acoreBind1CatLevMetaTy cat n metaLevVal m t e +{-# INLINE acoreBind1CatMetaTy #-} + +acoreBind1CatTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> t -> e -> b +acoreBind1CatTy cat n t e = acoreBind1CatLevTy cat n metaLevVal t e +{-# INLINE acoreBind1CatTy #-} + +acoreBind1LevTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> MetaLev -> t -> e -> b +acoreBind1LevTy n l t e = acoreBind1CatLevTy (acoreBindcategDflt e) n l t e +{-# INLINE acoreBind1LevTy #-} + +acoreBind1Ty :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> e -> b +acoreBind1Ty n t e = acoreBind1LevTy n metaLevVal t e +{-# INLINE acoreBind1Ty #-} + +acoreBind1Cat :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> e -> b +acoreBind1Cat cat n e = acoreBind1CatTy cat n acoreTyNone {- (acoreTyErr "acoreBind1Cat") -} e +{-# INLINE acoreBind1Cat #-} + +acoreBind1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> e -> b +acoreBind1 n e = acoreBind1Cat (acoreBindcategDflt e) n e +{-# INLINE acoreBind1 #-} + +{-# LINE 662 "src/ehc/AbstractCore.chs" #-} +acoreBind1MetasTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> (mbind,m) -> t -> e -> b +acoreBind1MetasTy n m t e = acoreBind1CatLevMetasTy (acoreBindcategDflt e) n metaLevVal m t e +{-# INLINE acoreBind1MetasTy #-} + +{- +acoreBind1Metas :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> (mbind,m) -> e -> b +acoreBind1Metas n m e = aacoreBind1MetasTy n m acoreTyNone e +{-# INLINE acoreBind1Metas #-} +-} + +acoreBind1CatMeta :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> m -> e -> b +acoreBind1CatMeta cat n m e = acoreBind1CatLevMetaTy cat n metaLevVal m (acoreTyErr "acoreBind1CatMeta") e +{-# INLINE acoreBind1CatMeta #-} + +acoreBind1MetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> m -> t -> e -> b +acoreBind1MetaTy n m t e = acoreBind1MetasTy n (acoreMetabindDflt,m) t e +{-# INLINE acoreBind1MetaTy #-} + +{- +acoreBind1Meta :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> m -> e -> b +acoreBind1Meta n m e = acoreBind1MetaTy n m acoreTyNone e +{-# INLINE acoreBind1Meta #-} +-} + + +{-# LINE 689 "src/ehc/AbstractCore.chs" #-} +acoreBind1Asp1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> bound -> b +acoreBind1Asp1 n ba = acoreBind1Asp n [ba] +{-# INLINE acoreBind1Asp1 #-} + +acoreBind1NmLevTy1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> MetaLev -> t -> b +acoreBind1NmLevTy1 n l t = acoreBind1Asp n [acoreBoundValTy1CatLev acoreBindcategPlain n l t] +-- {-# INLINE acoreBind1NmLevTy1 #-} + +acoreBind1NmTy1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> b +acoreBind1NmTy1 n t = acoreBind1NmLevTy1 n metaLevTy t +{-# INLINE acoreBind1NmTy1 #-} + +acoreBind1Nm1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> b +acoreBind1Nm1 n = acoreBind1Asp n [] +{-# INLINE acoreBind1Nm1 #-} + +{-# LINE 711 "src/ehc/AbstractCore.chs" #-} +acoreBoundVal1CatLevMetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> MetaLev -> m -> t -> e -> bound +acoreBoundVal1CatLevMetaTy bcat n mlev m t e = acoreBoundVal1CatLevMetasTy bcat n mlev (acoreMetabindDflt,m) t e +{-# INLINE acoreBoundVal1CatLevMetaTy #-} + +acoreBoundVal1CatLevTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> MetaLev -> t -> e -> bound +acoreBoundVal1CatLevTy cat n l t e = acoreBoundVal1CatLevMetaTy cat n l acoreMetavalDflt t e +{-# INLINE acoreBoundVal1CatLevTy #-} + +acoreBoundVal1CatMetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> m -> t -> e -> bound +acoreBoundVal1CatMetaTy cat n m t e = acoreBoundVal1CatLevMetaTy cat n metaLevVal m t e +{-# INLINE acoreBoundVal1CatMetaTy #-} + +acoreBoundVal1CatTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> t -> e -> bound +acoreBoundVal1CatTy cat n t e = acoreBoundVal1CatLevTy cat n metaLevVal t e +{-# INLINE acoreBoundVal1CatTy #-} + +acoreBoundVal1Cat :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> HsName -> e -> bound +acoreBoundVal1Cat cat n e = acoreBoundVal1CatTy cat n (acoreTyErr "acoreBoundVal1Cat") e +{-# INLINE acoreBoundVal1Cat #-} + +{-# LINE 733 "src/ehc/AbstractCore.chs" #-} +acoreBoundVal1Metas :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> (mbind,m) -> e -> bound +acoreBoundVal1Metas n m e = acoreBoundVal1CatLevMetasTy (acoreBindcategDflt e) n metaLevVal m (acoreTyErr "acoreBoundVal1Metas") e +{-# INLINE acoreBoundVal1Metas #-} + +acoreBoundVal1Meta :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> m -> e -> bound +acoreBoundVal1Meta n m e = acoreBoundVal1Metas n (acoreMetabindDflt,m) e +{-# INLINE acoreBoundVal1Meta #-} + + +{-# LINE 744 "src/ehc/AbstractCore.chs" #-} +acoreBound1AspkeyVal :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => ACoreBindAspectKeyS -> e -> bound +acoreBound1AspkeyVal a e = acoreBound1MetaVal (acoreBoundmeta a 0 CLbl_None) e +{-# INLINE acoreBound1AspkeyVal #-} + +acoreBound1Val :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> bound +acoreBound1Val e = acoreBound1AspkeyVal acbaspkeyDefault e +{-# INLINE acoreBound1Val #-} + +{-# LINE 764 "src/ehc/AbstractCore.chs" #-} +acoreTyErrLift :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, Functor f) => String -> f x -> f (x,t) +acoreTyErrLift msg = fmap (\n -> (n,acoreTyErr msg)) +{-# INLINE acoreTyErrLift #-} + +{-# LINE 774 "src/ehc/AbstractCore.chs" #-} +-- | Construct let, possibly merging bindings +acoreLetMerge :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Bool -> bcat -> [b] -> e -> e +acoreLetMerge merge c bs e + = if null bs + then e + else case acoreBindcategMbStrict c of + {- + Just _ + -> + -} + _ -> case acoreExprMbLet e of + Just (c',bs',e') | merge && c' == c + -> mk c (bs++bs') e' + _ -> mk c bs e + where mk c bs e + = case acoreBindcategMbRec c of + Just c -> acoreLetBase c bs e + _ -> foldr (\b e -> acoreLetBase c [b] e) e bs + +acoreLet :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bcat -> [b] -> e -> e +acoreLet c bs e = acoreLetMerge False c bs e +{-# INLINE acoreLet #-} + +acoreLetRec :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [b] -> e -> e +acoreLetRec bs e = acoreLet (acoreBindcategRec) bs e +{-# INLINE acoreLetRec #-} + +{-# LINE 803 "src/ehc/AbstractCore.chs" #-} +acoreLetN :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [(bcat,[b])] -> e -> e +acoreLetN cbs e = foldr (\(c,bs) e -> acoreLet c bs e) e cbs + +{-# LINE 808 "src/ehc/AbstractCore.chs" #-} +acoreLet1PlainTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> e -> e -> e +acoreLet1PlainTy nm t e + = acoreLet cat [acoreBind1CatTy cat nm t e] + where cat = acoreBindcategPlain + +acoreLet1Plain :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> e -> e -> e +acoreLet1Plain nm e = acoreLet1PlainTy nm (acoreTyErr "acoreLet1Plain") e +{-# INLINE acoreLet1Plain #-} + +{-# LINE 819 "src/ehc/AbstractCore.chs" #-} +acoreLet1StrictTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> e -> e -> e +acoreLet1StrictTy nm t e + = acoreLet cat [acoreBind1CatTy cat nm t e] + where cat = acoreBindcategStrict + +acoreLet1Strict :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> e -> e -> e +acoreLet1Strict nm e = acoreLet1StrictTy nm (acoreTyErr "acoreLet1Strict") e +{-# INLINE acoreLet1Strict #-} + +{-# LINE 830 "src/ehc/AbstractCore.chs" #-} +-- | evaluate an expr, with a continuation for the evaluated expr +acoreLet1StrictInMetaTyWith :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => (t->t) -> (e->e) -> HsName -> m -> t -> e -> (e -> e) -> e +acoreLet1StrictInMetaTyWith mkT mkE nm m t e mkC + = acoreLetBase cat [acoreBind1CatMetaTy cat nm m (mkT t) (mkE e)] (mkC (acoreVar nm)) + where cat = acoreBindcategStrict + +acoreMbLet1StrictInMetaTyWith :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => (t->t) -> (e->e) -> Maybe (HsName,t) -> m -> e -> (e -> e) -> e +acoreMbLet1StrictInMetaTyWith mkT mkE (Just (nm,t)) m e mkC = acoreLet1StrictInMetaTyWith mkT mkE nm m t e mkC +acoreMbLet1StrictInMetaTyWith _ _ _ m e mkC = mkC e + +acoreLet1StrictInMetaTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> m -> t -> e -> (e -> e) -> e +acoreLet1StrictInMetaTy = acoreLet1StrictInMetaTyWith acoreTyUnThunk acoreExprUnThunk +{-# INLINE acoreLet1StrictInMetaTy #-} + +acoreLet1StrictInMeta :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> m -> e -> (e -> e) -> e +acoreLet1StrictInMeta nm m e mkC = acoreLet1StrictInMetaTy nm m (acoreTyErr "acoreLet1StrictInMeta") e mkC +{-# INLINE acoreLet1StrictInMeta #-} + +acoreLet1StrictInTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> e -> (e -> e) -> e +acoreLet1StrictInTy nm t e mkC = acoreLet1StrictInMetaTy nm acoreMetavalDflt t e mkC +{-# INLINE acoreLet1StrictInTy #-} + +acoreLet1StrictIn :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> e -> (e -> e) -> e +acoreLet1StrictIn nm e mkC = acoreLet1StrictInMeta nm acoreMetavalDflt e mkC +{-# INLINE acoreLet1StrictIn #-} + +{-# LINE 862 "src/ehc/AbstractCore.chs" #-} +acoreNmHole :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => UID -> e +acoreNmHole = acoreVar . mkHNm + +acoreNmHolePred :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => PredOccId -> e +acoreNmHolePred = acoreNmHole . poiId + +{-# LINE 874 "src/ehc/AbstractCore.chs" #-} +-- | get default for bindcateg +acoreBindcategDflt :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> bcat +acoreBindcategDflt _ = acoreBindcategPlain +{-# INLINE acoreBindcategDflt #-} + +{-# LINE 885 "src/ehc/AbstractCore.chs" #-} +acoreChar :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Char -> e +acoreChar opts i = let x = acoreCharTy (acoreTyChar opts) i in x + +acoreInt :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Int -> e +acoreInt opts i = let x = acoreIntTy (acoreTyInt opts) i in x + +acoreInt2 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Integer -> e +acoreInt2 opts i = let x = acoreIntTy2 (acoreTyInt opts) i in x + +{-# LINE 900 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinApp :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> (EHBuiltinNames -> HsName) -> [e] -> e +acoreBuiltinApp opts bnmOf args = acoreVar (ehcOptBuiltin opts bnmOf) `acoreApp` args + +{-# LINE 905 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinAddInt :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> e -> Int -> e +acoreBuiltinAddInt opts e i + = if i == 0 + then e + else case acoreExprMbInt e of + Just (t,i') -> acoreIntTy2 t (toInteger i + i') + _ -> acoreBuiltinApp opts ehbnPrimAddInt [e,acoreInt opts i] + +{-# LINE 915 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinGtInt :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> e -> Int -> e +acoreBuiltinGtInt opts e i = acoreBuiltinApp opts ehbnPrimGtInt [e,acoreInt opts i] + +{-# LINE 920 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinEqChar :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Char -> e -> e +acoreBuiltinEqChar opts c e = acoreBuiltinApp opts ehbnPrimEqChar [e,acoreChar opts c] + +{-# LINE 925 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinString :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> String -> e +acoreBuiltinString opts m = let x = acoreBuiltinApp opts ehbnPackedStringToString [acoreStringTy (acoreTyString opts) m] in x + +{-# LINE 930 "src/ehc/AbstractCore.chs" #-} +acoreBuiltinError :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> String -> e +acoreBuiltinError opts m = acoreBuiltinApp opts ehbnError [acoreBuiltinString opts m] + +acoreBuiltinUndefined :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> e +acoreBuiltinUndefined opts = acoreBuiltinApp opts ehbnUndefined [] + +{-# LINE 938 "src/ehc/AbstractCore.chs" #-} +-- | Builtin Integer +acoreBuiltinInteger :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Integer -> e +acoreBuiltinInteger opts i = acoreBuiltinApp opts ehbnPackedStringToInteger [acoreStringTy (acoreTyString opts) (show i)] + +{-# LINE 944 "src/ehc/AbstractCore.chs" #-} +-- | Builtin list singleton (note: hardcoded of tags) +acoreBuiltinListSingleton :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> e -> e +acoreBuiltinListSingleton opts e + = acoreTagTupTy (ctagCons opts) (acoreTyErr "acoreBuiltinListSingleton.Cons") [e, acoreTagTupTy (ctagNil opts) (acoreTyErr "acoreBuiltinListSingleton.Nil") []] + +{-# LINE 955 "src/ehc/AbstractCore.chs" #-} +-- | when pat is con get tag +acorePatConMbTag :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => p -> Maybe CTag +acorePatConMbTag = fmap (\(tg,_,_) -> tg) . acorePatMbCon + +-- | possibly get tag of alt +acoreAltMbTag :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => a -> Maybe CTag +acoreAltMbTag = (\p -> (\(tg,_,_) -> tg) <$> acorePatMbCon p + <|> (const ctagInt) <$> acorePatMbInt p + -- <|> (const ctagChar) <$> acorePatMbChar p + ) . fst . acoreUnAlt + +{-# LINE 972 "src/ehc/AbstractCore.chs" #-} +-- | bound name of binding +acoreBindNm :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => b -> HsName +acoreBindNm = fst . acoreUnBind +{-# INLINE acoreBindNm #-} + +{-# LINE 983 "src/ehc/AbstractCore.chs" #-} +-- | bound name of binding +acorePatFldTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => t -> (HsName,e) -> HsName -> pf +acorePatFldTy t lbloff n = acorePatFldBind lbloff (acoreBind1NmTy1 n t) +{-# INLINE acorePatFldTy #-} + +{-# LINE 994 "src/ehc/AbstractCore.chs" #-} +-- | possible expr of bound (may panic) +acoreUnBoundVal :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => bound -> e +acoreUnBoundVal = maybe (panic "acoreBoundMbVal") (\(_,a) -> a) . acoreBoundMbVal +{-# INLINE acoreUnBoundVal #-} + +{-# LINE 1005 "src/ehc/AbstractCore.chs" #-} +-- | Construct 'if' expression. Hardcoded: tag nr, ordered alts (by tag) +acoreIf :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Maybe HsName -> e -> e -> e -> e +acoreIf opts cn c t f + = acoreMbLet1StrictInMetaTyWith id id (fmap (\n -> (n,acoreTyBool opts)) cn) acoreMetavalDflt c + $ (\c -> acoreCaseDflt c + [ acoreAlt (acorePatCon (ctagFalse opts) acorePatRestEmpty []) f + , acoreAlt (acorePatCon (ctagTrue opts) acorePatRestEmpty []) t + ] + Nothing {-(tcUndefined opts)-} + ) + +{-# LINE 1018 "src/ehc/AbstractCore.chs" #-} +acoreMatchChar :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Maybe HsName -> Char -> e -> e -> e -> e +acoreMatchChar opts cn cchar cexpr t f + = acoreIf opts cn (acoreBuiltinEqChar opts cchar cexpr) t f + +{-# LINE 1048 "src/ehc/AbstractCore.chs" #-} +data Coe' expr metaval bind bindasp ty + = Coe_Map !(expr -> expr) -- normal, expression as function + | Coe_C !expr -- constant + | Coe_Compose !(Coe' expr metaval bind bindasp ty) -- composition + !(Coe' expr metaval bind bindasp ty) + | Coe_App1 !expr -- apply + | Coe_App [HsName] -- apply n args + | Coe_Lam !HsName !ty -- lambda + | Coe_CloseExists !TyVarId !ty !ty -- closing existential + | Coe_OpenExists !TyVarId !ty !ty -- opening existential + | Coe_LamLet !HsName !ty !UID -- lambda with a let binding in the body + | Coe_LetRec ![bind] -- let rec + | Coe_ImplApp !ImplsVarId -- implicits, for apply + | Coe_ImplLam !ImplsVarId -- implicits, for lambda + +instance Show (Coe' expr metaval bind bindasp ty) where + show _ = "COE" + +{-# LINE 1085 "src/ehc/AbstractCore.chs" #-} +-- | Coercions may either be applied or not on type arguments. +-- In particular, due to lack of proper analysis (and generics code like generation), +-- it is only known for arrow and product types how to construct a coercion from its type args, as they directly +-- correspond to values. +-- +-- A CoeCtx encodes this yes/no may allow. +-- A CoeCtx is isomorphic (for now) to Bool. +data CoeCtx + = CoeCtx_Allow + | CoeCtx_DontAllow + deriving (Eq,Show) + +{-# LINE 1103 "src/ehc/AbstractCore.chs" #-} +-- | Non inspectable, most general, coercion +acoreCoeMap :: (e -> e) -> Coe' e m b ba t +acoreCoeMap = Coe_Map +{-# INLINE acoreCoeMap #-} + +-- | Coe identity +acoreCoeId :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Coe' e m b ba t +acoreCoeId = Coe_C acoreCoeArg +{-# INLINE acoreCoeId #-} + +{-# LINE 1115 "src/ehc/AbstractCore.chs" #-} +acoreCoeLamLetTy :: HsName -> t -> UID -> Coe' e m b ba t +acoreCoeLamLetTy = Coe_LamLet +{-# INLINE acoreCoeLamLetTy #-} + +acoreCoeLamLet :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> UID -> Coe' e m b ba t +acoreCoeLamLet n u = acoreCoeLamLetTy n (acoreTyErr "acoreCoeLamLet") u +{-# INLINE acoreCoeLamLet #-} + +-- | Let still requiring a body +acoreCoeLetRec :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [b] -> Coe' e m b ba t +acoreCoeLetRec [] = acoreCoeId +acoreCoeLetRec bs = Coe_LetRec bs + +{-# LINE 1130 "src/ehc/AbstractCore.chs" #-} +-- | Application still requiring a function +acoreCoeApp1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => e -> Coe' e m b ba t +acoreCoeApp1 = Coe_App1 -- a acoreMetavalDflt +{-# INLINE acoreCoeApp1 #-} + +acoreCoeAppNbyName :: [(HsName)] -> Coe' e m b ba t +acoreCoeAppNbyName = Coe_App +{-# INLINE acoreCoeAppNbyName #-} + +-- acoreCoeApp2 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [(e)] -> Coe' e m b ba t +-- acoreCoeApp2 as = acoreCoeMap (\e -> acoreApp e as) + +acoreCoeAppN :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [e] -> Coe' e m b ba t +acoreCoeAppN as = acoreCoeMap (\e -> acoreApp e as) +{-# INLINE acoreCoeAppN #-} + +{-# LINE 1148 "src/ehc/AbstractCore.chs" #-} +-- | Lambda still requiring a body +acoreCoeLam1Ty :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> t -> Coe' e m b ba t +acoreCoeLam1Ty = Coe_Lam +{-# INLINE acoreCoeLam1Ty #-} + +acoreCoeLam1 :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => HsName -> Coe' e m b ba t +acoreCoeLam1 n = acoreCoeLam1Ty n (acoreTyErr "acoreCoeLam1") +{-# INLINE acoreCoeLam1 #-} + +{-# LINE 1159 "src/ehc/AbstractCore.chs" #-} +-- | Composition of 2 Coe's +acoreCoeCompose :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Coe' e m b ba t -> Coe' e m b ba t -> Coe' e m b ba t +acoreCoeCompose c1 c2 + | acoreCoeIsId c1 = c2 + | otherwise = Coe_Compose c1 c2 + + +{-# LINE 1168 "src/ehc/AbstractCore.chs" #-} +acoreCoePoiLApp :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => [PredOccId] -> [Coe' e m b ba t] +acoreCoePoiLApp = map (\i -> acoreCoeApp1 (acoreNmHolePred i)) + +acoreCoeImplsApp :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Impls -> [Coe' e m b ba t] +acoreCoeImplsApp = acoreCoePoiLApp . implsPrIdL + +{-# LINE 1176 "src/ehc/AbstractCore.chs" #-} +acoreCoePoiLLamTy :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Coe' e m b ba t -> [(PredOccId,t)] -> [Coe' e m b ba t] +acoreCoePoiLLamTy onLast poiL + = case map mk poiL of + l@(_:_) -> h ++ [t `acoreCoeCompose` onLast] + where (h,t) = fromJust $ initlast l + _ | acoreCoeIsId onLast -> [] + | otherwise -> [onLast] + where mk (poi,ty) = acoreCoeLam1Ty (poiHNm poi) ty + +acoreCoeImplsLam :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Coe' e m b ba t -> Impls -> [Coe' e m b ba t] +acoreCoeImplsLam onLast is = acoreCoePoiLLamTy onLast (acoreTyErrLift "acoreCoeImplsLam" (implsPrIdL is)) + +{-# LINE 1194 "src/ehc/AbstractCore.chs" #-} +acoreCoeIsId :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Coe' e m b ba t -> Bool +acoreCoeIsId (Coe_C e) = acoreExprIsCoeArg e +acoreCoeIsId _ = False + +{-# LINE 1204 "src/ehc/AbstractCore.chs" #-} +data CSubstKey + = CSKey_UID UID + | CSKey_Nm HsName + | CSKey_Ref ACoreBindRef + deriving (Show,Eq,Ord) + +{-# LINE 1212 "src/ehc/AbstractCore.chs" #-} +data CSubstInfo' expr metaval bind bindasp ty + = CSITy { csiTy :: !ty + } + | CSIExpr { csiRepl :: !expr + } + | CSIImpls { csiAppCoeL :: ![Coe' expr metaval bind bindasp ty] + , csiLamCoeL :: ![Coe' expr metaval bind bindasp ty] + } + | CSIBinds { csiBindL :: ![bind] + } + +instance Show (CSubstInfo' e m b ba t) where + show _ = "CSubstInfo'" + +{-# LINE 1230 "src/ehc/AbstractCore.chs" #-} +type CSubst' e m b ba t = Map.Map CSubstKey (CSubstInfo' e m b ba t) + +emptyCSubst :: CSubst' e m b ba t +emptyCSubst = Map.empty + +{-# LINE 1241 "src/ehc/AbstractCore.chs" #-} +acoreCSubstFromNmTyL :: AssocL HsName t -> CSubst' e m b ba t +acoreCSubstFromNmTyL l = Map.fromList [ (CSKey_Nm k,CSITy v) | (k,v) <- l ] + +{-# LINE 1246 "src/ehc/AbstractCore.chs" #-} +acoreCSubstFromRefExprL :: AssocL ACoreBindRef e -> CSubst' e m b ba t +acoreCSubstFromRefExprL l = Map.fromList [ (CSKey_Ref k,CSIExpr v) | (k,v) <- l ] + +{-# LINE 1251 "src/ehc/AbstractCore.chs" #-} +acoreCSubstFromUidExprL :: AssocL UID e -> CSubst' e m b ba t +acoreCSubstFromUidExprL l = Map.fromList [ (CSKey_UID k,CSIExpr v) | (k,v) <- l ] + +{-# LINE 1256 "src/ehc/AbstractCore.chs" #-} +acoreCSubstFromUidBindLL :: AssocL UID [b] -> CSubst' e m b ba t +acoreCSubstFromUidBindLL l = Map.fromList [ (CSKey_UID k,CSIBinds v) | (k,v) <- l ] + +acoreCSubstFromUidImplsL :: AssocL UID ([Coe' e m b ba t],[Coe' e m b ba t]) -> CSubst' e m b ba t +acoreCSubstFromUidImplsL l = Map.fromList [ (CSKey_UID k,uncurry CSIImpls v) | (k,v) <- l ] + +{-# LINE 1268 "src/ehc/AbstractCore.chs" #-} +-- | Combine CSubst: union only, application is postponed +cSubstAppSubst :: CSubst' e m b ba t -> CSubst' e m b ba t -> CSubst' e m b ba t +cSubstAppSubst = Map.union + +{-# LINE 1278 "src/ehc/AbstractCore.chs" #-} +infixr `cSubstApp` + +class CSubstitutable e m b ba t a + | a -> e m b ba t + where + cSubstApp :: CSubst' e m b ba t -> a -> a + +instance CSubstitutable e m b ba t (CSubst' e m b ba t) where + cSubstApp cs s = cs `cSubstAppSubst` s + +{-# LINE 1294 "src/ehc/AbstractCore.chs" #-} +data RAlt' e t b pr + = RAlt_Alt { rcaPats :: ![RPat' e t b pr], raaExpr :: !e, raaFailS :: UIDS } + +data RPat' e t b pr + = RPat_Var { rcpPNm :: !RPatNm, rcpTy :: !t, rcpMustEval :: Bool } + | RPat_Con { rcpPNm :: !RPatNm, rcpTy :: !t, rcpTag :: !CTag, rcpBinds :: !(RPatConBind' e t b pr) } + | RPat_Int { rcpPNm :: !RPatNm, rcpTy :: !t, rcpInt :: !Integer } + | RPat_Char { rcpPNm :: !RPatNm, rcpTy :: !t, rcpChar :: !Char } + | RPat_Irrefutable { rcpPNm :: !RPatNm, rcpTy :: !t, rcpValBindL :: ![b] } + | RPat_BoolExpr { rcpPNm :: !RPatNm, rcpTy :: !t, rcpExpr :: !e, rcpMbConst :: Maybe SrcConst } + +data RPatConBind' e t b pr + = RPatConBind_One { rpcbRest :: !pr, rpcbBinds :: ![RPatFld' e t b pr] } + | RPatConBind_Many { rpcbConBinds :: ![RPatConBind' e t b pr] } + +data RPatFld' e t b pr + = RPatFld_Fld { rpbLbl :: !HsName, rpbOffset :: !e, rpbNm :: !HsName, rpbPat :: !(RPat' e t b pr)} + +type RCEAltL' e t b pr = [RAlt' e t b pr] + +{-# LINE 1318 "src/ehc/AbstractCore.chs" #-} +rcaPat :: RAlt' e t b pr -> RPat' e t b pr +rcaPat = head . rcaPats + +raltLPatNms :: [RAlt' e t b pr] -> [RPatNm] +raltLPatNms = nub . sort . map (rcpPNm . rcaPat) + +{-# LINE 1326 "src/ehc/AbstractCore.chs" #-} +rpatConTag :: RPat' e t b pr -> CTag +rpatConTag (RPat_Int _ _ _ ) = ctagInt +rpatConTag (RPat_Char _ _ _ ) = ctagChar +rpatConTag p = rcpTag p + +rcaTag :: RAlt' e t b pr -> CTag +rcaTag = rpatConTag . head . rcaPats + +{-# LINE 1336 "src/ehc/AbstractCore.chs" #-} +raltIsVar :: RAlt' e t b pr -> Bool +raltIsVar (RAlt_Alt (RPat_Var _ _ _ : _) _ _) = True +raltIsVar _ = False + +raltIsConst :: RAlt' e t b pr -> Bool +raltIsConst (RAlt_Alt (p : _) _ _) + = c p + where c (RPat_Int _ _ _) = True + c (RPat_Char _ _ _) = True + c _ = False + +{-# LINE 1349 "src/ehc/AbstractCore.chs" #-} +raltIsConMany :: RAlt' e t b pr -> Bool +raltIsConMany (RAlt_Alt (RPat_Con _ _ _ (RPatConBind_Many _) : _) _ _) = True +raltIsConMany _ = False + +{-# LINE 1355 "src/ehc/AbstractCore.chs" #-} +raltIsIrrefutable :: RAlt' e t b pr -> Bool +raltIsIrrefutable (RAlt_Alt (RPat_Irrefutable _ _ _ : _) _ _) = True +raltIsIrrefutable _ = False + +{-# LINE 1361 "src/ehc/AbstractCore.chs" #-} +raltMbBoolExpr :: RAlt' e t b pr -> Maybe (Maybe SrcConst) +raltMbBoolExpr (RAlt_Alt (RPat_BoolExpr _ _ _ e : _) _ _) = Just e +raltMbBoolExpr _ = Nothing + +raltIsBoolExpr :: RAlt' e t b pr -> Bool +raltIsBoolExpr = isJust . raltMbBoolExpr + +{-# LINE 1372 "src/ehc/AbstractCore.chs" #-} +rpatConBindUnFlatten :: RPatConBind' e t b pr -> [RPatConBind' e t b pr] -> RPatConBind' e t b pr +rpatConBindUnFlatten z [] = z +rpatConBindUnFlatten _ [b] = b +rpatConBindUnFlatten _ bs = RPatConBind_Many bs + +{-# LINE 1383 "src/ehc/AbstractCore.chs" #-} +acoreRPat2Pat :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RPat' e t b pr -> p +acoreRPat2Pat p + = case p of + RPat_Var n ty _ -> acorePatVarTy (rpatNmNm n) ty + RPat_Con n _ t b -> acorePatCon t r bs + where (r,bs) = acoreRPatConBind2PatConBind b + RPat_Int n ty v -> acorePatIntTy2 ty v + RPat_Char n ty v -> acorePatCharTy ty v + RPat_BoolExpr n _ v _ -> acorePatBoolExpr v + +{-# LINE 1397 "src/ehc/AbstractCore.chs" #-} +acoreRPatConBind2PatConBind :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RPatConBind' e t b pr -> (pr,[pf]) +acoreRPatConBind2PatConBind b + = case b of + RPatConBind_One r bs -> (r,map acoreRPatBind2PatFld bs) + RPatConBind_Many bs -> head (map acoreRPatConBind2PatConBind bs) + +acoreRPatBind2PatFld :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RPatFld' e t b pr -> pf +acoreRPatBind2PatFld (RPatFld_Fld l o _ p@(RPat_Var n _ _)) = acorePatFldTy (rcpTy p) (l,o) (rpatNmNm n) + +{-# LINE 1414 "src/ehc/AbstractCore.chs" #-} +ctagTrue, ctagFalse :: EHCOpts -> CTag +ctagTrue opts = CTag (ehcOptBuiltin opts ehbnDataBool) (ehcOptBuiltin opts ehbnBoolTrue) tagBoolTrue 0 0 -- this makes it hardcoded, ideally dependent on datatype def itself !! +ctagFalse opts = CTag (ehcOptBuiltin opts ehbnDataBool) (ehcOptBuiltin opts ehbnBoolFalse) tagBoolFalse 0 0 -- this makes it hardcoded, ideally dependent on datatype def itself !! + +{-# LINE 1426 "src/ehc/AbstractCore.chs" #-} +ctagCons, ctagNil :: EHCOpts -> CTag +ctagCons opts = CTag (ehcOptBuiltin opts ehbnDataList) (ehcOptBuiltin opts ehbnDataListAltCons) tagListCons 2 2 -- this makes it hardcoded, ideally dependent on datatype def itself !! +ctagNil opts = CTag (ehcOptBuiltin opts ehbnDataList) (ehcOptBuiltin opts ehbnDataListAltNil ) tagListNil 0 2 -- this makes it hardcoded, ideally dependent on datatype def itself !! + +{-# LINE 1436 "src/ehc/AbstractCore.chs" #-} +-- | Reason to fail a case alternative +data CaseAltFailReason + = CaseAltFailReason_Absence -- failed because of absence + | CaseAltFailReason_Continue + { cafailCaseId :: UID -- failed as part of case match attempt, but continues with code identified by id + } + deriving (Show,Eq,Ord) + +instance PP CaseAltFailReason where + pp (CaseAltFailReason_Continue i) = pp i + pp (CaseAltFailReason_Absence ) = pp "absent" + +{-# LINE 1450 "src/ehc/AbstractCore.chs" #-} +cafailHasId :: CaseAltFailReason -> (Bool,UID) +cafailHasId (CaseAltFailReason_Absence ) = (False,uidUnused) +cafailHasId (CaseAltFailReason_Continue i) = (True ,i) + +{-# LINE 1456 "src/ehc/AbstractCore.chs" #-} +deriving instance Typeable CaseAltFailReason +deriving instance Data CaseAltFailReason + +{-# LINE 1465 "src/ehc/AbstractCore.chs" #-} +data AppFunKind + = AppFunKind_NoApp -- inlined Nothing + | AppFunKind_Fun ACoreBindRef + | AppFunKind_Tag CTag + | AppFunKind_FFI + +{-# LINE 1477 "src/ehc/AbstractCore.chs" #-} + +-- | What kind of Expr? +data WhatExpr + = ExprIsLam Int -- arity + | ExprIsApp Int -- arity + WhatExpr -- function + | ExprIsVar HsName + | ExprIsInt Int + | ExprIsTup CTag + | ExprIsFFI + | ExprIsOtherWHNF + | ExprIsOther + | ExprIsBind + deriving Eq + +{-# LINE 1494 "src/ehc/AbstractCore.chs" #-} +-- | is an var? +whatExprMbVar :: WhatExpr -> Maybe HsName +whatExprMbVar (ExprIsVar a) = Just a +whatExprMbVar _ = Nothing + +-- | is an app? +whatExprMbApp :: WhatExpr -> Maybe (Int,WhatExpr) +whatExprMbApp (ExprIsApp a w) = Just (a,w) +whatExprMbApp _ = Nothing + +-- | is a lam? +whatExprMbLam :: WhatExpr -> Maybe Int +whatExprMbLam (ExprIsLam a) = Just a +whatExprMbLam _ = Nothing + +-- | app arity +whatExprAppArity :: WhatExpr -> Int +whatExprAppArity (ExprIsApp a _) = a +whatExprAppArity _ = 0 + +{-# LINE 1516 "src/ehc/AbstractCore.chs" #-} +whatExprIsWHNF :: WhatExpr -> Bool +whatExprIsWHNF (ExprIsLam _) = True +whatExprIsWHNF (ExprIsVar _) = True +whatExprIsWHNF (ExprIsInt _) = True +whatExprIsWHNF (ExprIsTup _) = True +whatExprIsWHNF ExprIsOtherWHNF = True +whatExprIsWHNF _ = False + +{-# LINE 1526 "src/ehc/AbstractCore.chs" #-} +whatExprIsLam :: WhatExpr -> Bool +whatExprIsLam = isJust . whatExprMbLam +{-# INLINE whatExprIsLam #-} + +-- | Is Expr a Tup? +whatExprIsTup :: WhatExpr -> Bool +whatExprIsTup (ExprIsTup _) = True +whatExprIsTup _ = False + + +{-# LINE 1538 "src/ehc/AbstractCore.chs" #-} +-- | Is Expr a FFI? +whatExprIsFFI :: WhatExpr -> Bool +whatExprIsFFI (ExprIsFFI ) = True +whatExprIsFFI _ = False + + +{-# LINE 1556 "src/ehc/AbstractCore.chs" #-} +instance Serialize ACoreBindAspectKey where + sput (ACoreBindAspectKey_Default ) = sputWord8 0 + sput (ACoreBindAspectKey_Strict ) = sputWord8 1 + sput (ACoreBindAspectKey_Ty ) = sputWord8 2 + sput (ACoreBindAspectKey_RelevTy ) = sputWord8 3 + sput (ACoreBindAspectKey_Debug ) = sputWord8 4 + sput (ACoreBindAspectKey_Core ) = sputWord8 5 + sput (ACoreBindAspectKey_FusionRole ) = sputWord8 7 + sget = do + t <- sgetWord8 + case t of + 0 -> return ACoreBindAspectKey_Default + 1 -> return ACoreBindAspectKey_Strict + 2 -> return ACoreBindAspectKey_Ty + 3 -> return ACoreBindAspectKey_RelevTy + 4 -> return ACoreBindAspectKey_Debug + 5 -> return ACoreBindAspectKey_Core + 7 -> return ACoreBindAspectKey_FusionRole + +{-# LINE 1587 "src/ehc/AbstractCore.chs" #-} +instance Serialize ACoreBindRef where + sput (ACoreBindRef a b) = sput a >> sput b + sget = liftM2 ACoreBindRef sget sget + +{-# LINE 1593 "src/ehc/AbstractCore.chs" #-} +instance Serialize CaseAltFailReason where + sput (CaseAltFailReason_Continue a) = sputWord8 0 >> sput a + sput (CaseAltFailReason_Absence ) = sputWord8 1 + sget = do + t <- sgetWord8 + case t of + 0 -> liftM CaseAltFailReason_Continue sget + 1 -> return CaseAltFailReason_Absence + +{-# LINE 1608 "src/ehc/AbstractCore.chs" #-} +instance PP CSubstKey where + pp (CSKey_UID i) = pp i + pp (CSKey_Nm n) = pp n + pp (CSKey_Ref r) = pp r + +{-# LINE 1615 "src/ehc/AbstractCore.chs" #-} +instance (PP expr, PP ty) => PP (CSubstInfo' expr metaval bind bindasp ty) where + pp (CSITy t ) = pp t + pp (CSIExpr e ) = pp e + pp (CSIImpls l r ) = pp "CSIImpls" -- pp (fst $ coeWeaveOnAsSubst uidStart l r CExpr_CoeArg) + pp (CSIBinds b ) = pp "CSIBinds" -- ppCBindL b + diff --git a/src/UHC/Light/Compiler/AbstractCore/Utils.hs b/src/UHC/Light/Compiler/AbstractCore/Utils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AbstractCore/Utils.hs @@ -0,0 +1,499 @@ +module UHC.Light.Compiler.AbstractCore.Utils +( CaseFailSubst' +, RCEEnv' (..), emptyRCEEnv +, rceEnvDataAlts +, acorePatTagArityMbNms +, acoreAltLSaturate +, acoreAltOffsetL +, MbPatRest' +, acoreStrictSatCaseMetaTy, acoreStrictSatCaseTy +, acoreSelsCasesMetaTy +, acoreSelsCaseMetaTy, acoreSelsCaseTy +, acoreSelCaseTy +, acoreSatSelsCasesTy +, acoreSatSelsCaseMetaTy, acoreSatSelsCaseTy +, acoreExprSatSelCaseTy +, rceMatchTy +, rceUpdEnv +, acoreRPatBindL2BindL +, acoreCSubstFromVarMpImpls +, acoreMatchStringTy +, acoreMatchTupleTy ) +where +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.ValGam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.List +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty + + + +{-# LINE 32 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Substitution for fail construct, identified by a UID +type CaseFailSubst' e m b ba t = CSubst' e m b ba t + +{-# LINE 37 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Env to support Reordering of Case Expression (RCE) +data RCEEnv' expr metaval bind bindasp ty + = RCEEnv + { rceValGam :: !ValGam -- type of value (amongst other) + , rceTyVarMp :: !VarMp -- tvar bindings for ValGam + , rceDataGam :: !DataGam -- data type + constructor info + , rceCaseFailSubst :: !(CaseFailSubst' expr metaval bind bindasp ty) -- fail continuation map + , rceCaseIds :: !UIDS -- fail ids + , rceCaseCont :: !expr -- continuation + , rceEHCOpts :: !EHCOpts -- options + -- , rceIsStrict :: !Bool -- scrutinee must be evaluated + } + +emptyRCEEnv :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> RCEEnv' e m b ba t +emptyRCEEnv opts = RCEEnv emptyGam emptyVarMp emptyGam Map.empty (Set.singleton uidStart) (acoreBuiltinUndefined opts) opts -- True + +{-# LINE 55 "src/ehc/AbstractCore/Utils.chs" #-} +-- | All tags of the type of the constructor for a tag t +rceEnvDataAlts :: RCEEnv' e m b ba t -> CTag -> Maybe [CTag] +rceEnvDataAlts env t + = case t of + CTag _ conNm _ _ _ + -> case valGamTyOfDataCon conNm (rceValGam env) of + (_,ty,[]) + -> dataGamTagsOfTy (rceTyVarMp env `varUpd` ty) (rceDataGam env) + _ -> Nothing + -- panic ("rceEnvDataAlts: " ++ show conNm) -- Nothing + -- dataGamTagsOfTy (appCon conNm) (rceDataGam env) + _ -> Nothing + +{-# LINE 74 "src/ehc/AbstractCore/Utils.chs" #-} +acorePatTagArityMbNms :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> CTag -> Int -> Maybe [HsName] -> p +acorePatTagArityMbNms opts ctag arity mbNmL + = pat + where pat = acorePatCon ctag (acorePatRestEmpty) (zipWith mkB nmL [0 .. arity - 1]) + mkB n o = acorePatFldTy (acoreTyErr "acorePatTagArityMbNms") (n,acoreInt opts o) n + nmL = maybe (repeat hsnWild) id mbNmL + +{-# LINE 94 "src/ehc/AbstractCore/Utils.chs" #-} +acoreAltLSaturate :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> [a] -> [a] +acoreAltLSaturate env alts + = case alts of + (alt1:_) -> listSaturateWith 0 (length allAlts - 1) altIntTag allAlts alts + where (allAlts,altIntTag) + = case acorePatMbCon pat of + -- if a con pat, use the tag to dispatch upon + Just (CTagRec,_,_) + -> ([(0,alt1)], const 0) + Just (tg,_,_) + -> case rceEnvDataAlts env tg of + Just ts -> ([ (ctagTag t,mkA env t (ctagArity t)) | t <- ts ], ctagTag . panicJust "acoreAltLSaturate.rceEnvDataAlts(2)" . acoreAltMbTag) + _ -> -- tr "acoreAltLSaturate" (pp tg) $ + ([(0,alt1)], const 0) + -- _ -> panic ("acoreAltLSaturate.rceEnvDataAlts(1): " ++ show tg) + _ -> case acorePatMbInt pat of + -- if an int, use the int to dispatch upon; used internally only (by deriving Enum) + Just (_,i) -> ([ (fromInteger i, a) | a <- alts ], fromInteger . snd . panicJust "acoreAltLSaturate.acorePatMbInt(2)" . acorePatMbInt . fst . acoreUnAlt) + _ -> panic "acoreAltLSaturate.acorePatMbInt(1)" + where (pat,_) = acoreUnAlt alt1 + mkA env ct a = acoreAlt (acorePatTagArityMbNms (rceEHCOpts env) ct a Nothing) (rceCaseCont env) + _ -> [] + +{-# LINE 123 "src/ehc/AbstractCore/Utils.chs" #-} +acorePatBindOffsetL :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> [pf] -> ([pf],[b]) +acorePatBindOffsetL opts pbL + = let (pbL',obL) + = unzip + . map + (\b -> let ((l,o),pbind) = acoreUnPatFld b + (n,_) = acoreUnBind pbind + offNm = hsnUniqify HsNameUniqifier_FieldOffset l + in case acoreExprMbInt o of + Just _ -> (b,[]) + _ -> (acorePatFldTy (acoreTyErr "acorePatBindOffsetL") (l,acoreVar offNm) n,[acoreBind1Ty offNm (acoreTyInt opts) o]) + ) + $ pbL + in (pbL',concat obL) + +{-# LINE 140 "src/ehc/AbstractCore/Utils.chs" #-} +acoreAltOffsetL :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> a -> (a,[b]) +acoreAltOffsetL opts alt + = case acorePatMbCon p of + Just (t,r,b) + -> (acoreAlt (acorePatCon t r b') e,offBL) + where (b',offBL) = acorePatBindOffsetL opts b + _ -> (alt,[]) + where (p,e) = acoreUnAlt alt + +{-# LINE 155 "src/ehc/AbstractCore/Utils.chs" #-} +type MbPatRest' pr = Maybe (pr,Int) -- (pat rest, arity) + +{-# LINE 159 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make case expression from alternatives, saturating the alternatives w.r.t. all constructors +-- | Either: +-- | - make a case expr from alternatives, +-- | saturating the alternatives with defaults for missing alternatives. +-- | - or, when only a single alternative binding a single field, bind it directly with a let +acoreStrictSatCaseMetaTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> m -> e -> [a] -> e +acoreStrictSatCaseMetaTy env mbNm meta e [] + = rceCaseCont env -- TBD: should be error message "scrutinizing datatype without constructors" +acoreStrictSatCaseMetaTy env mbNm meta e [alt] + | isJust mbPatCon && length flds == 1 && not (ctagIsRec tg) && isJust mbDgi && dgiIsNewtype (fromJust mbDgi) + = acoreLet cat + ( [ acoreBind1CatMetaTy cat pnm meta ty e ] + ++ maybe [] (\(n,ty) -> [ acoreBind1CatMetaTy cat n meta ty e ]) mbNm + ) ae + where mbDgi = dataGamLookup (ctagTyNm tg) (rceDataGam env) + (pat,ae) = acoreUnAlt alt + mbPatCon@(~(Just (tg,_,flds@(~([fld]))))) = acorePatMbCon pat + (_,pbind) = acoreUnPatFld fld + (pnm,_) = acoreUnBind pbind + cat = acoreBindcategPlain + ty = maybe (acoreTyErr "acoreStrictSatCaseMetaTy.ty") snd mbNm +acoreStrictSatCaseMetaTy env mbNm meta e alts + = case mbNm of + Just (n,ty) -> acoreLet1StrictInMetaTy n meta ty e $ mk alts + Nothing -> mk alts e + where mk (alt:alts) n + = acoreLet (acoreBindcategStrict) altOffBL (acoreCaseDflt n (acoreAltLSaturate env (alt':alts)) (Just undef)) + where (alt',altOffBL) = acoreAltOffsetL (rceEHCOpts env) alt + mk [] n + = acoreCaseDflt n [] (Just undef) -- dummy case + undef = acoreBuiltinUndefined (rceEHCOpts env) + +acoreStrictSatCaseMeta :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName) -> m -> e -> [a] -> e +acoreStrictSatCaseMeta env eNm m e alts = acoreStrictSatCaseMetaTy env (acoreTyErrLift "acoreStrictSatCaseMeta" eNm) m e alts +{-# INLINE acoreStrictSatCaseMeta #-} + +acoreStrictSatCaseTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> [a] -> e +acoreStrictSatCaseTy env eNm e alts = acoreStrictSatCaseMetaTy env eNm acoreMetavalDflt e alts +{-# INLINE acoreStrictSatCaseTy #-} + +acoreStrictSatCase :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName) -> e -> [a] -> e +acoreStrictSatCase env eNm e alts = acoreStrictSatCaseMeta env eNm acoreMetavalDflt e alts +{-# INLINE acoreStrictSatCase #-} + +{-# LINE 207 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from non-saturated alternatives, +-- | alternatives are given by their tag + fields (name/offset) + rest (for extensible records) + alt expr +acoreSelsCasesMetaTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> m -> e -> [(CTag,[(HsName,t,{-HsName,-}e)],MbPatRest' pr,e)] -> e +acoreSelsCasesMetaTy env mbNm meta e tgSels + = acoreStrictSatCaseMetaTy env mbNm meta e alts + where alts = [ acoreAlt + (acorePatCon ct + (mkRest mbRest ct) + [acorePatFldTy t (n,off) n | (n,t,{-lbl,-}off) <- nmLblOffL] + ) + sel + | (ct,nmLblOffL,mbRest,sel) <- tgSels + ] + mkRest mbr ct + = case mbr of + Just (r,_) -> r + _ -> ctag (acorePatRestVar hsnWild) (\_ _ _ _ _ -> acorePatRestEmpty) ct + + +{-# LINE 228 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from a single alternative, +-- | the alternative given by their tag + fields (name/offset) + rest (for extensible records) + alt expr +acoreSelsCaseMetaTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> m -> e -> CTag -> [(HsName,t,{-HsName,-}e)] -> MbPatRest' pr -> e -> e +acoreSelsCaseMetaTy env ne meta e ct nmLblOffL mbRest sel = acoreSelsCasesMetaTy env ne meta e [(ct,nmLblOffL,mbRest,sel)] + +acoreSelsCaseTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> CTag -> [(HsName,t,{-HsName,-}e)] -> MbPatRest' pr -> e -> e +acoreSelsCaseTy env ne e ct nmLblOffL mbRest sel = acoreSelsCaseMetaTy env ne acoreMetavalDflt e ct nmLblOffL mbRest sel +{-# INLINE acoreSelsCaseTy #-} + +{-# LINE 239 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from a single alternative with a single field, +-- | the alternative given by their tag + field (name/offset) + rest (for extensible records) + alt expr +acoreSelCaseTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> CTag -> HsName -> e -> MbPatRest' pr -> e +acoreSelCaseTy env ne e ct n {-lbl-} off mbRest + = acoreSelsCaseTy env ne e ct [(n,acoreTyErr $ "acoreSelCaseTy: " ++ show n,{-lbl,-}off)] mbRest (acoreVar n) + +acoreSelCase :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe HsName -> e -> CTag -> HsName -> e -> MbPatRest' pr -> e +acoreSelCase env ne e ct n {-lbl-} off mbRest + = acoreSelCaseTy env (acoreTyErrLift "acoreSelCase" ne) e ct n {-lbl-} off mbRest +{-# INLINE acoreSelCase #-} + +{-# LINE 252 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from a single alternative with non-saturated fields, +-- | the alternative given by their tag + field (name/offset) + rest (for extensible records) + alt expr, +-- | the fields (and alternatives) are saturated according to the tag + rest info +acoreSatSelsCasesMetaTy + :: forall e m b bound boundmeta bcat mbind t p pr pf a ba . + (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> m -> e -> [(CTag,[(HsName,t,{-HsName,-}Int)],MbPatRest' pr,e)] -> e +acoreSatSelsCasesMetaTy env ne meta e tgSels + = acoreSelsCasesMetaTy env ne meta e alts + where mkOffL ct mbr nol + = case (ct,mbr) of + (CTagRec ,Nothing ) -> map mklo nol + (CTagRec ,Just (_,a)) -> mkloL a + (CTag _ _ _ a _,_ ) -> mkloL a + where mklo :: (HsName,t,Int) -> (HsName,t,e) + mklo (n,t,o) = (n,t,acoreInt opts o) + mkloL :: Int -> [(HsName,t,e)] + mkloL a = map mklo + $ listSaturateWith + 0 (a-1) + (\(_,_,o) -> o) + [(o,(l,acoreTyErr $ "acoreSatSelsCasesMetaTy.mkloL: " ++ show l,o)) | (o,l) <- zip [0..a-1] hsnLclSupply] + nol + alts = [ (ct,mkOffL ct mbRest nmLblOffL,mbRest,sel) | (ct,nmLblOffL,mbRest,sel) <- tgSels ] + opts = rceEHCOpts env + +acoreSatSelsCasesTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> [(CTag,[(HsName,t,{-HsName,-}Int)],MbPatRest' pr,e)] -> e +acoreSatSelsCasesTy env ne e tgSels = acoreSatSelsCasesMetaTy env ne acoreMetavalDflt e tgSels +{-# INLINE acoreSatSelsCasesTy #-} + +{-# LINE 283 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from a single alternative with non-saturated fields, +-- | the alternative given by their tag + field (name/offset) + rest (for extensible records) + alt expr, +-- | the fields (and alternatives) are saturated according to the tag + rest info +acoreSatSelsCaseMetaTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> m -> e -> CTag -> [(HsName,t,{-HsName,-}Int)] -> MbPatRest' pr -> e -> e +acoreSatSelsCaseMetaTy env ne meta e ct nmLblOffL mbRest sel = acoreSatSelsCasesMetaTy env ne meta e [(ct,nmLblOffL,mbRest,sel)] + +acoreSatSelsCaseTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> CTag -> [(HsName,t,{-HsName,-}Int)] -> MbPatRest' pr -> e -> e +acoreSatSelsCaseTy env ne e ct nmLblOffL mbRest sel = acoreSatSelsCaseMetaTy env ne acoreMetavalDflt e ct nmLblOffL mbRest sel +{-# INLINE acoreSatSelsCaseTy #-} + +{-# LINE 295 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Make a case expr from a single alternative with a single field, +-- | the alternative given by their tag + field (name/offset) + rest (for extensible records) + alt expr, +-- | the fields (and alternatives) are saturated according to the tag + rest info +acoreExprSatSelCaseTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName,t) -> e -> CTag -> HsName -> {- HsName -> -} Int -> MbPatRest' pr -> e +acoreExprSatSelCaseTy env ne e ct n {- lbl -} off mbRest = acoreSatSelsCaseTy env ne e ct [(n,acoreTyErr $ "acoreExprSatSelCaseTy: " ++ show n,{-lbl,-}off)] mbRest (acoreVar n) + +acoreExprSatSelCase :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Maybe (HsName) -> e -> CTag -> HsName -> {- HsName -> -} Int -> MbPatRest' pr -> e +acoreExprSatSelCase env ne e ct n {- lbl -} off mbRest = acoreExprSatSelCaseTy env (acoreTyErrLift "acoreExprSatSelCase" ne) e ct n {- lbl -} off mbRest +{-# INLINE acoreExprSatSelCase #-} + +{-# LINE 327 "src/ehc/AbstractCore/Utils.chs" #-} +acoreMatchStringTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> String -> t -> e -> e -> e -> e +acoreMatchStringTy env str ty ok fail e + = acoreLet1PlainTy x ty e + $ foldr (\(c,ns@(_,xh,_)) ok + -> matchCons ns + $ acoreMatchChar opts (Just $ hsnUniqifyEval xh) c (acoreVar xh) ok fail + ) + (matchNil xt ok) + $ zip str nms + where env' = env {rceCaseCont = fail} + matchCons (x,xh,xt) e = acoreSatSelsCaseTy env' (Just (hsnUniqifyEval x,ty)) (acoreVar x) constag [(xh,acoreTyErr "acoreMatchStringTy.hd",0),(xt,acoreTyErr "acoreMatchStringTy.tl",1)] (Just (acorePatRestEmpty,2)) e + matchNil x e = acoreSatSelsCaseTy env' (Just (hsnUniqifyEval x,ty)) (acoreVar x) niltag [] (Just (acorePatRestEmpty,0)) e + constag = ctagCons opts + niltag = ctagNil opts + opts = rceEHCOpts env + (nms@((x,_,_):_),(xt,_,_)) + = fromJust $ initlast $ snd + $ foldr (\n (nt,l) -> (n,(n,hsnUniqifyStr HsNameUniqifier_Field "h" n,nt):l)) (hsnUnknown,[]) + $ take (length str + 1) $ hsnLclSupplyWith (mkHNmHidden "l") + +{-# LINE 349 "src/ehc/AbstractCore/Utils.chs" #-} +acoreMatchTupleTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> [HsName] -> t -> e -> e -> e +acoreMatchTupleTy env fldNmL ty ok e + = acoreLet1PlainTy x ty e + $ acoreSatSelsCaseTy env (Just (hsnUniqifyEval x,ty)) (acoreVar x) CTagRec (zipWith (\f o -> (f,acoreTyErr $ "acoreMatchTupleTy: " ++ show f,o)) fldNmL [0..]) (Just (acorePatRestEmpty,length fldNmL)) ok + where x = mkHNmHidden "x" + +{-# LINE 361 "src/ehc/AbstractCore/Utils.chs" #-} +data RCESplitCateg + = RCESplitVar UIDS + | RCESplitCon + | RCESplitConMany + | RCESplitConst + | RCESplitIrrefutable + | RCESplitBoolExpr + deriving Eq + +rceSplitMustBeOnItsOwn :: RCESplitCateg -> Bool +rceSplitMustBeOnItsOwn RCESplitConMany = True +rceSplitMustBeOnItsOwn RCESplitIrrefutable = True +rceSplitMustBeOnItsOwn _ = False + +{-# LINE 379 "src/ehc/AbstractCore/Utils.chs" #-} +rceSplit :: (RAlt' e t b pr -> RCESplitCateg) -> RCEAltL' e t b pr -> [RCEAltL' e t b pr] +rceSplit f [] = [] +rceSplit f [x] = [[x]] +rceSplit f (x:xs@(x':_)) + | xcateg == f x' + && not (rceSplitMustBeOnItsOwn xcateg) + = let (z:zs) = rceSplit f xs + in (x:z) : zs + | otherwise + = [x] : rceSplit f xs + where xcateg = f x + +{-# LINE 393 "src/ehc/AbstractCore/Utils.chs" #-} +-- | Add bindings from the name n of each alt to nm, to take care of different namings +rceRebinds :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => Bool -> (HsName,t) -> RCEAltL' e t b pr -> [b] +rceRebinds origOnly (nm,ty) alts + = [ acoreBind1Ty n ty (acoreVar nm) | pn <- raltLPatNms alts, alsoUniq || rpatNmIsOrig pn, let n = rpatNmNm pn, n /= nm ] + where alsoUniq = not origOnly + +{-# LINE 401 "src/ehc/AbstractCore/Utils.chs" #-} +rceMatchVar :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchVar env ((arg,ty):args') alts + = remMatch + where remMatch + = rceMatchTy env args' + [ RAlt_Alt remPats (mk $ acoreLet acoreBindcategPlain (rceRebinds True (arg',ty) [a]) e) f + | a@(RAlt_Alt (RPat_Var _ _ mustEval : remPats) e f) <- alts + , let (arg',mk) = if mustEval + then let argStrict = hsnUniqify HsNameUniqifier_Strict arg + in (argStrict,acoreLet1StrictTy argStrict ty (acoreVar arg)) + else (arg,id) + ] + +rceMatchIrrefutable :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchIrrefutable env (argty@(arg,ty):args') alts@[RAlt_Alt (RPat_Irrefutable n _ b : remPats) e f] + = acoreLet acoreBindcategPlain (rceRebinds False argty alts) $ acoreLet acoreBindcategPlain b remMatch + where remMatch = rceMatchTy env args' [RAlt_Alt remPats e f] + +rceMkConAltAndSubAlts :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> a +rceMkConAltAndSubAlts env ((arg,ty):args) alts@(alt:_) + = acoreAlt altPat (acoreLet acoreBindcategPlain (rceRebinds True (arg,ty) alts) subMatch) + where (subAlts,subAltSubs) + = unzip + [ ( RAlt_Alt (pats ++ ps) e f + , map (\p -> let n = rpatNmNm (rcpPNm p) in (n,rcpTy p)) pats + ) + | (RAlt_Alt (RPat_Con _ _ _ (RPatConBind_One _ pbinds) : ps) e f) <- alts + , let pats = [ p | (RPatFld_Fld _ _ _ p) <- pbinds ] + ] + subMatch + = rceMatchTy env (subAltSub ++ args) subAlts + where subAltSub = zipWith (\(_,t) (n,ni) -> (ni,t)) (head subAltSubs) altNmIntroAssocL + (altPat, altNmIntroAssocL) + = case alt of + RAlt_Alt (RPat_Con n _ t (RPatConBind_One r pbL) : _) _ _ + -> (acorePatCon t r pbL', nmIntroAssocL) + where (pbL',nmIntroAssocL) + = unzip + [ ( acorePatFldTy (rcpTy p) (l,o) introNm -- nm + , (nm, introNm) + ) + | (RPatFld_Fld l o n p, inx) <- zip pbL [(0 :: Int) ..] + , let nm = rpatNmNm $ rcpPNm p + , let introNm = hsnUniqifyInt HsNameUniqifier_Field inx nm + ] + tyerr n = acoreTyErr ("rceMkConAltAndSubAlts: " ++ show n) + +rceMatchCon :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchCon env ((arg,ty):args) alts + = acoreStrictSatCaseTy env (Just (arg',ty)) (acoreVar arg) alts' + where arg' = hsnUniqifyEval arg + alts' = map (rceMkConAltAndSubAlts env ((arg',ty):args)) + $ groupSortOn (ctagTag . rcaTag) + $ filter (not . null . rcaPats) + $ alts + +rceMatchConMany :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchConMany env ((arg,ty):args) [RAlt_Alt (RPat_Con n _ t (RPatConBind_Many bs) : ps) e f] + = acoreLet1StrictInTy arg' ty (acoreVar arg) + (\_ -> foldr (\mka e -> rceMatchTy env [(arg',ty)] (mka e)) (rceMatchTy env ((arg',ty):args) altslast) altsinit) + where arg' = hsnUniqifyEval arg + altsinit = [ \e -> [RAlt_Alt (RPat_Con n ty t b : []) e f] | b <- bsinit ] + altslast = [RAlt_Alt (RPat_Con n ty t blast : ps) e f] + (bsinit,blast) = panicJust "rceMatchConMany" $ initlast bs + +rceMatchConst :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchConst env ((arg,ty):args) alts + = acoreLet1StrictInTy arg' ty (acoreVar arg) (\n -> acoreLet cat (rceRebinds True (arg,ty) alts) (acoreCaseDflt n alts' Nothing {-(rceCaseCont env)-})) + where arg' = hsnUniqifyEval arg + alts' = [ acoreAlt (acoreRPat2Pat p) (cSubstApp (rceCaseFailSubst env) e {- tcSubstCaseAltFail (rceEHCOpts env) (rceCaseFailSubst env) e -}) | (RAlt_Alt (p:_) e _) <- alts ] + cat = acoreBindcategPlain + +{-# LINE 475 "src/ehc/AbstractCore/Utils.chs" #-} +rceMatchBoolExpr :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchBoolExpr env aargs@((arg,_):args) alts + = foldr (\(n,c,t) f -> acoreIf (rceEHCOpts env) (Just n) c t f) (rceCaseCont env) alts' + where alts' = map (\(u, alts@(RAlt_Alt (RPat_BoolExpr _ _ b _ : _) _ _ : _)) + -> ( hsnUniqifyInt HsNameUniqifier_Evaluated u arg + , acoreApp b [acoreVar arg] + , rceMatchTy env args [ RAlt_Alt remPats e f | (RAlt_Alt (RPat_BoolExpr _ _ _ _ : remPats) e f) <- alts ] + ) ) + $ zip [0..] + $ groupSortOn (rcpMbConst . head . rcaPats) + $ filter (not . null . rcaPats) + $ alts + +{-# LINE 490 "src/ehc/AbstractCore/Utils.chs" #-} +rceMatchSplits :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchSplits env args alts@(alt:_) + | raltIsVar alt = rceMatchVar env args alts + | raltIsConst alt = rceMatchConst env args alts + | raltIsIrrefutable alt = rceMatchIrrefutable env args alts + | raltIsBoolExpr alt = rceMatchBoolExpr env args alts + | raltIsConMany alt = rceMatchConMany env args alts + | otherwise = rceMatchCon env args alts + + +{-# LINE 504 "src/ehc/AbstractCore/Utils.chs" #-} +rceMatchTy :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, CSubstitutable e m b ba t e) => RCEEnv' e m b ba t -> [(HsName,t)] -> RCEAltL' e t b pr -> e +rceMatchTy env [] [] = rceCaseCont env +rceMatchTy env [] alts + = case [ e | (RAlt_Alt [] e _) <- alts ] of + (e:_) -> cSubstApp (rceCaseFailSubst env) e -- tcSubstCaseAltFail (rceEHCOpts env) (rceCaseFailSubst env) e + _ -> rceCaseCont env +rceMatchTy env args alts + = foldr + (\alts e + -> case acoreExprMbVar e of + Just _ + -> rceMatchSplits (rceUpdEnv e env) args alts + _ -> acoreLet1PlainTy nc (rcpTy pc) e + $ rceMatchSplits (rceUpdEnv (acoreVar nc) env) args alts + where pc = rcaPat $ head alts + nc = hsnUniqify HsNameUniqifier_CaseContinuation (rpatNmNm $ rcpPNm pc) + ) + (rceCaseCont env) + $ (rceSplit (\a -> if raltIsVar a then RCESplitVar (raaFailS a) + else if raltIsConst a then RCESplitConst + else if raltIsIrrefutable a then RCESplitIrrefutable + else if raltIsBoolExpr a then RCESplitBoolExpr + else if raltIsConMany a then RCESplitConMany + else RCESplitCon + ) alts) + +{-# LINE 539 "src/ehc/AbstractCore/Utils.chs" #-} +rceUpdEnv :: e -> RCEEnv' e m b ba t -> RCEEnv' e m b ba t +rceUpdEnv e env + = env { rceCaseFailSubst = Map.union (acoreCSubstFromUidExprL [ (i,e) | i <- Set.toList (rceCaseIds env) ]) + $ rceCaseFailSubst env + , rceCaseCont = e + } + +{-# LINE 552 "src/ehc/AbstractCore/Utils.chs" #-} +acoreCSubstFromVarMpImpls :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => VarMp -> CSubst' e m b ba t +acoreCSubstFromVarMpImpls c + = acoreCSubstFromUidImplsL + [ (iv,(acoreCoeImplsApp i,acoreCoeImplsLam acoreCoeId i)) + | (iv,VMIImpls i) <- varmpToAssocL c, let (_,mbTl) = implsPredsMbTail i, isNothing mbTl + ] + +{-# LINE 565 "src/ehc/AbstractCore/Utils.chs" #-} +acoreRPatBindL2BindL :: (Eq bcat, AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => RCEEnv' e m b ba t -> Bool -> HsName -> CTag -> MbPatRest' pr -> AssocL (RPatFld' e t b pr) (Maybe Int) -> [b] +acoreRPatBindL2BindL env hasSub parNm ct rest pbL + = concat + $ map (\(RPatFld_Fld l o _ p,mbOff) + -> let b n = [acoreBind1CatTy acoreBindcategPlain n (rcpTy p) (mkc n mbOff)] + pn = parNm + pn' = hsnUniqifyEval pn + mkc n (Just o) = acoreExprSatSelCaseTy env (Just (pn',ty pn')) (acoreVar pn) ct n {- l -} o rest + mkc n Nothing = acoreSelCaseTy env (Just (pn',ty pn')) (acoreVar pn) ct n {- l -} o rest + ty n = acoreTyErr ("acoreRPatBindL2BindL: " ++ show n) + in case rcpPNm p of + RPatNmOrig n -> b n + RPatNmUniq n | hasSub -> b n + _ -> [] + ) + $ pbL + diff --git a/src/UHC/Light/Compiler/AnaDomain.hs b/src/UHC/Light/Compiler/AnaDomain.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain.hs @@ -0,0 +1,569 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/AnaDomain.ag) +module UHC.Light.Compiler.AnaDomain(QualAGItf (..), TyAGItf (..), CoeAGItf (..) +, AnaEval (..), AnaEvalL, RelevTy (..), RelevTyL, MbRelevTy, RelevQual (..), RelevQualL, RelevCoe (..), RelevCoeL +, RQuant (..) +, RelevQualS +, (<.>) +, relevtyAnaEval +, AnaLattice (..) +, freshStrict, freshLazy +, anaMkBotFun +, relevCoeUnCompose +, relevCoeToComposeList +, RVarMpInfo (..) +, rvmiMbEval +, RVarMp, emptyRVarMp +, rvarmpEvalUnit +, rvarmpKeysSet, rvarmpUnions +, AnaMatchState (..), AMS, emptyAnaMatchState +, AMSOut (..), emptyAMSOut, amsoMkOk +, amsLE, amsRunMb) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.VarMp +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.List +import Data.Maybe +import Control.Monad.State +import Control.Applicative +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Control.Monad hiding (join) +import UHC.Util.Serialize +import UHC.Util.Control.Monad (liftM6) +import Data.Typeable (Typeable) +import Data.Generics (Data) + + + + + + + + + + + + + + + + + + + + + +-- | quantifier for RelevTy_Fun +data RQuant + = RQuant_Forall -- the usual universal instantiation + | RQuant_Rec -- quantified for mutual recursive use, instantiates differently + | RQuant_None -- not quantified + deriving + ( Eq, Ord, Enum + , Typeable, Data + ) + + + +instance Show RQuant where + show RQuant_Forall = "A" + show RQuant_Rec = "R" + show RQuant_None = "" + + + +type RelevQualS = Set.Set RelevQual + + + +infixl 3 `RelevCoe_Comp` +infixl 3 <.> + +-- | smart variant of RelevCoe_Comp +(<.>) :: RelevCoe -> RelevCoe -> RelevCoe +RelevCoe_Id <.> r = r +l <.> RelevCoe_Id = l +RelevCoe_Eval ll lr <.> RelevCoe_Eval rl rr + | lr == rl = RelevCoe_Eval ll rr +RelevCoe_CastTy ll (RelevTy_Ana lr) + <.> RelevCoe_Eval rl rr + | lr == rl = RelevCoe_CastTy ll (RelevTy_Ana rr) +l <.> RelevCoe_Comp rl rr = (l <.> rl) `RelevCoe_Comp` rr +RelevCoe_Comp ll lr <.> r = ll `RelevCoe_Comp` (lr <.> r) +l <.> r = RelevCoe_Comp l r + + + +relevtyAnaEval (RelevTy_Ana e) = e +relevtyAnaEval _ = panic "AnaDomain.relevtyAnaEval" + + + +class AnaLattice a where + top :: a + bot :: a + + isTop :: a -> Bool + isBot :: a -> Bool + isVar :: a -> Maybe UID + + fresh :: UID -> a + + meetl :: a -> a -> AMS (Maybe a) + joinl :: a -> a -> AMS (Maybe a) + + -- base <= base + leBB_l :: a -> a -> AMS (AMSOut a) + leBB_r :: a -> a -> AMS (AMSOut a) + leBB_l = leBB + leBB_r = leBB + + -- base <= base + leBB :: a -> a -> AMS (AMSOut a) + leBB = leBB_l + + -- base <= fun, default compares to fun result + leBF :: a -> [a] -> a -> AMS (AMSOut a) + leBF b fa fr = leBB b fr + + + +-- | wrap action inside var looking up +anaVar + :: AnaLattice x + => (UID -> AnaMatchState -> Maybe x) -- lookup + -> res -- when vars are equal anyway + -> (x -> AMS res) -- when var found + -> (x -> x -> AMS res) -- when var is not found + -> UID -> x -> x + -> AMS res +anaVar lkupVar dflt found notfound v1 a1 a2 + = do { s <- get + ; let isV2@(~(Just v2)) = isVar a2 + ; if isJust isV2 && v1 == v2 + then return dflt + else case lkupVar v1 s of + Just a1' -> found a1' + _ -> notfound a1 a2 + } + +anaBind + :: (UID -> x -> RVarMp) + -> (x -> res) + -> UID -> x + -> AMS res +anaBind mkVM mkRes v1 a2 + = do { s <- get + ; put (amsBind (mkVM v1) a2 s) + ; return $ mkRes a2 + } + + + +instance AnaLattice AnaEval where + top = AnaEval_Lazy + bot = AnaEval_WHNF + + isTop AnaEval_Lazy = True + isTop _ = False + + isBot AnaEval_WHNF = True + isBot _ = False + + isVar (AnaEval_Var v) = Just v + isVar _ = Nothing + + fresh = AnaEval_Var + + meetl a1@(AnaEval_Var v1) a2 = anaVar amsLookupEval (Just a1) (meetl a2) anaEvalMeet v1 a1 a2 + meetl a1 a2@(AnaEval_Var v2) = anaVar amsLookupEval (Just a1) (meetl a1) anaEvalMeet v2 a2 a1 + meetl a1 a2 = anaEvalMeet a1 a2 + + joinl a1@(AnaEval_Var v1) a2 = anaVar amsLookupEval (Just a1) (joinl a2) anaEvalJoin v1 a1 a2 + joinl a1 a2@(AnaEval_Var v2) = anaVar amsLookupEval (Just a1) (joinl a1) anaEvalJoin v2 a2 a1 + joinl a1 a2 = anaEvalJoin a1 a2 + + leBB_l a1@(AnaEval_Var v1) a2 = anaVar amsLookupEval (amsoMkOk a1 a1 $ RelevCoe_Eval a1 a1) (flip leBB_l a2) leBB_r v1 a1 a2 + leBB_l a1 a2 = leBB_r a1 a2 + leBB_r a1 a2@(AnaEval_Var v2) = anaVar amsLookupEval (amsoMkOk a1 a1 $ RelevCoe_Eval a1 a1) ( leBB_r a1) (flip anaEvalLE) v2 a2 a1 + leBB_r a1 a2 = anaEvalLE a1 a2 + + + + +-- | meet or join for 2 element lattice (only bot+top), nothing in between +anaMeetOrJoin + :: AnaLattice x + => (UID -> x -> RVarMp) -- make var mapping (subst) + -> Bool -- is meet (True) or join (False) + -> x -> x + -> AMS (Maybe x) +anaMeetOrJoin mkVM isM a1 a2 + = mt False a1 a2 + where mt flip a1 a2 + | isB && isM = return $ Just a1 + | isB = return $ Just a2 + | isT && isM = return $ Just a2 + | isT = return $ Just a1 + | not flip = mt True a2 a1 + | isJust m1 && isJust m2 + = do { s <- get + ; let bound = amsBoundS s + ; if not (v1 `Set.member` bound) then bind v1 a2 + else if not (v2 `Set.member` bound) then bind v2 a1 + else return Nothing + } + | otherwise = return Nothing + where m1@(~(Just v1)) = isVar a1 + m2@(~(Just v2)) = isVar a2 + -- areV = isJust m1 && isJust m2 + isB = isBot a1 + isT = isTop a1 + bind = anaBind mkVM Just + +-- | meet, join, specialized for AnaEval +anaEvalMeet, anaEvalJoin :: AnaEval -> AnaEval -> AMS (Maybe AnaEval) +anaEvalMeet = anaMeetOrJoin rvarmpEvalUnit True +anaEvalJoin = anaMeetOrJoin rvarmpEvalUnit False + +anaEvalLE :: AnaEval -> AnaEval -> AMS (AMSOut AnaEval) +anaEvalLE a1 a2 + = le a1 a2 + where le a1@(AnaEval_Var v1) a2@(AnaEval_WHNF ) = bind v1 a2 -- can't get lower than bot + le a1@(AnaEval_Var v1) a2 = delay a1 a2 -- rest is delayed + le a1@(AnaEval_Lazy ) a2@(AnaEval_Var v2) = bind v2 a1 -- can't get higher than top + le a1 a2@(AnaEval_Var v2) = delay a1 a2 -- rest is delayed + le a1@(AnaEval_WHNF ) a2@(AnaEval_WHNF ) = return $ amsoMkOk a1 a2 (RelevCoe_Eval a1 a2) + le a1@(AnaEval_WHNF ) a2@(AnaEval_Lazy ) = coe a1 a2 -- forget that it is alreay evaluated + le a1@(AnaEval_Lazy ) a2@(AnaEval_Lazy ) = return $ amsoMkOk a1 a2 (RelevCoe_Eval a1 a2) + le a1@(AnaEval_Lazy ) a2@(AnaEval_WHNF ) = coe' RelevCoe_Cast a1 a2 -- permitted, but not without marking as casting required, according to lattice + le a1 a2 = return $ amsoMkFail -- Ok a1 a2 (RelevCoe_Err "anaEvalLE") + + bind = anaBind rvarmpEvalUnit (\a2 -> amsoMkOk a2 a2 $ RelevCoe_Eval a2 a2) + + -- | coerce + coe' wrap l h = return $ amsoMkOk l h (RelevCoe_Eval l h) + coe = coe' id + + -- | postpone by generating a qualification, to be solved later, or to end up in a signature + delay l h + = do { s <- get + ; put (amsQual (RelevQual_SubEval l h) s) + ; return $ amsoMkOk l h (RelevCoe_Eval l h) + } + + + +-- | Only valid for RelevTy_Ana as aggregrate of domains +instance AnaLattice RelevTy where + top = RelevTy_Ana top + bot = RelevTy_Ana bot + + isTop (RelevTy_Ana a1) = isTop a1 + isBot (RelevTy_Ana a1) = isBot a1 + isVar _ = Nothing + -- isVar (RelevTy_Ana a1) = do { v1 <- isVar a1 ; return v1 } + + fresh u = RelevTy_Ana (fresh u1) + where (_,u1) = mkNewLevUID u + + meetl (RelevTy_Ana a11) (RelevTy_Ana a21) = liftM (fmap RelevTy_Ana) (meetl a11 a21) + meetl _ _ = return Nothing + + joinl (RelevTy_Ana a11) (RelevTy_Ana a21) = liftM (fmap RelevTy_Ana) (joinl a11 a21) + joinl _ _ = return Nothing + + leBB (RelevTy_Ana a11) (RelevTy_Ana a21) = do { AMSOut l h c True <- leBB a11 a21 + ; return $ amsoMkOk (RelevTy_Ana l) (RelevTy_Ana h) c + } + leBB (RelevTy_Fun _ _ _ a1 r1) (RelevTy_Fun _ _ _ a2 r2) + = do { r_amso <- leBB r1 r2 + ; a_amso <- mapM (uncurry leBB) (zip a2 a1) + ; return $ amsoMk (RelevTy_Fun RQuant_None [] [] (map amsoHi a_amso) (amsoLo r_amso)) + (RelevTy_Fun RQuant_None [] [] (map amsoLo a_amso) (amsoHi r_amso)) + (RelevCoe_Fun (map amsoCoe a_amso) (amsoCoe r_amso)) + (and $ amsoIsOk r_amso : map amsoIsOk a_amso) + } + -- others lead to a constraint between t1 and function result, with a coercion between t1 and whole function t2 + -- Note: this has to be delegated to actual AnaDomain... + {- + leBB t1 t2@(RelevTy_Fun _ _ a2 r2) + = do { f_amso <- leBF t1 a2 r2 + ; let t1' = anaMkBotFun (length a2) + ; return $ AMSOut (RelevTy_Fun [] [] (map amsoHi a_amso) (amsoLo r_amso)) + (RelevTy_Fun [] [] (map amsoLo a_amso) (amsoHi r_amso)) + (RelevCoe_Fun (map amsoCoe a_amso) (amsoCoe r_amso)) + } + -} + leBB _ _ = return $ amsoMkFail -- Ok (RelevTy_Err "leBB.lo") (RelevTy_Err "leBB.hi") (RelevCoe_Err "leBB") + + {- + leBB (RelevTy_Ana a11) (RelevTy_Ana a21) = do { AMSOut l h c <- leBB a11 a21 + ; return $ AMSOut (RelevTy_Ana l) (RelevTy_Ana h) c + } + leBB _ _ = return $ AMSOut (RelevTy_Err "leBB.lo") (RelevTy_Err "leBB.hi") (RelevCoe_Err "leBB") + -} + + + +-- | bottom only for AnaEval lattice, otherwise fresh +freshStrict :: UID -> RelevTy +freshStrict u + = case fresh u of + RelevTy_Ana _ -> RelevTy_Ana bot + +-- | top only for AnaEval lattice, otherwise fresh +freshLazy :: UID -> RelevTy +freshLazy u + = case fresh u of + RelevTy_Ana _ -> RelevTy_Ana top + + + +-- | construct 'worst case' assuming function signature, where we assume function assumes nothing and we cannot assume anything about result, except for the result being bottom (i.e. strict) +anaMkBotFun :: Int -> RelevTy +anaMkBotFun arity = RelevTy_Fun RQuant_None [] [] (replicate arity top) bot + + + +-- | decompose RelevCoe composition in top and below +relevCoeUnCompose :: RelevCoe -> (RelevCoe,[RelevCoe]) +relevCoeUnCompose (RelevCoe_Comp l r) + = (l, u r) + where u (RelevCoe_Comp l r) = l : u r + u c = [c] +relevCoeUnCompose c = (c, []) + + + +-- | decompose RelevCoe composition in list of subsequently applied coe's +relevCoeToComposeList :: RelevCoe -> [RelevCoe] +relevCoeToComposeList c + = u [] c + where u a (RelevCoe_Comp l r) = let a' = u a r in u a' l + u a c = [c] ++ a + + + +data RVarMpInfo -- for all types of Var alternatives an alternative here + = RVMIEval AnaEval + + + +rvmiMbEval :: RVarMpInfo -> Maybe AnaEval +rvmiMbEval (RVMIEval x) = Just x +-- for now, until more alternatives are in it +-- rvmiMbEval _ = Nothing + + + +type RVarMp = VarMpStk' UID RVarMpInfo + +emptyRVarMp :: RVarMp +emptyRVarMp = emptyVarMpStk + + + +rvarmpEvalUnit :: UID -> AnaEval -> RVarMp +-- poor mens occurcheck... +-- rvarmpEvalUnit v (AnaEval_Var v2) | v == v2 = emptyRVarMp +rvarmpEvalUnit v i = varmpstkUnit v (RVMIEval i) -- [mkVarMp (Map.fromList [(v,RVMIEval i)])] + + + +-- | renaming +rvarmpKeysSet :: RVarMp -> Set.Set UID +rvarmpKeysSet = varmpstkKeysSet + +rvarmpUnions :: [RVarMp] -> RVarMp +rvarmpUnions = varmpstkUnions + + + +-- | state maintained during matching +data AnaMatchState + = AnaMatchState + { amsBoundS :: !UIDS -- vars which are already bound + , amsOuterVarMp :: !RVarMp -- as known from outside matching + , amsLocalVarMp :: !RVarMp -- as gathered during a match (1 invocation of runState) + , amsGathQual :: !RelevQualS -- gathered constraints + } + +type AMS a = State AnaMatchState a + +emptyAnaMatchState :: AnaMatchState +emptyAnaMatchState = AnaMatchState Set.empty emptyRVarMp emptyRVarMp Set.empty + +instance Show AnaMatchState where + show x = "AMS " ++ s (amsOuterVarMp x) ++ s (amsLocalVarMp x) + where s m = show (assocLMapElt rvmiMbEval $ varmpstkToAssocL m) + + + +-- | direct (non state) output of matching +data AMSOut a + = AMSOut + { amsoLo :: a + , amsoHi :: a + , amsoCoe :: RelevCoe + , amsoIsOk :: Bool + } + +emptyAMSOut :: AnaLattice a => AMSOut a +emptyAMSOut = AMSOut bot top RelevCoe_Id True + +amsoMk :: a -> a -> RelevCoe -> Bool -> AMSOut a +amsoMk l h c ok = AMSOut l h c ok + +amsoMkOk :: a -> a -> RelevCoe -> AMSOut a +amsoMkOk l h c = amsoMk l h c True + +amsoMkFail :: AnaLattice a => AMSOut a +amsoMkFail = emptyAMSOut {amsoIsOk = False} + +instance Show a => Show (AMSOut a) where + show x = "AMSOut (" ++ show (amsoLo x) ++ " <= " ++ show (amsoHi x) ++ ")" + + + +amsBind :: (x -> RVarMp) -> x -> AnaMatchState -> AnaMatchState +amsBind b a s = s {amsLocalVarMp = b a |+> amsLocalVarMp s} + +amsQual :: RelevQual -> AnaMatchState -> AnaMatchState +amsQual q s = s {amsGathQual = Set.insert q (amsGathQual s)} + + + +-- | run leBB +amsLE :: AnaLattice x => RVarMp -> x -> x -> (AMSOut x,AnaMatchState) +amsLE m x1 x2 = runState (leBB x1 x2) (emptyAnaMatchState {amsOuterVarMp = m}) + +-- | run a Maybe returning AMS +amsRunMb :: AnaMatchState -> AMS (Maybe x) -> Maybe (x,AnaMatchState) +amsRunMb s ams + = case runState ams s of + (Just x, s) -> Just (x,s) + _ -> Nothing + + + +-- | Lookup in VarMp's of AnaMatchState +amsLookup :: UID -> AnaMatchState -> Maybe RVarMpInfo +amsLookup i s = varmpLookup i (amsOuterVarMp s) <|> varmpLookup i (amsLocalVarMp s) + +amsLookupEval :: UID -> AnaMatchState -> Maybe AnaEval +amsLookupEval i s = do { i <- amsLookup i s ; rvmiMbEval i } + + + +instance Serialize RQuant where + sput = sputEnum8 + sget = sgetEnum8 + +instance Serialize RelevQual where + sput (RelevQual_SubEval a b ) = sputWord8 0 >> sput a >> sput b + -- sput (RelevQual_Alt a b c d e f) = sputWord8 1 >> sput a >> sput b >> sput c >> sput d >> sput e >> sput f + sget + = do t <- sgetWord8 + case t of + 0 -> liftM2 RelevQual_SubEval sget sget + -- 1 -> liftM6 RelevQual_Alt sget sget sget sget sget sget + +instance Serialize RelevTy where + sput (RelevTy_Ana a ) = sputWord8 0 >> sput a + sput (RelevTy_Fun a b c d e) = sputWord8 1 >> sput a >> sput b >> sput c >> sput d >> sput e + sput (RelevTy_None ) = sputWord8 2 + sput (RelevTy_Err a ) = sputWord8 3 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> liftM RelevTy_Ana sget + 1 -> liftM5 RelevTy_Fun sget sget sget sget sget + 2 -> return RelevTy_None + 3 -> liftM RelevTy_Err sget + +instance Serialize RelevCoe where + sput (RelevCoe_Id ) = sputWord8 0 + sput (RelevCoe_Err a ) = sputWord8 1 >> sput a + sput (RelevCoe_Comp a b ) = sputWord8 2 >> sput a >> sput b + sput (RelevCoe_Fun a b ) = sputWord8 3 >> sput a >> sput b + sput (RelevCoe_Cast a ) = sputWord8 4 >> sput a + sput (RelevCoe_Eval a b ) = sputWord8 5 >> sput a >> sput b + sput (RelevCoe_CastTy a b ) = sputWord8 6 >> sput a >> sput b + sget + = do t <- sgetWord8 + case t of + 0 -> return RelevCoe_Id + 1 -> liftM RelevCoe_Err sget + 2 -> liftM2 RelevCoe_Comp sget sget + 3 -> liftM2 RelevCoe_Fun sget sget + 4 -> liftM RelevCoe_Cast sget + 5 -> liftM2 RelevCoe_Eval sget sget + 6 -> liftM2 RelevCoe_CastTy sget sget + +instance Serialize AnaEval where + sput (AnaEval_Var a ) = sputWord8 0 >> sput a + sput (AnaEval_WHNF ) = sputWord8 1 + sput (AnaEval_Lazy ) = sputWord8 2 + sput (AnaEval_Meet a ) = sputWord8 3 >> sput a + sput (AnaEval_Join a ) = sputWord8 4 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> liftM AnaEval_Var sget + 1 -> return AnaEval_WHNF + 2 -> return AnaEval_Lazy + 3 -> liftM AnaEval_Meet sget + 4 -> liftM AnaEval_Join sget + +-- AnaEval ----------------------------------------------------- +data AnaEval = AnaEval_Var {av_AnaEval_Var :: !(UID)} + | AnaEval_WHNF {} + | AnaEval_Lazy {} + | AnaEval_Meet {opnds_AnaEval_Meet :: !(AnaEvalL)} + | AnaEval_Join {opnds_AnaEval_Join :: !(AnaEvalL)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- AnaEvalL ---------------------------------------------------- +type AnaEvalL = [AnaEval] +-- CoeAGItf ---------------------------------------------------- +data CoeAGItf = CoeAGItf_AGItf {relevCoe_CoeAGItf_AGItf :: !(RelevCoe)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- MbRelevTy --------------------------------------------------- +type MbRelevTy = Maybe (RelevTy) +-- QualAGItf --------------------------------------------------- +data QualAGItf = QualAGItf_AGItf {relevQual_QualAGItf_AGItf :: !(RelevQual)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- RelevCoe ---------------------------------------------------- +data RelevCoe = RelevCoe_Id {} + | RelevCoe_Err {str_RelevCoe_Err :: !(String)} + | RelevCoe_Comp {l_RelevCoe_Comp :: !(RelevCoe),r_RelevCoe_Comp :: !(RelevCoe)} + | RelevCoe_Fun {args_RelevCoe_Fun :: !(RelevCoeL),res_RelevCoe_Fun :: !(RelevCoe)} + | RelevCoe_Cast {coe_RelevCoe_Cast :: !(RelevCoe)} + | RelevCoe_CastTy {l_RelevCoe_CastTy :: !(RelevTy),r_RelevCoe_CastTy :: !(RelevTy)} + | RelevCoe_Eval {from_RelevCoe_Eval :: !(AnaEval),to_RelevCoe_Eval :: !(AnaEval)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- RelevCoeL --------------------------------------------------- +type RelevCoeL = [RelevCoe] +-- RelevQual --------------------------------------------------- +data RelevQual = RelevQual_SubEval {l_RelevQual_SubEval :: !(AnaEval),r_RelevQual_SubEval :: !(AnaEval)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- RelevQualL -------------------------------------------------- +type RelevQualL = [RelevQual] +-- RelevTy ----------------------------------------------------- +data RelevTy = RelevTy_None {} + | RelevTy_Err {str_RelevTy_Err :: !(String)} + | RelevTy_Ana {eval_RelevTy_Ana :: !(AnaEval)} + | RelevTy_Fun {quant_RelevTy_Fun :: !(RQuant),quants_RelevTy_Fun :: !(([UID])),quals_RelevTy_Fun :: !(RelevQualL),args_RelevTy_Fun :: !(RelevTyL),res_RelevTy_Fun :: !(RelevTy)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- RelevTyL ---------------------------------------------------- +type RelevTyL = [RelevTy] +-- TyAGItf ----------------------------------------------------- +data TyAGItf = TyAGItf_AGItf {relevTy_TyAGItf_AGItf :: !(RelevTy)} + deriving ( Data,Eq,Ord,Show,Typeable) diff --git a/src/UHC/Light/Compiler/AnaDomain/Ftv.hs b/src/UHC/Light/Compiler/AnaDomain/Ftv.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain/Ftv.hs @@ -0,0 +1,568 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/AnaDomain/Ftv.) +module UHC.Light.Compiler.AnaDomain.Ftv(relevTyFtv +, relevQualFtv +, relevCoeFtv) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.AnaDomain +import qualified Data.Set as Set + + + + + + + +relevTyFtv :: RelevTy -> UIDS +relevTyFtv ty + = fvS_Syn_TyAGItf t + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf ) + + + +relevQualFtv :: RelevQual -> UIDS +relevQualFtv qual + = fvS_Syn_QualAGItf t + where t = wrap_QualAGItf + (sem_QualAGItf (QualAGItf_AGItf qual)) + (Inh_QualAGItf ) + + + +relevCoeFtv :: RelevCoe -> UIDS +relevCoeFtv coe + = fvS_Syn_CoeAGItf t + where t = wrap_CoeAGItf + (sem_CoeAGItf (CoeAGItf_AGItf coe)) + (Inh_CoeAGItf ) + +-- AnaEval ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Var: + child av : {UID} + alternative WHNF: + alternative Lazy: + alternative Meet: + child opnds : AnaEvalL + alternative Join: + child opnds : AnaEvalL +-} +-- cata +sem_AnaEval :: AnaEval -> + T_AnaEval +sem_AnaEval (AnaEval_Var _av) = + (sem_AnaEval_Var _av) +sem_AnaEval (AnaEval_WHNF) = + (sem_AnaEval_WHNF) +sem_AnaEval (AnaEval_Lazy) = + (sem_AnaEval_Lazy) +sem_AnaEval (AnaEval_Meet _opnds) = + (sem_AnaEval_Meet (sem_AnaEvalL _opnds)) +sem_AnaEval (AnaEval_Join _opnds) = + (sem_AnaEval_Join (sem_AnaEvalL _opnds)) +-- semantic domain +type T_AnaEval = ( UIDS) +sem_AnaEval_Var :: UID -> + T_AnaEval +sem_AnaEval_Var av_ = + (case (Set.singleton av_) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_AnaEval_WHNF :: T_AnaEval +sem_AnaEval_WHNF = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_AnaEval_Lazy :: T_AnaEval +sem_AnaEval_Lazy = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_AnaEval_Meet :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Meet opnds_ = + (case (opnds_) of + { ( _opndsIfvS) -> + (case (_opndsIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_AnaEval_Join :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Join opnds_ = + (case (opnds_) of + { ( _opndsIfvS) -> + (case (_opndsIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +-- AnaEvalL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Cons: + child hd : AnaEval + child tl : AnaEvalL + alternative Nil: +-} +-- cata +sem_AnaEvalL :: AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL list = + (Prelude.foldr sem_AnaEvalL_Cons sem_AnaEvalL_Nil (Prelude.map sem_AnaEval list)) +-- semantic domain +type T_AnaEvalL = ( UIDS) +sem_AnaEvalL_Cons :: T_AnaEval -> + T_AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS) -> + (case (hd_) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_AnaEvalL_Nil :: T_AnaEvalL +sem_AnaEvalL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- CoeAGItf ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative AGItf: + child relevCoe : RelevCoe +-} +-- cata +sem_CoeAGItf :: CoeAGItf -> + T_CoeAGItf +sem_CoeAGItf (CoeAGItf_AGItf _relevCoe) = + (sem_CoeAGItf_AGItf (sem_RelevCoe _relevCoe)) +-- semantic domain +type T_CoeAGItf = ( UIDS) +data Inh_CoeAGItf = Inh_CoeAGItf {} +data Syn_CoeAGItf = Syn_CoeAGItf {fvS_Syn_CoeAGItf :: !(UIDS)} +wrap_CoeAGItf :: T_CoeAGItf -> + Inh_CoeAGItf -> + Syn_CoeAGItf +wrap_CoeAGItf sem (Inh_CoeAGItf) = + (let ( _lhsOfvS) = sem + in (Syn_CoeAGItf _lhsOfvS)) +sem_CoeAGItf_AGItf :: T_RelevCoe -> + T_CoeAGItf +sem_CoeAGItf_AGItf relevCoe_ = + (case (relevCoe_) of + { ( _relevCoeIfvS) -> + (case (_relevCoeIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +-- MbRelevTy --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Just: + child just : RelevTy + alternative Nothing: +-} +-- cata +sem_MbRelevTy :: MbRelevTy -> + T_MbRelevTy +sem_MbRelevTy (Prelude.Just x) = + (sem_MbRelevTy_Just (sem_RelevTy x)) +sem_MbRelevTy Prelude.Nothing = + sem_MbRelevTy_Nothing +-- semantic domain +type T_MbRelevTy = ( UIDS) +sem_MbRelevTy_Just :: T_RelevTy -> + T_MbRelevTy +sem_MbRelevTy_Just just_ = + (case (just_) of + { ( _justIfvS) -> + (case (_justIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_MbRelevTy_Nothing :: T_MbRelevTy +sem_MbRelevTy_Nothing = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- QualAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative AGItf: + child relevQual : RelevQual +-} +-- cata +sem_QualAGItf :: QualAGItf -> + T_QualAGItf +sem_QualAGItf (QualAGItf_AGItf _relevQual) = + (sem_QualAGItf_AGItf (sem_RelevQual _relevQual)) +-- semantic domain +type T_QualAGItf = ( UIDS) +data Inh_QualAGItf = Inh_QualAGItf {} +data Syn_QualAGItf = Syn_QualAGItf {fvS_Syn_QualAGItf :: !(UIDS)} +wrap_QualAGItf :: T_QualAGItf -> + Inh_QualAGItf -> + Syn_QualAGItf +wrap_QualAGItf sem (Inh_QualAGItf) = + (let ( _lhsOfvS) = sem + in (Syn_QualAGItf _lhsOfvS)) +sem_QualAGItf_AGItf :: T_RelevQual -> + T_QualAGItf +sem_QualAGItf_AGItf relevQual_ = + (case (relevQual_) of + { ( _relevQualIfvS) -> + (case (_relevQualIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +-- RelevCoe ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Id: + alternative Err: + child str : {String} + alternative Comp: + child l : RelevCoe + child r : RelevCoe + alternative Fun: + child args : RelevCoeL + child res : RelevCoe + alternative Cast: + child coe : RelevCoe + alternative CastTy: + child l : RelevTy + child r : RelevTy + alternative Eval: + child from : AnaEval + child to : AnaEval +-} +-- cata +sem_RelevCoe :: RelevCoe -> + T_RelevCoe +sem_RelevCoe (RelevCoe_Id) = + (sem_RelevCoe_Id) +sem_RelevCoe (RelevCoe_Err _str) = + (sem_RelevCoe_Err _str) +sem_RelevCoe (RelevCoe_Comp _l _r) = + (sem_RelevCoe_Comp (sem_RelevCoe _l) (sem_RelevCoe _r)) +sem_RelevCoe (RelevCoe_Fun _args _res) = + (sem_RelevCoe_Fun (sem_RelevCoeL _args) (sem_RelevCoe _res)) +sem_RelevCoe (RelevCoe_Cast _coe) = + (sem_RelevCoe_Cast (sem_RelevCoe _coe)) +sem_RelevCoe (RelevCoe_CastTy _l _r) = + (sem_RelevCoe_CastTy (sem_RelevTy _l) (sem_RelevTy _r)) +sem_RelevCoe (RelevCoe_Eval _from _to) = + (sem_RelevCoe_Eval (sem_AnaEval _from) (sem_AnaEval _to)) +-- semantic domain +type T_RelevCoe = ( UIDS) +sem_RelevCoe_Id :: T_RelevCoe +sem_RelevCoe_Id = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_RelevCoe_Err :: String -> + T_RelevCoe +sem_RelevCoe_Err str_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_RelevCoe_Comp :: T_RelevCoe -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Comp l_ r_ = + (case (r_) of + { ( _rIfvS) -> + (case (l_) of + { ( _lIfvS) -> + (case (_lIfvS `Set.union` _rIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevCoe_Fun :: T_RelevCoeL -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Fun args_ res_ = + (case (res_) of + { ( _resIfvS) -> + (case (args_) of + { ( _argsIfvS) -> + (case (_argsIfvS `Set.union` _resIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevCoe_Cast :: T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Cast coe_ = + (case (coe_) of + { ( _coeIfvS) -> + (case (_coeIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_RelevCoe_CastTy :: T_RelevTy -> + T_RelevTy -> + T_RelevCoe +sem_RelevCoe_CastTy l_ r_ = + (case (r_) of + { ( _rIfvS) -> + (case (l_) of + { ( _lIfvS) -> + (case (_lIfvS `Set.union` _rIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevCoe_Eval :: T_AnaEval -> + T_AnaEval -> + T_RelevCoe +sem_RelevCoe_Eval from_ to_ = + (case (to_) of + { ( _toIfvS) -> + (case (from_) of + { ( _fromIfvS) -> + (case (_fromIfvS `Set.union` _toIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +-- RelevCoeL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Cons: + child hd : RelevCoe + child tl : RelevCoeL + alternative Nil: +-} +-- cata +sem_RelevCoeL :: RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL list = + (Prelude.foldr sem_RelevCoeL_Cons sem_RelevCoeL_Nil (Prelude.map sem_RelevCoe list)) +-- semantic domain +type T_RelevCoeL = ( UIDS) +sem_RelevCoeL_Cons :: T_RelevCoe -> + T_RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS) -> + (case (hd_) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevCoeL_Nil :: T_RelevCoeL +sem_RelevCoeL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- RelevQual --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative SubEval: + child l : AnaEval + child r : AnaEval +-} +-- cata +sem_RelevQual :: RelevQual -> + T_RelevQual +sem_RelevQual (RelevQual_SubEval _l _r) = + (sem_RelevQual_SubEval (sem_AnaEval _l) (sem_AnaEval _r)) +-- semantic domain +type T_RelevQual = ( UIDS) +sem_RelevQual_SubEval :: T_AnaEval -> + T_AnaEval -> + T_RelevQual +sem_RelevQual_SubEval l_ r_ = + (case (r_) of + { ( _rIfvS) -> + (case (l_) of + { ( _lIfvS) -> + (case (_lIfvS `Set.union` _rIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +-- RelevQualL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Cons: + child hd : RelevQual + child tl : RelevQualL + alternative Nil: +-} +-- cata +sem_RelevQualL :: RelevQualL -> + T_RelevQualL +sem_RelevQualL list = + (Prelude.foldr sem_RelevQualL_Cons sem_RelevQualL_Nil (Prelude.map sem_RelevQual list)) +-- semantic domain +type T_RelevQualL = ( UIDS) +sem_RelevQualL_Cons :: T_RelevQual -> + T_RelevQualL -> + T_RelevQualL +sem_RelevQualL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS) -> + (case (hd_) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevQualL_Nil :: T_RelevQualL +sem_RelevQualL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- RelevTy ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative None: + alternative Err: + child str : {String} + alternative Ana: + child eval : AnaEval + alternative Fun: + child quant : {RQuant} + child quants : {[UID]} + child quals : RelevQualL + child args : RelevTyL + child res : RelevTy +-} +-- cata +sem_RelevTy :: RelevTy -> + T_RelevTy +sem_RelevTy (RelevTy_None) = + (sem_RelevTy_None) +sem_RelevTy (RelevTy_Err _str) = + (sem_RelevTy_Err _str) +sem_RelevTy (RelevTy_Ana _eval) = + (sem_RelevTy_Ana (sem_AnaEval _eval)) +sem_RelevTy (RelevTy_Fun _quant _quants _quals _args _res) = + (sem_RelevTy_Fun _quant _quants (sem_RelevQualL _quals) (sem_RelevTyL _args) (sem_RelevTy _res)) +-- semantic domain +type T_RelevTy = ( UIDS) +sem_RelevTy_None :: T_RelevTy +sem_RelevTy_None = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_RelevTy_Err :: String -> + T_RelevTy +sem_RelevTy_Err str_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_RelevTy_Ana :: T_AnaEval -> + T_RelevTy +sem_RelevTy_Ana eval_ = + (case (eval_) of + { ( _evalIfvS) -> + (case (_evalIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_RelevTy_Fun :: RQuant -> + ([UID]) -> + T_RelevQualL -> + T_RelevTyL -> + T_RelevTy -> + T_RelevTy +sem_RelevTy_Fun quant_ quants_ quals_ args_ res_ = + (case (res_) of + { ( _resIfvS) -> + (case (args_) of + { ( _argsIfvS) -> + (case (quals_) of + { ( _qualsIfvS) -> + (case (_qualsIfvS `Set.union` _argsIfvS `Set.union` _resIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +-- RelevTyL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative Cons: + child hd : RelevTy + child tl : RelevTyL + alternative Nil: +-} +-- cata +sem_RelevTyL :: RelevTyL -> + T_RelevTyL +sem_RelevTyL list = + (Prelude.foldr sem_RelevTyL_Cons sem_RelevTyL_Nil (Prelude.map sem_RelevTy list)) +-- semantic domain +type T_RelevTyL = ( UIDS) +sem_RelevTyL_Cons :: T_RelevTy -> + T_RelevTyL -> + T_RelevTyL +sem_RelevTyL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS) -> + (case (hd_) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_RelevTyL_Nil :: T_RelevTyL +sem_RelevTyL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : UIDS + alternatives: + alternative AGItf: + child relevTy : RelevTy +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _relevTy) = + (sem_TyAGItf_AGItf (sem_RelevTy _relevTy)) +-- semantic domain +type T_TyAGItf = ( UIDS) +data Inh_TyAGItf = Inh_TyAGItf {} +data Syn_TyAGItf = Syn_TyAGItf {fvS_Syn_TyAGItf :: !(UIDS)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf) = + (let ( _lhsOfvS) = sem + in (Syn_TyAGItf _lhsOfvS)) +sem_TyAGItf_AGItf :: T_RelevTy -> + T_TyAGItf +sem_TyAGItf_AGItf relevTy_ = + (case (relevTy_) of + { ( _relevTyIfvS) -> + (case (_relevTyIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) diff --git a/src/UHC/Light/Compiler/AnaDomain/Pretty.hs b/src/UHC/Light/Compiler/AnaDomain/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain/Pretty.hs @@ -0,0 +1,782 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/AnaDomain/Pret) +module UHC.Light.Compiler.AnaDomain.Pretty(ppRelevTy +, ppRelevQual +, ppAnaEval +, ppRelevCoe +, VarPPMp) where + +import UHC.Util.Pretty +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.Base.Common +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Char + + + + + + + + + +ppRelevTy :: VarPPMp -> RelevTy -> (PP_Doc,VarPPMp) +ppRelevTy vm x + = let t = wrap_RelevTy (sem_RelevTy x) + (Inh_RelevTy + { varMp_Inh_RelevTy = vm + }) + in (pp_Syn_RelevTy t, quantVarMp_Syn_RelevTy t) + +instance PP RelevTy where + pp x = fst $ ppRelevTy Map.empty x + + + +ppRelevQual :: RelevQual -> PP_Doc +ppRelevQual x + = let t = wrap_RelevQual (sem_RelevQual x) + (Inh_RelevQual + { varMp_Inh_RelevQual = Map.empty + }) + in (pp_Syn_RelevQual t) + +instance PP RelevQual where + pp x = ppRelevQual x + + + +ppAnaEval :: AnaEval -> PP_Doc +ppAnaEval x + = let t = wrap_AnaEval (sem_AnaEval x) + (Inh_AnaEval + { varMp_Inh_AnaEval = Map.empty + }) + in (pp_Syn_AnaEval t) + +instance PP AnaEval where + pp x = ppAnaEval x + + + +ppRelevCoe :: VarPPMp -> RelevCoe -> PP_Doc +ppRelevCoe vm x + = let t = wrap_RelevCoe (sem_RelevCoe x) + (Inh_RelevCoe + { varMp_Inh_RelevCoe = vm + }) + in (pp_Syn_RelevCoe t) + +instance PP RelevCoe where + pp x = ppRelevCoe Map.empty x + + + +instance Show RVarMpInfo where + show _ = "RVarMpInfo" + +instance PP RVarMpInfo where + pp (RVMIEval a) = pp a + + + +instance PP AnaMatchState where + pp x = ppParens (amsOuterVarMp x) >#< amsLocalVarMp x >#< "~>" >#< ppCommas (Set.toList $ amsGathQual x) + +instance PP a => PP (AMSOut a) where + pp x = amsoLo x >#< "<=" >#< amsoHi x >#< "~" >#< amsoCoe x + + + +type VarPPMp = Map.Map UID PP_Doc + +-- AnaEval ----------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Var: + child av : {UID} + alternative WHNF: + alternative Lazy: + alternative Meet: + child opnds : AnaEvalL + alternative Join: + child opnds : AnaEvalL +-} +-- cata +sem_AnaEval :: AnaEval -> + T_AnaEval +sem_AnaEval (AnaEval_Var _av) = + (sem_AnaEval_Var _av) +sem_AnaEval (AnaEval_WHNF) = + (sem_AnaEval_WHNF) +sem_AnaEval (AnaEval_Lazy) = + (sem_AnaEval_Lazy) +sem_AnaEval (AnaEval_Meet _opnds) = + (sem_AnaEval_Meet (sem_AnaEvalL _opnds)) +sem_AnaEval (AnaEval_Join _opnds) = + (sem_AnaEval_Join (sem_AnaEvalL _opnds)) +-- semantic domain +type T_AnaEval = VarPPMp -> + ( PP_Doc) +data Inh_AnaEval = Inh_AnaEval {varMp_Inh_AnaEval :: !(VarPPMp)} +data Syn_AnaEval = Syn_AnaEval {pp_Syn_AnaEval :: !(PP_Doc)} +wrap_AnaEval :: T_AnaEval -> + Inh_AnaEval -> + Syn_AnaEval +wrap_AnaEval sem (Inh_AnaEval _lhsIvarMp) = + (let ( _lhsOpp) = sem _lhsIvarMp + in (Syn_AnaEval _lhsOpp)) +sem_AnaEval_Var :: UID -> + T_AnaEval +sem_AnaEval_Var av_ = + (\ _lhsIvarMp -> + (case (Map.findWithDefault (pp av_) av_ _lhsIvarMp) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_AnaEval_WHNF :: T_AnaEval +sem_AnaEval_WHNF = + (\ _lhsIvarMp -> + (case (pp "S") of + { _lhsOpp -> + ( _lhsOpp) })) +sem_AnaEval_Lazy :: T_AnaEval +sem_AnaEval_Lazy = + (\ _lhsIvarMp -> + (case (pp "L") of + { _lhsOpp -> + ( _lhsOpp) })) +sem_AnaEval_Meet :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Meet opnds_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _opndsOvarMp -> + (case (opnds_ _opndsOvarMp) of + { ( _opndsIpp,_opndsIppL) -> + (case (ppListSep "" "" " /\\ " _opndsIppL) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_AnaEval_Join :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Join opnds_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _opndsOvarMp -> + (case (opnds_ _opndsOvarMp) of + { ( _opndsIpp,_opndsIppL) -> + (case (ppListSep "" "" " \\/ " _opndsIppL) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +-- AnaEvalL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : AnaEval + child tl : AnaEvalL + alternative Nil: +-} +-- cata +sem_AnaEvalL :: AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL list = + (Prelude.foldr sem_AnaEvalL_Cons sem_AnaEvalL_Nil (Prelude.map sem_AnaEval list)) +-- semantic domain +type T_AnaEvalL = VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_AnaEvalL_Cons :: T_AnaEval -> + T_AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL_Cons hd_ tl_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _tlOvarMp -> + (case (_lhsIvarMp) of + { _hdOvarMp -> + (case (tl_ _tlOvarMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_ _hdOvarMp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) +sem_AnaEvalL_Nil :: T_AnaEvalL +sem_AnaEvalL_Nil = + (\ _lhsIvarMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CoeAGItf ---------------------------------------------------- +{- + alternatives: + alternative AGItf: + child relevCoe : RelevCoe +-} +-- cata +sem_CoeAGItf :: CoeAGItf -> + T_CoeAGItf +sem_CoeAGItf (CoeAGItf_AGItf _relevCoe) = + (sem_CoeAGItf_AGItf (sem_RelevCoe _relevCoe)) +-- semantic domain +type T_CoeAGItf = ( ) +sem_CoeAGItf_AGItf :: T_RelevCoe -> + T_CoeAGItf +sem_CoeAGItf_AGItf relevCoe_ = + ( ) +-- MbRelevTy --------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Just: + child just : RelevTy + alternative Nothing: +-} +-- cata +sem_MbRelevTy :: MbRelevTy -> + T_MbRelevTy +sem_MbRelevTy (Prelude.Just x) = + (sem_MbRelevTy_Just (sem_RelevTy x)) +sem_MbRelevTy Prelude.Nothing = + sem_MbRelevTy_Nothing +-- semantic domain +type T_MbRelevTy = VarPPMp -> + ( PP_Doc) +sem_MbRelevTy_Just :: T_RelevTy -> + T_MbRelevTy +sem_MbRelevTy_Just just_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _justOvarMp -> + (case (just_ _justOvarMp) of + { ( _justIpp,_justIquantVarMp) -> + (case (_justIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_MbRelevTy_Nothing :: T_MbRelevTy +sem_MbRelevTy_Nothing = + (\ _lhsIvarMp -> + (case (empty) of + { _lhsOpp -> + ( _lhsOpp) })) +-- QualAGItf --------------------------------------------------- +{- + alternatives: + alternative AGItf: + child relevQual : RelevQual +-} +-- cata +sem_QualAGItf :: QualAGItf -> + T_QualAGItf +sem_QualAGItf (QualAGItf_AGItf _relevQual) = + (sem_QualAGItf_AGItf (sem_RelevQual _relevQual)) +-- semantic domain +type T_QualAGItf = ( ) +sem_QualAGItf_AGItf :: T_RelevQual -> + T_QualAGItf +sem_QualAGItf_AGItf relevQual_ = + ( ) +-- RelevCoe ---------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Id: + alternative Err: + child str : {String} + alternative Comp: + child l : RelevCoe + child r : RelevCoe + alternative Fun: + child args : RelevCoeL + child res : RelevCoe + alternative Cast: + child coe : RelevCoe + alternative CastTy: + child l : RelevTy + child r : RelevTy + alternative Eval: + child from : AnaEval + child to : AnaEval +-} +-- cata +sem_RelevCoe :: RelevCoe -> + T_RelevCoe +sem_RelevCoe (RelevCoe_Id) = + (sem_RelevCoe_Id) +sem_RelevCoe (RelevCoe_Err _str) = + (sem_RelevCoe_Err _str) +sem_RelevCoe (RelevCoe_Comp _l _r) = + (sem_RelevCoe_Comp (sem_RelevCoe _l) (sem_RelevCoe _r)) +sem_RelevCoe (RelevCoe_Fun _args _res) = + (sem_RelevCoe_Fun (sem_RelevCoeL _args) (sem_RelevCoe _res)) +sem_RelevCoe (RelevCoe_Cast _coe) = + (sem_RelevCoe_Cast (sem_RelevCoe _coe)) +sem_RelevCoe (RelevCoe_CastTy _l _r) = + (sem_RelevCoe_CastTy (sem_RelevTy _l) (sem_RelevTy _r)) +sem_RelevCoe (RelevCoe_Eval _from _to) = + (sem_RelevCoe_Eval (sem_AnaEval _from) (sem_AnaEval _to)) +-- semantic domain +type T_RelevCoe = VarPPMp -> + ( PP_Doc) +data Inh_RelevCoe = Inh_RelevCoe {varMp_Inh_RelevCoe :: !(VarPPMp)} +data Syn_RelevCoe = Syn_RelevCoe {pp_Syn_RelevCoe :: !(PP_Doc)} +wrap_RelevCoe :: T_RelevCoe -> + Inh_RelevCoe -> + Syn_RelevCoe +wrap_RelevCoe sem (Inh_RelevCoe _lhsIvarMp) = + (let ( _lhsOpp) = sem _lhsIvarMp + in (Syn_RelevCoe _lhsOpp)) +sem_RelevCoe_Id :: T_RelevCoe +sem_RelevCoe_Id = + (\ _lhsIvarMp -> + (case (pp "#_c") of + { _lhsOpp -> + ( _lhsOpp) })) +sem_RelevCoe_Err :: String -> + T_RelevCoe +sem_RelevCoe_Err str_ = + (\ _lhsIvarMp -> + (case ("#_c:" >#< str_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_RelevCoe_Comp :: T_RelevCoe -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Comp l_ r_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _rOvarMp -> + (case (_lhsIvarMp) of + { _lOvarMp -> + (case (r_ _rOvarMp) of + { ( _rIpp) -> + (case (l_ _lOvarMp) of + { ( _lIpp) -> + (case (_lIpp >#< "._c" >#< _rIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_RelevCoe_Fun :: T_RelevCoeL -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Fun args_ res_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _resOvarMp -> + (case (_lhsIvarMp) of + { _argsOvarMp -> + (case (res_ _resOvarMp) of + { ( _resIpp) -> + (case (args_ _argsOvarMp) of + { ( _argsIpp,_argsIppL) -> + (case (ppParensCommas' _argsIppL >#< "-c>" >#< _resIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_RelevCoe_Cast :: T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Cast coe_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _coeOvarMp -> + (case (coe_ _coeOvarMp) of + { ( _coeIpp) -> + (case ("(#!" >#< _coeIpp >|< ")") of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_RelevCoe_CastTy :: T_RelevTy -> + T_RelevTy -> + T_RelevCoe +sem_RelevCoe_CastTy l_ r_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _rOvarMp -> + (case (_lhsIvarMp) of + { _lOvarMp -> + (case (r_ _rOvarMp) of + { ( _rIpp,_rIquantVarMp) -> + (case (l_ _lOvarMp) of + { ( _lIpp,_lIquantVarMp) -> + (case (ppParens $ _lIpp >#< "`castTy`" >#< _rIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_RelevCoe_Eval :: T_AnaEval -> + T_AnaEval -> + T_RelevCoe +sem_RelevCoe_Eval from_ to_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _toOvarMp -> + (case (_lhsIvarMp) of + { _fromOvarMp -> + (case (to_ _toOvarMp) of + { ( _toIpp) -> + (case (from_ _fromOvarMp) of + { ( _fromIpp) -> + (case (ppParens $ _fromIpp >#< "~e>" >#< _toIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +-- RelevCoeL --------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : RelevCoe + child tl : RelevCoeL + alternative Nil: +-} +-- cata +sem_RelevCoeL :: RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL list = + (Prelude.foldr sem_RelevCoeL_Cons sem_RelevCoeL_Nil (Prelude.map sem_RelevCoe list)) +-- semantic domain +type T_RelevCoeL = VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_RelevCoeL_Cons :: T_RelevCoe -> + T_RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL_Cons hd_ tl_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _tlOvarMp -> + (case (_lhsIvarMp) of + { _hdOvarMp -> + (case (tl_ _tlOvarMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_ _hdOvarMp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) +sem_RelevCoeL_Nil :: T_RelevCoeL +sem_RelevCoeL_Nil = + (\ _lhsIvarMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- RelevQual --------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative SubEval: + child l : AnaEval + child r : AnaEval +-} +-- cata +sem_RelevQual :: RelevQual -> + T_RelevQual +sem_RelevQual (RelevQual_SubEval _l _r) = + (sem_RelevQual_SubEval (sem_AnaEval _l) (sem_AnaEval _r)) +-- semantic domain +type T_RelevQual = VarPPMp -> + ( PP_Doc) +data Inh_RelevQual = Inh_RelevQual {varMp_Inh_RelevQual :: !(VarPPMp)} +data Syn_RelevQual = Syn_RelevQual {pp_Syn_RelevQual :: !(PP_Doc)} +wrap_RelevQual :: T_RelevQual -> + Inh_RelevQual -> + Syn_RelevQual +wrap_RelevQual sem (Inh_RelevQual _lhsIvarMp) = + (let ( _lhsOpp) = sem _lhsIvarMp + in (Syn_RelevQual _lhsOpp)) +sem_RelevQual_SubEval :: T_AnaEval -> + T_AnaEval -> + T_RelevQual +sem_RelevQual_SubEval l_ r_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _rOvarMp -> + (case (_lhsIvarMp) of + { _lOvarMp -> + (case (r_ _rOvarMp) of + { ( _rIpp) -> + (case (l_ _lOvarMp) of + { ( _lIpp) -> + (case (_lIpp >#< "#< _rIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +-- RelevQualL -------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : RelevQual + child tl : RelevQualL + alternative Nil: +-} +-- cata +sem_RelevQualL :: RelevQualL -> + T_RelevQualL +sem_RelevQualL list = + (Prelude.foldr sem_RelevQualL_Cons sem_RelevQualL_Nil (Prelude.map sem_RelevQual list)) +-- semantic domain +type T_RelevQualL = VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_RelevQualL_Cons :: T_RelevQual -> + T_RelevQualL -> + T_RelevQualL +sem_RelevQualL_Cons hd_ tl_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _tlOvarMp -> + (case (_lhsIvarMp) of + { _hdOvarMp -> + (case (tl_ _tlOvarMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_ _hdOvarMp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) +sem_RelevQualL_Nil :: T_RelevQualL +sem_RelevQualL_Nil = + (\ _lhsIvarMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- RelevTy ----------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attributes: + pp : PP_Doc + quantVarMp : VarPPMp + alternatives: + alternative None: + visit 0: + local quantVarMp : _ + alternative Err: + child str : {String} + visit 0: + local quantVarMp : _ + alternative Ana: + child eval : AnaEval + visit 0: + local quantVarMp : _ + alternative Fun: + child quant : {RQuant} + child quants : {[UID]} + child quals : RelevQualL + child args : RelevTyL + child res : RelevTy + visit 0: + local _tup1 : _ + local varMp : _ + local quantNmL : _ + local quantVarMp : _ +-} +-- cata +sem_RelevTy :: RelevTy -> + T_RelevTy +sem_RelevTy (RelevTy_None) = + (sem_RelevTy_None) +sem_RelevTy (RelevTy_Err _str) = + (sem_RelevTy_Err _str) +sem_RelevTy (RelevTy_Ana _eval) = + (sem_RelevTy_Ana (sem_AnaEval _eval)) +sem_RelevTy (RelevTy_Fun _quant _quants _quals _args _res) = + (sem_RelevTy_Fun _quant _quants (sem_RelevQualL _quals) (sem_RelevTyL _args) (sem_RelevTy _res)) +-- semantic domain +type T_RelevTy = VarPPMp -> + ( PP_Doc,VarPPMp) +data Inh_RelevTy = Inh_RelevTy {varMp_Inh_RelevTy :: !(VarPPMp)} +data Syn_RelevTy = Syn_RelevTy {pp_Syn_RelevTy :: !(PP_Doc),quantVarMp_Syn_RelevTy :: !(VarPPMp)} +wrap_RelevTy :: T_RelevTy -> + Inh_RelevTy -> + Syn_RelevTy +wrap_RelevTy sem (Inh_RelevTy _lhsIvarMp) = + (let ( _lhsOpp,_lhsOquantVarMp) = sem _lhsIvarMp + in (Syn_RelevTy _lhsOpp _lhsOquantVarMp)) +sem_RelevTy_None :: T_RelevTy +sem_RelevTy_None = + (\ _lhsIvarMp -> + (case (pp "#") of + { _lhsOpp -> + (case (Map.empty) of + { _quantVarMp -> + (case (_quantVarMp) of + { _lhsOquantVarMp -> + ( _lhsOpp,_lhsOquantVarMp) }) }) })) +sem_RelevTy_Err :: String -> + T_RelevTy +sem_RelevTy_Err str_ = + (\ _lhsIvarMp -> + (case ("#:" >#< str_) of + { _lhsOpp -> + (case (Map.empty) of + { _quantVarMp -> + (case (_quantVarMp) of + { _lhsOquantVarMp -> + ( _lhsOpp,_lhsOquantVarMp) }) }) })) +sem_RelevTy_Ana :: T_AnaEval -> + T_RelevTy +sem_RelevTy_Ana eval_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _evalOvarMp -> + (case (eval_ _evalOvarMp) of + { ( _evalIpp) -> + (case (_evalIpp) of + { _lhsOpp -> + (case (Map.empty) of + { _quantVarMp -> + (case (_quantVarMp) of + { _lhsOquantVarMp -> + ( _lhsOpp,_lhsOquantVarMp) }) }) }) }) })) +sem_RelevTy_Fun :: RQuant -> + ([UID]) -> + T_RelevQualL -> + T_RelevTyL -> + T_RelevTy -> + T_RelevTy +sem_RelevTy_Fun quant_ quants_ quals_ args_ res_ = + (\ _lhsIvarMp -> + (case (genNmMap pp quants_ _lhsIvarMp) of + { __tup1 -> + (case (__tup1) of + { (_varMp,_) -> + (case (_varMp) of + { _resOvarMp -> + (case (_varMp) of + { _argsOvarMp -> + (case (_varMp) of + { _qualsOvarMp -> + (case (__tup1) of + { (_,_quantNmL) -> + (case (res_ _resOvarMp) of + { ( _resIpp,_resIquantVarMp) -> + (case (args_ _argsOvarMp) of + { ( _argsIpp,_argsIppL) -> + (case (quals_ _qualsOvarMp) of + { ( _qualsIpp,_qualsIppL) -> + (case ((if null _quantNmL then empty else "forall" >|< ppParens (show quant_) >#< ppSpaces _quantNmL >#< ". ") + >|< (if null _qualsIppL then empty else ppParensCommas' _qualsIppL >#< "=> ") + >|< ppParensCommas _argsIppL >#< "->" >#< ppParens _resIpp) of + { _lhsOpp -> + (case (_varMp) of + { _quantVarMp -> + (case (_quantVarMp) of + { _lhsOquantVarMp -> + ( _lhsOpp,_lhsOquantVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +-- RelevTyL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + varMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : RelevTy + child tl : RelevTyL + alternative Nil: +-} +-- cata +sem_RelevTyL :: RelevTyL -> + T_RelevTyL +sem_RelevTyL list = + (Prelude.foldr sem_RelevTyL_Cons sem_RelevTyL_Nil (Prelude.map sem_RelevTy list)) +-- semantic domain +type T_RelevTyL = VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_RelevTyL_Cons :: T_RelevTy -> + T_RelevTyL -> + T_RelevTyL +sem_RelevTyL_Cons hd_ tl_ = + (\ _lhsIvarMp -> + (case (_lhsIvarMp) of + { _tlOvarMp -> + (case (_lhsIvarMp) of + { _hdOvarMp -> + (case (tl_ _tlOvarMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_ _hdOvarMp) of + { ( _hdIpp,_hdIquantVarMp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) +sem_RelevTyL_Nil :: T_RelevTyL +sem_RelevTyL_Nil = + (\ _lhsIvarMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + quantVarMp : VarPPMp + alternatives: + alternative AGItf: + child relevTy : RelevTy + visit 0: + local varMp : _ +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _relevTy) = + (sem_TyAGItf_AGItf (sem_RelevTy _relevTy)) +-- semantic domain +type T_TyAGItf = ( VarPPMp) +sem_TyAGItf_AGItf :: T_RelevTy -> + T_TyAGItf +sem_TyAGItf_AGItf relevTy_ = + (case (Map.empty) of + { _varMp -> + (case (_varMp) of + { _relevTyOvarMp -> + (case (relevTy_ _relevTyOvarMp) of + { ( _relevTyIpp,_relevTyIquantVarMp) -> + (case (_relevTyIquantVarMp) of + { _lhsOquantVarMp -> + ( _lhsOquantVarMp) }) }) }) }) diff --git a/src/UHC/Light/Compiler/AnaDomain/Trf/Instantiate.hs b/src/UHC/Light/Compiler/AnaDomain/Trf/Instantiate.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain/Trf/Instantiate.hs @@ -0,0 +1,989 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/AnaDomain/Trf/) +module UHC.Light.Compiler.AnaDomain.Trf.Instantiate(relevtyInst) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import qualified Data.Map as Map +import qualified Data.Set as Set + + + + + + + + + +relevtyInst :: UID -> RelevTy -> (RelevTy,RelevQualS) +relevtyInst uniq ty + = (ty', extraQualS `Set.union` qualS_Syn_TyAGItf t) + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf + { gUniq_Inh_TyAGItf = uniq + }) + ty' = repl_Syn_TyAGItf t + extraQualS + = case ty of + RelevTy_Fun RQuant_Rec _ _ a r + -> amsGathQual ams + where (amso,ams) = amsLE emptyRVarMp (RelevTy_Fun RQuant_None [] [] a r) ty' + _ -> Set.empty + +-- AnaEval ----------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : AnaEval + alternatives: + alternative Var: + child av : {UID} + alternative WHNF: + visit 0: + local repl : _ + alternative Lazy: + visit 0: + local repl : _ + alternative Meet: + child opnds : AnaEvalL + visit 0: + local repl : _ + alternative Join: + child opnds : AnaEvalL + visit 0: + local repl : _ +-} +-- cata +sem_AnaEval :: AnaEval -> + T_AnaEval +sem_AnaEval (AnaEval_Var _av) = + (sem_AnaEval_Var _av) +sem_AnaEval (AnaEval_WHNF) = + (sem_AnaEval_WHNF) +sem_AnaEval (AnaEval_Lazy) = + (sem_AnaEval_Lazy) +sem_AnaEval (AnaEval_Meet _opnds) = + (sem_AnaEval_Meet (sem_AnaEvalL _opnds)) +sem_AnaEval (AnaEval_Join _opnds) = + (sem_AnaEval_Join (sem_AnaEvalL _opnds)) +-- semantic domain +type T_AnaEval = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,AnaEval) +sem_AnaEval_Var :: UID -> + T_AnaEval +sem_AnaEval_Var av_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (AnaEval_Var $ Map.findWithDefault av_ av_ _lhsIfreshMp) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) })) +sem_AnaEval_WHNF :: T_AnaEval +sem_AnaEval_WHNF = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (AnaEval_WHNF) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_AnaEval_Lazy :: T_AnaEval +sem_AnaEval_Lazy = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (AnaEval_Lazy) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_AnaEval_Meet :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Meet opnds_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _opndsOgUniq -> + (case (_lhsIfreshMp) of + { _opndsOfreshMp -> + (case (opnds_ _opndsOfreshMp _opndsOgUniq) of + { ( _opndsIgUniq,_opndsIqualS,_opndsIrepl) -> + (case (_opndsIgUniq) of + { _lhsOgUniq -> + (case (_opndsIqualS) of + { _lhsOqualS -> + (case (AnaEval_Meet _opndsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) })) +sem_AnaEval_Join :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Join opnds_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _opndsOgUniq -> + (case (_lhsIfreshMp) of + { _opndsOfreshMp -> + (case (opnds_ _opndsOfreshMp _opndsOgUniq) of + { ( _opndsIgUniq,_opndsIqualS,_opndsIrepl) -> + (case (_opndsIgUniq) of + { _lhsOgUniq -> + (case (_opndsIqualS) of + { _lhsOqualS -> + (case (AnaEval_Join _opndsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) })) +-- AnaEvalL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : AnaEvalL + alternatives: + alternative Cons: + child hd : AnaEval + child tl : AnaEvalL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_AnaEvalL :: AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL list = + (Prelude.foldr sem_AnaEvalL_Cons sem_AnaEvalL_Nil (Prelude.map sem_AnaEval list)) +-- semantic domain +type T_AnaEvalL = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,AnaEvalL) +sem_AnaEvalL_Cons :: T_AnaEval -> + T_AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL_Cons hd_ tl_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsIfreshMp) of + { _hdOfreshMp -> + (case (hd_ _hdOfreshMp _hdOgUniq) of + { ( _hdIgUniq,_hdIqualS,_hdIrepl) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_lhsIfreshMp) of + { _tlOfreshMp -> + (case (tl_ _tlOfreshMp _tlOgUniq) of + { ( _tlIgUniq,_tlIqualS,_tlIrepl) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_hdIqualS `Set.union` _tlIqualS) of + { _lhsOqualS -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_AnaEvalL_Nil :: T_AnaEvalL +sem_AnaEvalL_Nil = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +-- CoeAGItf ---------------------------------------------------- +{- + alternatives: + alternative AGItf: + child relevCoe : RelevCoe +-} +-- cata +sem_CoeAGItf :: CoeAGItf -> + T_CoeAGItf +sem_CoeAGItf (CoeAGItf_AGItf _relevCoe) = + (sem_CoeAGItf_AGItf (sem_RelevCoe _relevCoe)) +-- semantic domain +type T_CoeAGItf = ( ) +sem_CoeAGItf_AGItf :: T_RelevCoe -> + T_CoeAGItf +sem_CoeAGItf_AGItf relevCoe_ = + ( ) +-- MbRelevTy --------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : MbRelevTy + alternatives: + alternative Just: + child just : RelevTy + visit 0: + local repl : _ + alternative Nothing: + visit 0: + local repl : _ +-} +-- cata +sem_MbRelevTy :: MbRelevTy -> + T_MbRelevTy +sem_MbRelevTy (Prelude.Just x) = + (sem_MbRelevTy_Just (sem_RelevTy x)) +sem_MbRelevTy Prelude.Nothing = + sem_MbRelevTy_Nothing +-- semantic domain +type T_MbRelevTy = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,MbRelevTy) +sem_MbRelevTy_Just :: T_RelevTy -> + T_MbRelevTy +sem_MbRelevTy_Just just_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _justOgUniq -> + (case (_lhsIfreshMp) of + { _justOfreshMp -> + (case (just_ _justOfreshMp _justOgUniq) of + { ( _justIgUniq,_justIqualS,_justIrepl) -> + (case (_justIgUniq) of + { _lhsOgUniq -> + (case (_justIqualS) of + { _lhsOqualS -> + (case (Just _justIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) })) +sem_MbRelevTy_Nothing :: T_MbRelevTy +sem_MbRelevTy_Nothing = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (Nothing) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +-- QualAGItf --------------------------------------------------- +{- + alternatives: + alternative AGItf: + child relevQual : RelevQual +-} +-- cata +sem_QualAGItf :: QualAGItf -> + T_QualAGItf +sem_QualAGItf (QualAGItf_AGItf _relevQual) = + (sem_QualAGItf_AGItf (sem_RelevQual _relevQual)) +-- semantic domain +type T_QualAGItf = ( ) +sem_QualAGItf_AGItf :: T_RelevQual -> + T_QualAGItf +sem_QualAGItf_AGItf relevQual_ = + ( ) +-- RelevCoe ---------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevCoe + alternatives: + alternative Id: + visit 0: + local repl : _ + alternative Err: + child str : {String} + visit 0: + local repl : _ + alternative Comp: + child l : RelevCoe + child r : RelevCoe + visit 0: + local repl : _ + alternative Fun: + child args : RelevCoeL + child res : RelevCoe + visit 0: + local repl : _ + alternative Cast: + child coe : RelevCoe + visit 0: + local repl : _ + alternative CastTy: + child l : RelevTy + child r : RelevTy + visit 0: + local repl : _ + alternative Eval: + child from : AnaEval + child to : AnaEval + visit 0: + local repl : _ +-} +-- cata +sem_RelevCoe :: RelevCoe -> + T_RelevCoe +sem_RelevCoe (RelevCoe_Id) = + (sem_RelevCoe_Id) +sem_RelevCoe (RelevCoe_Err _str) = + (sem_RelevCoe_Err _str) +sem_RelevCoe (RelevCoe_Comp _l _r) = + (sem_RelevCoe_Comp (sem_RelevCoe _l) (sem_RelevCoe _r)) +sem_RelevCoe (RelevCoe_Fun _args _res) = + (sem_RelevCoe_Fun (sem_RelevCoeL _args) (sem_RelevCoe _res)) +sem_RelevCoe (RelevCoe_Cast _coe) = + (sem_RelevCoe_Cast (sem_RelevCoe _coe)) +sem_RelevCoe (RelevCoe_CastTy _l _r) = + (sem_RelevCoe_CastTy (sem_RelevTy _l) (sem_RelevTy _r)) +sem_RelevCoe (RelevCoe_Eval _from _to) = + (sem_RelevCoe_Eval (sem_AnaEval _from) (sem_AnaEval _to)) +-- semantic domain +type T_RelevCoe = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevCoe) +sem_RelevCoe_Id :: T_RelevCoe +sem_RelevCoe_Id = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (RelevCoe_Id) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_RelevCoe_Err :: String -> + T_RelevCoe +sem_RelevCoe_Err str_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (RelevCoe_Err str_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_RelevCoe_Comp :: T_RelevCoe -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Comp l_ r_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lOgUniq -> + (case (_lhsIfreshMp) of + { _lOfreshMp -> + (case (l_ _lOfreshMp _lOgUniq) of + { ( _lIgUniq,_lIqualS,_lIrepl) -> + (case (_lIgUniq) of + { _rOgUniq -> + (case (_lhsIfreshMp) of + { _rOfreshMp -> + (case (r_ _rOfreshMp _rOgUniq) of + { ( _rIgUniq,_rIqualS,_rIrepl) -> + (case (_rIgUniq) of + { _lhsOgUniq -> + (case (_lIqualS `Set.union` _rIqualS) of + { _lhsOqualS -> + (case (RelevCoe_Comp _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevCoe_Fun :: T_RelevCoeL -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Fun args_ res_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _argsOgUniq -> + (case (_lhsIfreshMp) of + { _argsOfreshMp -> + (case (args_ _argsOfreshMp _argsOgUniq) of + { ( _argsIgUniq,_argsIqualS,_argsIrepl) -> + (case (_argsIgUniq) of + { _resOgUniq -> + (case (_lhsIfreshMp) of + { _resOfreshMp -> + (case (res_ _resOfreshMp _resOgUniq) of + { ( _resIgUniq,_resIqualS,_resIrepl) -> + (case (_resIgUniq) of + { _lhsOgUniq -> + (case (_argsIqualS `Set.union` _resIqualS) of + { _lhsOqualS -> + (case (RelevCoe_Fun _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevCoe_Cast :: T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Cast coe_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _coeOgUniq -> + (case (_lhsIfreshMp) of + { _coeOfreshMp -> + (case (coe_ _coeOfreshMp _coeOgUniq) of + { ( _coeIgUniq,_coeIqualS,_coeIrepl) -> + (case (_coeIgUniq) of + { _lhsOgUniq -> + (case (_coeIqualS) of + { _lhsOqualS -> + (case (RelevCoe_Cast _coeIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) })) +sem_RelevCoe_CastTy :: T_RelevTy -> + T_RelevTy -> + T_RelevCoe +sem_RelevCoe_CastTy l_ r_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lOgUniq -> + (case (_lhsIfreshMp) of + { _lOfreshMp -> + (case (l_ _lOfreshMp _lOgUniq) of + { ( _lIgUniq,_lIqualS,_lIrepl) -> + (case (_lIgUniq) of + { _rOgUniq -> + (case (_lhsIfreshMp) of + { _rOfreshMp -> + (case (r_ _rOfreshMp _rOgUniq) of + { ( _rIgUniq,_rIqualS,_rIrepl) -> + (case (_rIgUniq) of + { _lhsOgUniq -> + (case (_lIqualS `Set.union` _rIqualS) of + { _lhsOqualS -> + (case (RelevCoe_CastTy _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevCoe_Eval :: T_AnaEval -> + T_AnaEval -> + T_RelevCoe +sem_RelevCoe_Eval from_ to_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _fromOgUniq -> + (case (_lhsIfreshMp) of + { _fromOfreshMp -> + (case (from_ _fromOfreshMp _fromOgUniq) of + { ( _fromIgUniq,_fromIqualS,_fromIrepl) -> + (case (_fromIgUniq) of + { _toOgUniq -> + (case (_lhsIfreshMp) of + { _toOfreshMp -> + (case (to_ _toOfreshMp _toOgUniq) of + { ( _toIgUniq,_toIqualS,_toIrepl) -> + (case (_toIgUniq) of + { _lhsOgUniq -> + (case (_fromIqualS `Set.union` _toIqualS) of + { _lhsOqualS -> + (case (RelevCoe_Eval _fromIrepl _toIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +-- RelevCoeL --------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevCoeL + alternatives: + alternative Cons: + child hd : RelevCoe + child tl : RelevCoeL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevCoeL :: RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL list = + (Prelude.foldr sem_RelevCoeL_Cons sem_RelevCoeL_Nil (Prelude.map sem_RelevCoe list)) +-- semantic domain +type T_RelevCoeL = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevCoeL) +sem_RelevCoeL_Cons :: T_RelevCoe -> + T_RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL_Cons hd_ tl_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsIfreshMp) of + { _hdOfreshMp -> + (case (hd_ _hdOfreshMp _hdOgUniq) of + { ( _hdIgUniq,_hdIqualS,_hdIrepl) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_lhsIfreshMp) of + { _tlOfreshMp -> + (case (tl_ _tlOfreshMp _tlOgUniq) of + { ( _tlIgUniq,_tlIqualS,_tlIrepl) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_hdIqualS `Set.union` _tlIqualS) of + { _lhsOqualS -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevCoeL_Nil :: T_RelevCoeL +sem_RelevCoeL_Nil = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +-- RelevQual --------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevQual + alternatives: + alternative SubEval: + child l : AnaEval + child r : AnaEval + visit 0: + local repl : _ +-} +-- cata +sem_RelevQual :: RelevQual -> + T_RelevQual +sem_RelevQual (RelevQual_SubEval _l _r) = + (sem_RelevQual_SubEval (sem_AnaEval _l) (sem_AnaEval _r)) +-- semantic domain +type T_RelevQual = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevQual) +sem_RelevQual_SubEval :: T_AnaEval -> + T_AnaEval -> + T_RelevQual +sem_RelevQual_SubEval l_ r_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lOgUniq -> + (case (_lhsIfreshMp) of + { _lOfreshMp -> + (case (l_ _lOfreshMp _lOgUniq) of + { ( _lIgUniq,_lIqualS,_lIrepl) -> + (case (_lIgUniq) of + { _rOgUniq -> + (case (_lhsIfreshMp) of + { _rOfreshMp -> + (case (r_ _rOfreshMp _rOgUniq) of + { ( _rIgUniq,_rIqualS,_rIrepl) -> + (case (_rIgUniq) of + { _lhsOgUniq -> + (case (_lIqualS `Set.union` _rIqualS) of + { _lhsOqualS -> + (case (RelevQual_SubEval _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +-- RelevQualL -------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevQualL + alternatives: + alternative Cons: + child hd : RelevQual + child tl : RelevQualL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevQualL :: RelevQualL -> + T_RelevQualL +sem_RelevQualL list = + (Prelude.foldr sem_RelevQualL_Cons sem_RelevQualL_Nil (Prelude.map sem_RelevQual list)) +-- semantic domain +type T_RelevQualL = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevQualL) +sem_RelevQualL_Cons :: T_RelevQual -> + T_RelevQualL -> + T_RelevQualL +sem_RelevQualL_Cons hd_ tl_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsIfreshMp) of + { _hdOfreshMp -> + (case (hd_ _hdOfreshMp _hdOgUniq) of + { ( _hdIgUniq,_hdIqualS,_hdIrepl) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_lhsIfreshMp) of + { _tlOfreshMp -> + (case (tl_ _tlOfreshMp _tlOgUniq) of + { ( _tlIgUniq,_tlIqualS,_tlIrepl) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_hdIqualS `Set.union` _tlIqualS) of + { _lhsOqualS -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevQualL_Nil :: T_RelevQualL +sem_RelevQualL_Nil = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +-- RelevTy ----------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevTy + alternatives: + alternative None: + visit 0: + local repl : _ + alternative Err: + child str : {String} + visit 0: + local repl : _ + alternative Ana: + child eval : AnaEval + visit 0: + local repl : _ + alternative Fun: + child quant : {RQuant} + child quants : {[UID]} + child quals : RelevQualL + child args : RelevTyL + child res : RelevTy + visit 0: + local _tup1 : _ + local lUniq : {UID} + local freshTvL : _ + local freshMp : _ +-} +-- cata +sem_RelevTy :: RelevTy -> + T_RelevTy +sem_RelevTy (RelevTy_None) = + (sem_RelevTy_None) +sem_RelevTy (RelevTy_Err _str) = + (sem_RelevTy_Err _str) +sem_RelevTy (RelevTy_Ana _eval) = + (sem_RelevTy_Ana (sem_AnaEval _eval)) +sem_RelevTy (RelevTy_Fun _quant _quants _quals _args _res) = + (sem_RelevTy_Fun _quant _quants (sem_RelevQualL _quals) (sem_RelevTyL _args) (sem_RelevTy _res)) +-- semantic domain +type T_RelevTy = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevTy) +sem_RelevTy_None :: T_RelevTy +sem_RelevTy_None = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (RelevTy_None) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_RelevTy_Err :: String -> + T_RelevTy +sem_RelevTy_Err str_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case (RelevTy_Err str_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +sem_RelevTy_Ana :: T_AnaEval -> + T_RelevTy +sem_RelevTy_Ana eval_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _evalOgUniq -> + (case (_lhsIfreshMp) of + { _evalOfreshMp -> + (case (eval_ _evalOfreshMp _evalOgUniq) of + { ( _evalIgUniq,_evalIqualS,_evalIrepl) -> + (case (_evalIgUniq) of + { _lhsOgUniq -> + (case (_evalIqualS) of + { _lhsOqualS -> + (case (RelevTy_Ana _evalIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) })) +sem_RelevTy_Fun :: RQuant -> + ([UID]) -> + T_RelevQualL -> + T_RelevTyL -> + T_RelevTy -> + T_RelevTy +sem_RelevTy_Fun quant_ quants_ quals_ args_ res_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup1 -> + (case (__tup1) of + { (_qualsOgUniq,_) -> + (case (__tup1) of + { (_,_lUniq) -> + (case (mkNewLevUIDL (length quants_) _lUniq) of + { _freshTvL -> + (case (Map.union (Map.fromList $ zip quants_ _freshTvL) _lhsIfreshMp) of + { _freshMp -> + (case (_freshMp) of + { _qualsOfreshMp -> + (case (quals_ _qualsOfreshMp _qualsOgUniq) of + { ( _qualsIgUniq,_qualsIqualS,_qualsIrepl) -> + (case (_qualsIgUniq) of + { _argsOgUniq -> + (case (_freshMp) of + { _argsOfreshMp -> + (case (args_ _argsOfreshMp _argsOgUniq) of + { ( _argsIgUniq,_argsIqualS,_argsIrepl) -> + (case (_argsIgUniq) of + { _resOgUniq -> + (case (_freshMp) of + { _resOfreshMp -> + (case (res_ _resOfreshMp _resOgUniq) of + { ( _resIgUniq,_resIqualS,_resIrepl) -> + (case (_resIgUniq) of + { _lhsOgUniq -> + (case (Set.unions [ Set.fromList _qualsIrepl, _argsIqualS, _resIqualS ]) of + { _lhsOqualS -> + (case (RelevTy_Fun RQuant_None [] [] _argsIrepl _resIrepl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- RelevTyL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + freshMp : Map.Map UID UID + chained attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevTyL + alternatives: + alternative Cons: + child hd : RelevTy + child tl : RelevTyL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevTyL :: RelevTyL -> + T_RelevTyL +sem_RelevTyL list = + (Prelude.foldr sem_RelevTyL_Cons sem_RelevTyL_Nil (Prelude.map sem_RelevTy list)) +-- semantic domain +type T_RelevTyL = (Map.Map UID UID) -> + UID -> + ( UID,RelevQualS,RelevTyL) +sem_RelevTyL_Cons :: T_RelevTy -> + T_RelevTyL -> + T_RelevTyL +sem_RelevTyL_Cons hd_ tl_ = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsIfreshMp) of + { _hdOfreshMp -> + (case (hd_ _hdOfreshMp _hdOgUniq) of + { ( _hdIgUniq,_hdIqualS,_hdIrepl) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_lhsIfreshMp) of + { _tlOfreshMp -> + (case (tl_ _tlOfreshMp _tlOgUniq) of + { ( _tlIgUniq,_tlIqualS,_tlIrepl) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_hdIqualS `Set.union` _tlIqualS) of + { _lhsOqualS -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_RelevTyL_Nil :: T_RelevTyL +sem_RelevTyL_Nil = + (\ _lhsIfreshMp + _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Set.empty) of + { _lhsOqualS -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOgUniq,_lhsOqualS,_lhsOrepl) }) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + gUniq : UID + synthesized attributes: + qualS : RelevQualS + repl : RelevTy + alternatives: + alternative AGItf: + child relevTy : RelevTy + visit 0: + local freshMp : _ +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _relevTy) = + (sem_TyAGItf_AGItf (sem_RelevTy _relevTy)) +-- semantic domain +type T_TyAGItf = UID -> + ( RelevQualS,RelevTy) +data Inh_TyAGItf = Inh_TyAGItf {gUniq_Inh_TyAGItf :: !(UID)} +data Syn_TyAGItf = Syn_TyAGItf {qualS_Syn_TyAGItf :: !(RelevQualS),repl_Syn_TyAGItf :: !(RelevTy)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIgUniq) = + (let ( _lhsOqualS,_lhsOrepl) = sem _lhsIgUniq + in (Syn_TyAGItf _lhsOqualS _lhsOrepl)) +sem_TyAGItf_AGItf :: T_RelevTy -> + T_TyAGItf +sem_TyAGItf_AGItf relevTy_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _relevTyOgUniq -> + (case (Map.empty) of + { _freshMp -> + (case (_freshMp) of + { _relevTyOfreshMp -> + (case (relevTy_ _relevTyOfreshMp _relevTyOgUniq) of + { ( _relevTyIgUniq,_relevTyIqualS,_relevTyIrepl) -> + (case (_relevTyIqualS) of + { _lhsOqualS -> + (case (_relevTyIrepl) of + { _lhsOrepl -> + ( _lhsOqualS,_lhsOrepl) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/AnaDomain/Trf/Subst.hs b/src/UHC/Light/Compiler/AnaDomain/Trf/Subst.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain/Trf/Subst.hs @@ -0,0 +1,824 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/AnaDomain/Trf/) +module UHC.Light.Compiler.AnaDomain.Trf.Subst(relevtyAppVarLookup +, relevqualAppVarLookup +, relevcoeAppVarLookup) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.VarMp +import UHC.Util.Utils + + + + + + + +relevtyAppVarLookup :: VarLookup m UID RVarMpInfo => m -> RelevTy -> RelevTy +relevtyAppVarLookup varmp ty + = repl_Syn_TyAGItf t + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf {rvarLookup_Inh_TyAGItf = varlookupFix varmp}) + + + +relevqualAppVarLookup :: VarLookup m UID RVarMpInfo => m -> RelevQual -> RelevQual +relevqualAppVarLookup varmp qual + = repl_Syn_QualAGItf t + where t = wrap_QualAGItf + (sem_QualAGItf (QualAGItf_AGItf qual)) + (Inh_QualAGItf {rvarLookup_Inh_QualAGItf = varlookupFix varmp}) + + + +relevcoeAppVarLookup :: VarLookup m UID RVarMpInfo => m -> RelevCoe -> RelevCoe +relevcoeAppVarLookup varmp coe + = repl_Syn_CoeAGItf t + where t = wrap_CoeAGItf + (sem_CoeAGItf (CoeAGItf_AGItf coe)) + (Inh_CoeAGItf {rvarLookup_Inh_CoeAGItf = varlookupFix varmp}) + +-- AnaEval ----------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : AnaEval + alternatives: + alternative Var: + child av : {UID} + visit 0: + local repl : _ + local _tup1 : _ + local isRepl : _ + local replv : _ + inst repl' : AnaEval + alternative WHNF: + visit 0: + local repl : _ + alternative Lazy: + visit 0: + local repl : _ + alternative Meet: + child opnds : AnaEvalL + visit 0: + local repl : _ + alternative Join: + child opnds : AnaEvalL + visit 0: + local repl : _ +-} +-- cata +sem_AnaEval :: AnaEval -> + T_AnaEval +sem_AnaEval (AnaEval_Var _av) = + (sem_AnaEval_Var _av) +sem_AnaEval (AnaEval_WHNF) = + (sem_AnaEval_WHNF) +sem_AnaEval (AnaEval_Lazy) = + (sem_AnaEval_Lazy) +sem_AnaEval (AnaEval_Meet _opnds) = + (sem_AnaEval_Meet (sem_AnaEvalL _opnds)) +sem_AnaEval (AnaEval_Join _opnds) = + (sem_AnaEval_Join (sem_AnaEvalL _opnds)) +-- semantic domain +type T_AnaEval = (VarLookupFix UID RVarMpInfo) -> + ( AnaEval) +sem_AnaEval_Var :: UID -> + T_AnaEval +sem_AnaEval_Var av_ = + (\ _lhsIrvarLookup -> + (case (AnaEval_Var av_) of + { _repl -> + (case (maybe (_repl,False) (\t -> (t,True)) $ rvmiMbEval $? _lhsIrvarLookup av_) of + { __tup1 -> + (case (__tup1) of + { (_,_isRepl) -> + (case (__tup1) of + { (_replv,_) -> + (case (if _isRepl then _replv else AnaEval_WHNF) of + { repl'_val_ -> + (case ((sem_AnaEval repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIrvarLookup) of + { _repl'OrvarLookup -> + (case (repl'_inst_ _repl'OrvarLookup) of + { ( _repl'Irepl) -> + (case (if _isRepl + then _repl'Irepl + else _repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) }) }) }) })) +sem_AnaEval_WHNF :: T_AnaEval +sem_AnaEval_WHNF = + (\ _lhsIrvarLookup -> + (case (AnaEval_WHNF) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_AnaEval_Lazy :: T_AnaEval +sem_AnaEval_Lazy = + (\ _lhsIrvarLookup -> + (case (AnaEval_Lazy) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_AnaEval_Meet :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Meet opnds_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _opndsOrvarLookup -> + (case (opnds_ _opndsOrvarLookup) of + { ( _opndsIrepl) -> + (case (AnaEval_Meet _opndsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +sem_AnaEval_Join :: T_AnaEvalL -> + T_AnaEval +sem_AnaEval_Join opnds_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _opndsOrvarLookup -> + (case (opnds_ _opndsOrvarLookup) of + { ( _opndsIrepl) -> + (case (AnaEval_Join _opndsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +-- AnaEvalL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : AnaEvalL + alternatives: + alternative Cons: + child hd : AnaEval + child tl : AnaEvalL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_AnaEvalL :: AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL list = + (Prelude.foldr sem_AnaEvalL_Cons sem_AnaEvalL_Nil (Prelude.map sem_AnaEval list)) +-- semantic domain +type T_AnaEvalL = (VarLookupFix UID RVarMpInfo) -> + ( AnaEvalL) +sem_AnaEvalL_Cons :: T_AnaEval -> + T_AnaEvalL -> + T_AnaEvalL +sem_AnaEvalL_Cons hd_ tl_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _tlOrvarLookup -> + (case (_lhsIrvarLookup) of + { _hdOrvarLookup -> + (case (tl_ _tlOrvarLookup) of + { ( _tlIrepl) -> + (case (hd_ _hdOrvarLookup) of + { ( _hdIrepl) -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_AnaEvalL_Nil :: T_AnaEvalL +sem_AnaEvalL_Nil = + (\ _lhsIrvarLookup -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- CoeAGItf ---------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevCoe + alternatives: + alternative AGItf: + child relevCoe : RelevCoe +-} +-- cata +sem_CoeAGItf :: CoeAGItf -> + T_CoeAGItf +sem_CoeAGItf (CoeAGItf_AGItf _relevCoe) = + (sem_CoeAGItf_AGItf (sem_RelevCoe _relevCoe)) +-- semantic domain +type T_CoeAGItf = (VarLookupFix UID RVarMpInfo) -> + ( RelevCoe) +data Inh_CoeAGItf = Inh_CoeAGItf {rvarLookup_Inh_CoeAGItf :: !((VarLookupFix UID RVarMpInfo))} +data Syn_CoeAGItf = Syn_CoeAGItf {repl_Syn_CoeAGItf :: !(RelevCoe)} +wrap_CoeAGItf :: T_CoeAGItf -> + Inh_CoeAGItf -> + Syn_CoeAGItf +wrap_CoeAGItf sem (Inh_CoeAGItf _lhsIrvarLookup) = + (let ( _lhsOrepl) = sem _lhsIrvarLookup + in (Syn_CoeAGItf _lhsOrepl)) +sem_CoeAGItf_AGItf :: T_RelevCoe -> + T_CoeAGItf +sem_CoeAGItf_AGItf relevCoe_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _relevCoeOrvarLookup -> + (case (relevCoe_ _relevCoeOrvarLookup) of + { ( _relevCoeIrepl) -> + (case (_relevCoeIrepl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) })) +-- MbRelevTy --------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : MbRelevTy + alternatives: + alternative Just: + child just : RelevTy + visit 0: + local repl : _ + alternative Nothing: + visit 0: + local repl : _ +-} +-- cata +sem_MbRelevTy :: MbRelevTy -> + T_MbRelevTy +sem_MbRelevTy (Prelude.Just x) = + (sem_MbRelevTy_Just (sem_RelevTy x)) +sem_MbRelevTy Prelude.Nothing = + sem_MbRelevTy_Nothing +-- semantic domain +type T_MbRelevTy = (VarLookupFix UID RVarMpInfo) -> + ( MbRelevTy) +sem_MbRelevTy_Just :: T_RelevTy -> + T_MbRelevTy +sem_MbRelevTy_Just just_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _justOrvarLookup -> + (case (just_ _justOrvarLookup) of + { ( _justIrepl) -> + (case (Just _justIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +sem_MbRelevTy_Nothing :: T_MbRelevTy +sem_MbRelevTy_Nothing = + (\ _lhsIrvarLookup -> + (case (Nothing) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- QualAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevQual + alternatives: + alternative AGItf: + child relevQual : RelevQual +-} +-- cata +sem_QualAGItf :: QualAGItf -> + T_QualAGItf +sem_QualAGItf (QualAGItf_AGItf _relevQual) = + (sem_QualAGItf_AGItf (sem_RelevQual _relevQual)) +-- semantic domain +type T_QualAGItf = (VarLookupFix UID RVarMpInfo) -> + ( RelevQual) +data Inh_QualAGItf = Inh_QualAGItf {rvarLookup_Inh_QualAGItf :: !((VarLookupFix UID RVarMpInfo))} +data Syn_QualAGItf = Syn_QualAGItf {repl_Syn_QualAGItf :: !(RelevQual)} +wrap_QualAGItf :: T_QualAGItf -> + Inh_QualAGItf -> + Syn_QualAGItf +wrap_QualAGItf sem (Inh_QualAGItf _lhsIrvarLookup) = + (let ( _lhsOrepl) = sem _lhsIrvarLookup + in (Syn_QualAGItf _lhsOrepl)) +sem_QualAGItf_AGItf :: T_RelevQual -> + T_QualAGItf +sem_QualAGItf_AGItf relevQual_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _relevQualOrvarLookup -> + (case (relevQual_ _relevQualOrvarLookup) of + { ( _relevQualIrepl) -> + (case (_relevQualIrepl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) })) +-- RelevCoe ---------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevCoe + alternatives: + alternative Id: + visit 0: + local repl : _ + alternative Err: + child str : {String} + visit 0: + local repl : _ + alternative Comp: + child l : RelevCoe + child r : RelevCoe + visit 0: + local repl : _ + alternative Fun: + child args : RelevCoeL + child res : RelevCoe + visit 0: + local repl : _ + alternative Cast: + child coe : RelevCoe + visit 0: + local repl : _ + alternative CastTy: + child l : RelevTy + child r : RelevTy + visit 0: + local repl : _ + alternative Eval: + child from : AnaEval + child to : AnaEval + visit 0: + local repl : _ +-} +-- cata +sem_RelevCoe :: RelevCoe -> + T_RelevCoe +sem_RelevCoe (RelevCoe_Id) = + (sem_RelevCoe_Id) +sem_RelevCoe (RelevCoe_Err _str) = + (sem_RelevCoe_Err _str) +sem_RelevCoe (RelevCoe_Comp _l _r) = + (sem_RelevCoe_Comp (sem_RelevCoe _l) (sem_RelevCoe _r)) +sem_RelevCoe (RelevCoe_Fun _args _res) = + (sem_RelevCoe_Fun (sem_RelevCoeL _args) (sem_RelevCoe _res)) +sem_RelevCoe (RelevCoe_Cast _coe) = + (sem_RelevCoe_Cast (sem_RelevCoe _coe)) +sem_RelevCoe (RelevCoe_CastTy _l _r) = + (sem_RelevCoe_CastTy (sem_RelevTy _l) (sem_RelevTy _r)) +sem_RelevCoe (RelevCoe_Eval _from _to) = + (sem_RelevCoe_Eval (sem_AnaEval _from) (sem_AnaEval _to)) +-- semantic domain +type T_RelevCoe = (VarLookupFix UID RVarMpInfo) -> + ( RelevCoe) +sem_RelevCoe_Id :: T_RelevCoe +sem_RelevCoe_Id = + (\ _lhsIrvarLookup -> + (case (RelevCoe_Id) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_RelevCoe_Err :: String -> + T_RelevCoe +sem_RelevCoe_Err str_ = + (\ _lhsIrvarLookup -> + (case (RelevCoe_Err str_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_RelevCoe_Comp :: T_RelevCoe -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Comp l_ r_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _rOrvarLookup -> + (case (_lhsIrvarLookup) of + { _lOrvarLookup -> + (case (r_ _rOrvarLookup) of + { ( _rIrepl) -> + (case (l_ _lOrvarLookup) of + { ( _lIrepl) -> + (case (RelevCoe_Comp _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevCoe_Fun :: T_RelevCoeL -> + T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Fun args_ res_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _resOrvarLookup -> + (case (_lhsIrvarLookup) of + { _argsOrvarLookup -> + (case (res_ _resOrvarLookup) of + { ( _resIrepl) -> + (case (args_ _argsOrvarLookup) of + { ( _argsIrepl) -> + (case (RelevCoe_Fun _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevCoe_Cast :: T_RelevCoe -> + T_RelevCoe +sem_RelevCoe_Cast coe_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _coeOrvarLookup -> + (case (coe_ _coeOrvarLookup) of + { ( _coeIrepl) -> + (case (RelevCoe_Cast _coeIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +sem_RelevCoe_CastTy :: T_RelevTy -> + T_RelevTy -> + T_RelevCoe +sem_RelevCoe_CastTy l_ r_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _rOrvarLookup -> + (case (_lhsIrvarLookup) of + { _lOrvarLookup -> + (case (r_ _rOrvarLookup) of + { ( _rIrepl) -> + (case (l_ _lOrvarLookup) of + { ( _lIrepl) -> + (case (RelevCoe_CastTy _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevCoe_Eval :: T_AnaEval -> + T_AnaEval -> + T_RelevCoe +sem_RelevCoe_Eval from_ to_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _toOrvarLookup -> + (case (_lhsIrvarLookup) of + { _fromOrvarLookup -> + (case (to_ _toOrvarLookup) of + { ( _toIrepl) -> + (case (from_ _fromOrvarLookup) of + { ( _fromIrepl) -> + (case (RelevCoe_Eval _fromIrepl _toIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +-- RelevCoeL --------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevCoeL + alternatives: + alternative Cons: + child hd : RelevCoe + child tl : RelevCoeL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevCoeL :: RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL list = + (Prelude.foldr sem_RelevCoeL_Cons sem_RelevCoeL_Nil (Prelude.map sem_RelevCoe list)) +-- semantic domain +type T_RelevCoeL = (VarLookupFix UID RVarMpInfo) -> + ( RelevCoeL) +sem_RelevCoeL_Cons :: T_RelevCoe -> + T_RelevCoeL -> + T_RelevCoeL +sem_RelevCoeL_Cons hd_ tl_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _tlOrvarLookup -> + (case (_lhsIrvarLookup) of + { _hdOrvarLookup -> + (case (tl_ _tlOrvarLookup) of + { ( _tlIrepl) -> + (case (hd_ _hdOrvarLookup) of + { ( _hdIrepl) -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevCoeL_Nil :: T_RelevCoeL +sem_RelevCoeL_Nil = + (\ _lhsIrvarLookup -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- RelevQual --------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevQual + alternatives: + alternative SubEval: + child l : AnaEval + child r : AnaEval + visit 0: + local repl : _ +-} +-- cata +sem_RelevQual :: RelevQual -> + T_RelevQual +sem_RelevQual (RelevQual_SubEval _l _r) = + (sem_RelevQual_SubEval (sem_AnaEval _l) (sem_AnaEval _r)) +-- semantic domain +type T_RelevQual = (VarLookupFix UID RVarMpInfo) -> + ( RelevQual) +sem_RelevQual_SubEval :: T_AnaEval -> + T_AnaEval -> + T_RelevQual +sem_RelevQual_SubEval l_ r_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _rOrvarLookup -> + (case (_lhsIrvarLookup) of + { _lOrvarLookup -> + (case (r_ _rOrvarLookup) of + { ( _rIrepl) -> + (case (l_ _lOrvarLookup) of + { ( _lIrepl) -> + (case (RelevQual_SubEval _lIrepl _rIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +-- RelevQualL -------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevQualL + alternatives: + alternative Cons: + child hd : RelevQual + child tl : RelevQualL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevQualL :: RelevQualL -> + T_RelevQualL +sem_RelevQualL list = + (Prelude.foldr sem_RelevQualL_Cons sem_RelevQualL_Nil (Prelude.map sem_RelevQual list)) +-- semantic domain +type T_RelevQualL = (VarLookupFix UID RVarMpInfo) -> + ( RelevQualL) +sem_RelevQualL_Cons :: T_RelevQual -> + T_RelevQualL -> + T_RelevQualL +sem_RelevQualL_Cons hd_ tl_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _tlOrvarLookup -> + (case (_lhsIrvarLookup) of + { _hdOrvarLookup -> + (case (tl_ _tlOrvarLookup) of + { ( _tlIrepl) -> + (case (hd_ _hdOrvarLookup) of + { ( _hdIrepl) -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevQualL_Nil :: T_RelevQualL +sem_RelevQualL_Nil = + (\ _lhsIrvarLookup -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- RelevTy ----------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevTy + alternatives: + alternative None: + visit 0: + local repl : _ + alternative Err: + child str : {String} + visit 0: + local repl : _ + alternative Ana: + child eval : AnaEval + visit 0: + local repl : _ + alternative Fun: + child quant : {RQuant} + child quants : {[UID]} + child quals : RelevQualL + child args : RelevTyL + child res : RelevTy + visit 0: + local rvarLookup : _ + local repl : _ +-} +-- cata +sem_RelevTy :: RelevTy -> + T_RelevTy +sem_RelevTy (RelevTy_None) = + (sem_RelevTy_None) +sem_RelevTy (RelevTy_Err _str) = + (sem_RelevTy_Err _str) +sem_RelevTy (RelevTy_Ana _eval) = + (sem_RelevTy_Ana (sem_AnaEval _eval)) +sem_RelevTy (RelevTy_Fun _quant _quants _quals _args _res) = + (sem_RelevTy_Fun _quant _quants (sem_RelevQualL _quals) (sem_RelevTyL _args) (sem_RelevTy _res)) +-- semantic domain +type T_RelevTy = (VarLookupFix UID RVarMpInfo) -> + ( RelevTy) +sem_RelevTy_None :: T_RelevTy +sem_RelevTy_None = + (\ _lhsIrvarLookup -> + (case (RelevTy_None) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_RelevTy_Err :: String -> + T_RelevTy +sem_RelevTy_Err str_ = + (\ _lhsIrvarLookup -> + (case (RelevTy_Err str_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_RelevTy_Ana :: T_AnaEval -> + T_RelevTy +sem_RelevTy_Ana eval_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _evalOrvarLookup -> + (case (eval_ _evalOrvarLookup) of + { ( _evalIrepl) -> + (case (RelevTy_Ana _evalIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +sem_RelevTy_Fun :: RQuant -> + ([UID]) -> + T_RelevQualL -> + T_RelevTyL -> + T_RelevTy -> + T_RelevTy +sem_RelevTy_Fun quant_ quants_ quals_ args_ res_ = + (\ _lhsIrvarLookup -> + (case (varlookupFixDel quants_ _lhsIrvarLookup) of + { _rvarLookup -> + (case (_rvarLookup) of + { _resOrvarLookup -> + (case (_rvarLookup) of + { _argsOrvarLookup -> + (case (_rvarLookup) of + { _qualsOrvarLookup -> + (case (res_ _resOrvarLookup) of + { ( _resIrepl) -> + (case (args_ _argsOrvarLookup) of + { ( _argsIrepl) -> + (case (quals_ _qualsOrvarLookup) of + { ( _qualsIrepl) -> + (case (RelevTy_Fun quant_ quants_ _qualsIrepl _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) }) }) }) })) +-- RelevTyL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevTyL + alternatives: + alternative Cons: + child hd : RelevTy + child tl : RelevTyL + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_RelevTyL :: RelevTyL -> + T_RelevTyL +sem_RelevTyL list = + (Prelude.foldr sem_RelevTyL_Cons sem_RelevTyL_Nil (Prelude.map sem_RelevTy list)) +-- semantic domain +type T_RelevTyL = (VarLookupFix UID RVarMpInfo) -> + ( RelevTyL) +sem_RelevTyL_Cons :: T_RelevTy -> + T_RelevTyL -> + T_RelevTyL +sem_RelevTyL_Cons hd_ tl_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _tlOrvarLookup -> + (case (_lhsIrvarLookup) of + { _hdOrvarLookup -> + (case (tl_ _tlOrvarLookup) of + { ( _tlIrepl) -> + (case (hd_ _hdOrvarLookup) of + { ( _hdIrepl) -> + (case ((:) _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) +sem_RelevTyL_Nil :: T_RelevTyL +sem_RelevTyL_Nil = + (\ _lhsIrvarLookup -> + (case ([]) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + rvarLookup : VarLookupFix UID RVarMpInfo + synthesized attribute: + repl : RelevTy + alternatives: + alternative AGItf: + child relevTy : RelevTy +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _relevTy) = + (sem_TyAGItf_AGItf (sem_RelevTy _relevTy)) +-- semantic domain +type T_TyAGItf = (VarLookupFix UID RVarMpInfo) -> + ( RelevTy) +data Inh_TyAGItf = Inh_TyAGItf {rvarLookup_Inh_TyAGItf :: !((VarLookupFix UID RVarMpInfo))} +data Syn_TyAGItf = Syn_TyAGItf {repl_Syn_TyAGItf :: !(RelevTy)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIrvarLookup) = + (let ( _lhsOrepl) = sem _lhsIrvarLookup + in (Syn_TyAGItf _lhsOrepl)) +sem_TyAGItf_AGItf :: T_RelevTy -> + T_TyAGItf +sem_TyAGItf_AGItf relevTy_ = + (\ _lhsIrvarLookup -> + (case (_lhsIrvarLookup) of + { _relevTyOrvarLookup -> + (case (relevTy_ _relevTyOrvarLookup) of + { ( _relevTyIrepl) -> + (case (_relevTyIrepl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) })) diff --git a/src/UHC/Light/Compiler/AnaDomain/Utils.hs b/src/UHC/Light/Compiler/AnaDomain/Utils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/AnaDomain/Utils.hs @@ -0,0 +1,367 @@ +module UHC.Light.Compiler.AnaDomain.Utils +( RelevTyQuantHow (..) +, relevtyQuant +, relevQualRemoveAmbig +, assSolve +, relevTyArgsFromCTag +, relevTyArgs ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.AnaDomain.Trf.Subst +import UHC.Light.Compiler.AnaDomain.Ftv +import UHC.Light.Compiler.Gam.DataGam +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Array +import Data.Maybe +import Data.List +import UHC.Util.Utils +import Control.Monad.State +import Control.Applicative +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import UHC.Light.Compiler.AnaDomain.Pretty + + + +{-# LINE 37 "src/ehc/AnaDomain/Utils.chs" #-} +-- | configuring quantification, for debugging +data RelevTyQuantHow + = RelevTyQuantHow_Solve -- solve + | RelevTyQuantHow_RemoveAmbig -- constraints over vars not in type are removed + | RelevTyQuantHow_VarDefaultToTop -- vars left over, and in type, are defaulted to top + | RelevTyQuantHow_Quant -- quant + | RelevTyQuantHow_Rec -- for recursive use + deriving Eq + +{-# LINE 48 "src/ehc/AnaDomain/Utils.chs" #-} +relevtyQuant + :: [RelevTyQuantHow] + -> RVarMp -> RelevQualS -> RelevTy + -> ( RelevTy + , RVarMp -- extra subst + , RelevQualS -- removed quals + ) +relevtyQuant how m qs t + = case funTy of + t'@(RelevTy_Fun _ _ _ as r) | RelevTyQuantHow_Rec `elem` how + -> ( RelevTy_Fun RQuant_Rec (varFree t') [] as r + , emptyRVarMp + , Set.empty + ) + t'@(RelevTy_Fun _ _ _ as r) + -> ( RelevTy_Fun RQuant_Forall quantOver qs4 as' r' + , solveVarMp + , qs3rem + ) + where ftvT = varFreeSet t' + (qs2,solveVarMp) + | RelevTyQuantHow_Solve `elem` how = assSolve ftvT qsm + | otherwise = (qsm, emptyRVarMp) + where qsm = Set.map (varUpd m) qs + as' = solveVarMp `varUpd` as + r' = solveVarMp `varUpd` r + ftvT' = varFreeSet as' `Set.union` varFreeSet r' + (qs3,qs3rem) + | RelevTyQuantHow_RemoveAmbig `elem` how = relevQualRemoveAmbig ftvT' qsm + | otherwise = (qsm, Set.empty) + where qsm = Set.map (varUpd solveVarMp) qs2 + qs4 = Set.toList qs3 + ftvTQ = ftvT' `Set.union` varFreeSet qs4 + quantOver + | RelevTyQuantHow_Quant `elem` how = Set.toList ftvTQ + | otherwise = [] + t' -> ( t' + , emptyRVarMp + , Set.empty + ) + where funTy = case m `varUpd` t of + t'@(RelevTy_Fun _ _ _ _ _) -> t' + t' -> RelevTy_Fun RQuant_None [] [] [] t' + +{-# LINE 98 "src/ehc/AnaDomain/Utils.chs" #-} +-- | Remove unresolvable constraints, and those referring to free vars +relevQualRemoveAmbig :: UIDS -> RelevQualS -> (RelevQualS,RelevQualS) +relevQualRemoveAmbig bound qualS + = Set.partition ok qualS + where -- ok (RelevQual_Alt _ _ _ _ _ _) = False + ok q = varFreeSet q `Set.isSubsetOf` bound + +{-# LINE 111 "src/ehc/AnaDomain/Utils.chs" #-} +instance VarUpdatable RelevTy RVarMp where + varUpd = relevtyAppVarLookup + +instance VarExtractable RelevTy UID where + varFreeSet = relevTyFtv + +{-# LINE 119 "src/ehc/AnaDomain/Utils.chs" #-} +instance VarUpdatable RelevQual RVarMp where + varUpd = relevqualAppVarLookup + +instance VarExtractable RelevQual UID where + varFreeSet = relevQualFtv + +{-# LINE 127 "src/ehc/AnaDomain/Utils.chs" #-} +instance VarUpdatable RelevCoe RVarMp where + varUpd = relevcoeAppVarLookup + +instance VarExtractable RelevCoe UID where + varFreeSet = relevCoeFtv + +{-# LINE 163 "src/ehc/AnaDomain/Utils.chs" #-} +type WL = Map.Map UID (Set.Set Int) + +data ASS + = ASS + { assWl :: !WL + , assWlRedo :: !WL + , assQm :: !(Map.Map Int RelevQual) + , assVm :: !RVarMp + , assProgress :: !Bool + , assSolved :: !(Set.Set Int) + , assReduced :: !(Set.Set Int) + , assWlSize :: !Int + , assWlPos :: !Int + } + +assSolve :: UIDS -> RelevQualS -> (RelevQualS,RVarMp) +assSolve bound qualS + = -- maybe (qualS, emptyRVarMp) + (\ass -> ( Set.map (qual $ assQm ass) $ (Set.unions $ Map.elems (assWl ass)) `Set.difference` assSolved ass + , assVm ass + ) ) + --- $ tr "assSolve" (pp (show bound)) + $ solve (ASS wlInit Map.empty initQualM emptyRVarMp False Set.empty Set.empty (Map.size wlInit) 0) + where -- solver + solve ass@(ASS {assWl=wl, assQm=qualM, assWlPos=wlPos, assWlSize=wlSize}) + | check_pos {- _vUnbound -} && isJust mbN + = -- tr ("solve: isJust mbN") (v >#< show is >-< "slv :" >#< show (assSolved ass) >-< "slvN:" >#< show (assSolved $ fromJust mbN) >-< "wl :" >#< show wl >-< "wlRedo:" >#< show (assWlRedo $ fromJust mbN) >-< show (assQm ass) >-< show (assQm $ fromJust mbN)) $ + solve ((fromJust mbN) {assProgress = True, assWlPos = wlPos + 1}) + | check_pos + = -- tr ("solve: wlSz > 0(" ++ show wlSz ++ ")") (v >#< show is0 >#< show is >-< show wl) $ + solve (ass {assWlPos = wlPos + 1}) + | assProgress ass + = -- tr ("solve: assProgress ass && Map.size wlRedo > 0") (Map.size wl >#< show wl >-< Map.size wlRedo >#< show wlRedo) $ + let wl' = Map.filter (\s -> not (Set.null s)) wl + in solve (ass {assProgress = False, assWlPos=0, assWl = wl', assWlSize = Map.size wl'}) + | otherwise + = -- tr ("solve: done") ("assVm:" >#< assVm ass) $ + ass + where (v,is0) = Map.elemAt (assWlPos ass) wl + is = is0 `Set.difference` assSolved ass + (isReduced,isToSolve) = splitRedSlv1 qualM is + + -- the real solving work attempts + mbN = solveN v is ass + + -- checks, to be shared in guards + check_pos = wlPos < wlSize + + -- split into those which cannot be further solved, and the rest + splitRedSlv1 m = Set.partition (\i -> varFreeSet (qual m i) `Set.isSubsetOf` bound) + + -- solve combination of all quals related to single AnaEval var + solveN v is ass@(ASS {assWl=wl, assQm=qualM}) + = do (q,s,slv,_) <- solveQN1 (l) v (r) + let (qualM2,isNw) = qmAddL q qualM + slvS = Set.fromList slv + touchedBySubs = (Set.fold (\v is -> is `Set.union` Map.findWithDefault Set.empty v wl) Set.empty $ Set.delete v $ rvarmpKeysSet s) `Set.difference` assSolved ass + (qualM3,wl') = updQualWl slvS s wl qualM2 $ Set.toList $ Set.unions [isNw, is, touchedBySubs] `Set.difference` slvS -- filter (\i -> Set.notMember i slvS) $ isNw ++ isL + updAss wl' qualM3 s slvS ass + where isL = Set.toList is + (l, r, o) = split ([],[],[]) [ (qual qualM i, i) | i <- isL ] + split (l,r,o) (( RelevQual_SubEval a1 (AnaEval_Var v2), i) : qs) | v2 == v = split ((i,a1):l, r, o) qs + split (l,r,o) (( RelevQual_SubEval (AnaEval_Var v1) a2, i) : qs) | v1 == v = split ( l, (i,a2):r, o) qs + split (l,r,o) (( _ , i) : qs) = split ( l, r, i:o) qs + split res _ = res + + -- access qual via index + qual m q = panicJust "amsSolve.qual" $ Map.lookup q m + + -- update qualM + updQualWl slvS s wl qm is = (qm', wl') + where qm' = foldr (\i m -> Map.update (\q -> Just $ s `varUpd` q) i m) qm is + wl' = wlAddL qm' is wl + + -- update ass when something is solved + updAss wl qm s slv ass = Just (ass {assWl=wl, assQm=qm, assVm= s |+> assVm ass, assSolved = Set.union slv $ assSolved ass}) + + -- worklist: initial + remainder; TBD: variable-less quals need to be checked for being tautology + wlAdd m q wl = foldr (add q) wl (varFree (qual m q)) + where add q v wl = Map.alter (Just . maybe (Set.singleton q) (Set.insert q)) v wl + wlAddL m qs wl = foldr (wlAdd m) wl qs + + -- get worklist to solve + wlInit = wlAddL initQualM (Map.keys initQualM) Map.empty + + -- solve a combi of quals with sharing of middle AnaEval var + solveQN1 (als) var (ars) + = -- (\x -> tr "solveQN1.res" (ppCommas als >-< var >|< ppParens varIsBound >-< ppCommas ars >-< "=>" >#< maybe (pp "-") (\(q,s,slv,reason) -> (reason ++ ":") >#< "qual:" >#< q >#< "subs:" >#< s >-< "slv:" >#< show slv) x) x) $ + case (als,ars) of + {- + -} + -- transitive, no alternatives + (ll1, rr1) + | canDo && isJust mbJn + -> return + ( (if null ll1 || null rr1 then [] else [RelevQual_SubEval jn mt]) + ++ varConstraint + , amsLocalVarMp ams2 + , (slv $ als ++ ars) + , "transitivity 1" + ) + | canDo -- weaker transitivity where meet is distributed over the left sides + -> return + ( [ RelevQual_SubEval a mt | a <- alsq ] + ++ varConstraint + , amsLocalVarMp ams1 + , (slv $ als ++ ars) + , "transitivity 2" + ) + where canDo = varIsFree && not (null ll1) && not (null rr1) && isJust mbMt + mbMt@(~(Just (mt,ams1))) = if null rr1 then Just (top,ams0) else r1 ams0 meetl arsq + mbJn@(~(Just (jn,ams2))) = if null ll1 then Just (bot,ams1) else r1 ams1 joinl alsq + varConstraint + = if null rr1 then [] else [RelevQual_SubEval (AnaEval_Var var) mt] + -- symmetry + {- + -} + ((_:_), (_:_)) + | not (null lr) + -> case lr of + ((l,v,r):_) + -> return ( [], bind, [l,r] + , "symmetry" + ) + where bind | varIsFree = bindAnaEval var (AnaEval_Var v ) + | not $ v `Set.member` bound = bindAnaEval v (AnaEval_Var var) + | otherwise = emptyRVarMp + where mbV l = [ (fromJust mbv,i) | (i,a) <- l, let mbv = isVar a, isJust mbv ] + l = mbV als + r = mbV ars + lr = [ (il, v, fromJust mbr) | (v,il) <- l, let mbr = lookup v r, isJust mbr ] + -- reflexivity + {- + -} + ((_:_), _) + | not (null l) + -> case l of + (i:_) + -> return ( [], emptyRVarMp, [i] + , "reflexivity" + ) + where l = [ i | (i,a) <- als, maybe False (==var) (isVar a) ] + -- a free var which is not left constrained anymore, simplifies to the right side + ([], (_:_:_)) + | isJust mbMt + -> return ( [RelevQual_SubEval (AnaEval_Var var) mt], amsLocalVarMp ams1, slv ars + , "right meet" + ) + where mbMt@(~(Just (mt,ams1))) = r1 ams0 meetl arsq + {- + ([], (_:_)) + | varIsFree + -> do (mt,ams1) <- r1 ams0 meetl arsq + return ( [], bindAnaEval var mt |+> amsLocalVarMp ams1, slv ars + , "right meet" + ) + -} + {- + -- a free var not right constrained anymore, is just forgotten, which is pessimistic because we cannot infer 'more info', i.e. down in the lattice + ((_:_), []) + | varIsFree + -> return ( [], emptyRVarMp, slv als, "left forget" ) + -} + {- + -> do (jn,ams1) <- r1 ams0 joinl alsq + return ( [], bindAnaEval var jn |+> amsLocalVarMp ams1, slv als + , "left join" + ) + -} + -- overlaps with transitivity, fired only when we can conclude var <= bot anyway + {- + -} + ([], (_:_)) + | not (null b) + -> return ( [], bindAnaEval var a2, [i] + , "right bot" + ) + where (b,_) = partition (\(_,a) -> isBot a) ars + ~(i,a2) = head b + ((_:_), []) + | not (null b) + -> return ( [], bindAnaEval var a2, [i] + , "left top" + ) + where (b,_) = partition (\(_,a) -> isTop a) als + ~(i,a2) = head b + -- top at right is non-information, throw it away + (_, (_:_)) + | not (null t) + -> return ( [], emptyRVarMp, slv t + , "right top" + ) + where (t,_) = partition (\(_,a) -> isTop a) ars + -- bot at left is non-information, throw it away + ((_:_), _) + | not (null b) + -> return ( [], emptyRVarMp, slv b + , "left bot" + ) + where (b,_) = partition (\(_,a) -> isBot a) als + _ -> Nothing + where alsq = map snd als + arsq = map snd ars + slv a = map fst a + ams0 = emptyAnaMatchState {amsBoundS = bound} + r0 s act one l = r1 s act (one:l) + r1 s act (hd:tl) = foldM (\(x,s') y -> amsRunMb s' $ act x y) (hd,s) tl + varIsBound = var `Set.member` bound + varIsFree = not varIsBound + + -- initial qual map + qmAddL qs m = (m `Map.union` m', Map.keysSet m') + where m' = Map.fromList $ zip [Map.size m ..] qs + initQualM = -- (\v -> tr "initQualM" (pp $ show v) v) $ + fst $ qmAddL (Set.toList qualS) Map.empty + + -- bind, with simple occur check + bindAnaEval v1 a2@(AnaEval_Var v2) | v1 == v2 = emptyRVarMp + bindAnaEval v1 a2 = rvarmpEvalUnit v1 a2 + +{-# LINE 389 "src/ehc/AnaDomain/Utils.chs" #-} +-- | relev ty for tuple/constructor. isJust mbResTy <=> not isInPat +relevTyArgsFromCTag :: Bool -> CTag -> Maybe RelevTy -> Int -> DataGam -> UID -> Maybe ([RelevTy],RelevQualS) +relevTyArgsFromCTag isInPat ct mbResTy arity dataGam u + = case ct of + CTagRec + -> Just (map fresh $ mkNewLevUIDL arity u, Set.empty) + _ -> case dataGamTagLookup ct dataGam of + Just (_,dti) + -> Just (as, Set.fromList qa) + where (as, qa) = relevTyArgs frC constrain u (map ((==Strictness_Strict) . dcfaiStrictness) $ dtiConFldAnnL dti) res + (res, frC, constrain) + = case mbResTy of + Just t + -> (t , fr, \(RelevTy_Ana x) (RelevTy_Ana y) -> [RelevQual_SubEval x y]) + where fr _ = fresh + _ -> (top, fr, \_ _ -> [] ) + where fr e | e = freshStrict + | otherwise = freshLazy + _ -> Nothing + + +{-# LINE 413 "src/ehc/AnaDomain/Utils.chs" #-} +relevTyArgs :: (Bool -> UID -> RelevTy) -> (RelevTy -> RelevTy -> [RelevQual]) -> UID -> [Bool] -> RelevTy -> ([RelevTy],[RelevQual]) +relevTyArgs fresh constrain u relevForRes res + = (as, concat qa) + where (as,qa) = unzip $ zipWith mk relevForRes $ mkNewLevUIDL (length relevForRes) u + where mk e u | e = (t,constrain t res) + | otherwise = (t,[] ) + where t = fresh e u + diff --git a/src/UHC/Light/Compiler/Base/CfgPP.hs b/src/UHC/Light/Compiler/Base/CfgPP.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/CfgPP.hs @@ -0,0 +1,100 @@ +module UHC.Light.Compiler.Base.CfgPP +( CfgPP (..) +, CfgPP_Plain (..), CfgPP_Core (..), CfgPP_Grin (..), CfgPP_TyCore (..) +, ppCTag', ppCTagExtensive' +, ppCTagsMp ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Scanner.Common +import Data.Char +import qualified Data.Set as Set +import UHC.Util.Pretty + +{-# LINE 37 "src/ehc/Base/CfgPP.chs" #-} +class CfgPP x where + cfgppHsName :: x -> HsName -> PP_Doc + cfgppConHsName :: x -> HsName -> PP_Doc + cfgppUID :: x -> UID -> PP_Doc + cfgppVarHsName :: x -> Maybe HsName -> Maybe UID -> Maybe Int -> Maybe PP_Doc -> PP_Doc + cfgppVarHsNameFallback + :: x -> Maybe HsName -> Maybe UID -> Maybe Int -> Maybe PP_Doc -> PP_Doc + cfgppFollowAST :: x -> Bool + cfgppTyPPVarDflt :: x -> String -> UID -> Maybe PP_Doc -> PP_Doc + + cfgppHsName _ = pp + cfgppConHsName _ = ppCon + cfgppUID _ = pp + cfgppVarHsName x mn mu mi mp = cfgppVarHsNameFallback x mn mu mi mp + cfgppVarHsNameFallback x _ _ _ (Just p) = p + cfgppVarHsNameFallback x _ _ (Just i) _ = cfgppHsName x $ mkHNm $ tnUniqRepr i + cfgppVarHsNameFallback x (Just n) _ _ _ = cfgppHsName x n + cfgppVarHsNameFallback x _ (Just u) _ _ = cfgppUID x u + cfgppFollowAST _ = False + cfgppTyPPVarDflt = \x pre tv mbpp -> cfgppVarHsName x (Just $ mkHNm $ pre ++ "_" ++ show tv) (Just tv) Nothing mbpp + +{-# LINE 60 "src/ehc/Base/CfgPP.chs" #-} +data CfgPP_Plain = CfgPP_Plain +data CfgPP_Core = CfgPP_Core +data CfgPP_TyCore = CfgPP_TyCore +data CfgPP_Grin = CfgPP_Grin + +{-# LINE 67 "src/ehc/Base/CfgPP.chs" #-} +instance CfgPP CfgPP_Plain + +{-# LINE 71 "src/ehc/Base/CfgPP.chs" #-} +instance CfgPP CfgPP_Core where + cfgppHsName _ n = fst $ ppHsnEscapeWith '$' (hsnOkChars '$' $ copts) (hsnNotOkStrs copts) (`Set.member` leaveAsIs) n + where copts = coreScanOpts emptyEHCOpts + leaveAsIs = Set.fromList [hsnRowEmpty] + cfgppConHsName = cfgppHsName + cfgppFollowAST = const True + cfgppUID _ u = ppUIDParseable u + cfgppVarHsName x _ (Just u) _ _ = cfgppUID x u + cfgppVarHsName x mn mu mi mp = cfgppVarHsNameFallback x mn mu mi mp + +{-# LINE 83 "src/ehc/Base/CfgPP.chs" #-} +ppNmTyCore = ppHsnEscaped (Right $ Set.fromList ['0'..'9']) '$' (hsnEscapeeChars '$' tycoreScanOpts) + +instance CfgPP CfgPP_TyCore where + cfgppHsName _ = ppNmTyCore + +{-# LINE 90 "src/ehc/Base/CfgPP.chs" #-} +instance CfgPP CfgPP_Grin where + cfgppHsName _ = ppHsnNonAlpha grinScanOpts + +{-# LINE 99 "src/ehc/Base/CfgPP.chs" #-} +tnUniqRepr :: Int -> String +tnUniqRepr + = lrepr + where lrepr i = if i <= 26 + then [repr i] + else let (d,r) = i `divMod` 26 + in (repr d : lrepr r) + repr = (chr . (97+)) + +{-# LINE 114 "src/ehc/Base/CfgPP.chs" #-} +-- intended for parsing +ppCTag' :: CfgPP x => x -> CTag -> PP_Doc +ppCTag' x t + = case t of + CTagRec -> ppCurly "Rec" + CTag ty nm tag arity mxarity -> ppCurlysCommas' [ppNm ty, ppNm nm, pp tag {- , pp arity, pp mxarity -}] + where ppNm n = cfgppHsName x n + +-- intended for parsing +ppCTagExtensive' :: CfgPP x => x -> CTag -> PP_Doc +ppCTagExtensive' x t + = case t of + CTagRec -> ppCurly "Rec" + CTag ty nm tag arity mxarity -> ppCurlysCommas' [ppNm ty, ppNm nm, pp tag, pp arity, pp mxarity] + where ppNm n = cfgppHsName x n + +{-# LINE 132 "src/ehc/Base/CfgPP.chs" #-} +ppCTagsMp :: CfgPP x => x -> CTagsMp -> PP_Doc +ppCTagsMp x + = mkl (mkl (ppCTag' x)) + where mkl pe = ppCurlysSemisBlock . map (\(n,e) -> cfgppHsName x n >-< indent 1 ("=" >#< pe e)) + diff --git a/src/UHC/Light/Compiler/Base/Common.hs b/src/UHC/Light/Compiler/Base/Common.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Common.hs @@ -0,0 +1,835 @@ +module UHC.Light.Compiler.Base.Common +( module UHC.Light.Compiler.Base.HsName +, module UHC.Light.Compiler.Base.Range +, module UHC.Light.Compiler.Base.UID +, module UHC.Util.AssocL +, ppAppTop +, ppCon, ppCmt +, ppSpaced +, ParNeed (..), ParNeedL, parNeedApp +, ppParNeed +, CompilePoint (..) +, Fixity (..) +, fixityMaxPrio +, NmLev, nmLevAbsent, nmLevBuiltin, nmLevOutside, nmLevModule +, tokMkInt, tokMkStr +, tokMkQNames +, hsnLclSupply, hsnLclSupplyWith +, AlwaysEq (..) +, VarId, VarIdS +, whenM, unlessM +, str2stMp, str2stMpWithOmit, showStr2stMp +, unions +, withLkupLiftCyc1, withLkupChkVisitLift, withLkupLift +, lookupLiftCycMb1, lookupLiftCycMb2 +, MetaLev, metaLevVal +, listCombineUniq +, metaLevTy, metaLevKi, metaLevSo +, ppFld, mkPPAppFun, mkPPAppFun' +, mkExtAppPP, mkExtAppPP' +, tokMkQName +, uidHNm +, uidQualHNm +, module UHC.Light.Compiler.Base.Fld +, module UHC.Light.Compiler.CodeGen.Tag +, module UHC.Light.Compiler.Base.Strictness +, ppHsnNonAlpha, ppHsnEscaped, hsnEscapeeChars, ppHsnEscapeWith, hsnOkChars, hsnNotOkStrs +, ppPair +, showPP +, ppFM +, putCompileMsg +, writePP, writeToFile +, CLbl (..), clbl +, Unbox (..) +, replicateBy +, strPadLeft, strBlankPad +, Verbosity (..) +, splitByRadix +, strHex +, Backend (..) +, Presence (..) +, fmap2Tuple +, genNmMap +, MaybeOk (..), isJustOk, isNotOk, maybeOk, fromJustOk, fromNotOk +, KnownPrim (..) +, allKnownPrimMp +, module UHC.Light.Compiler.Base.RLList +, PredOccId (..) +, mkPrId, poiHNm +, mkPrIdCHR +, emptyPredOccId +, ppListV +, snd3, thd +, CHRScoped (..) +, InstVariant (..) +, VarUIDHsName (..), vunmNm +, vunmMbVar +, combineToDistinguishedElts +, LinkingStyle (..) +, fixityAppPrio +, InstDerivingFrom (..) +, SrcConst (..) +, ppAppTop' +, PkgName, emptyPkgName +, graphVisit ) +where +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Range +import UHC.Light.Compiler.Base.UID +import UHC.Util.AssocL +import UHC.Util.Pretty +import Data.List +import Control.Applicative ((<|>)) +import UHC.Util.ScanUtils +import qualified Data.Set as Set +import Control.Monad +import UHC.Util.VarLookup (MetaLev,metaLevVal) +import UHC.Light.Compiler.Scanner.Token +import UHC.Light.Compiler.Scanner.Machine(scanpredIsIdChar,scanpredIsKeywExtra) +import UHC.Util.FPath +import System.IO +import System.Environment +import System.Exit +import Data.Char +import Data.Maybe +import Numeric +import UHC.Light.Compiler.Base.Fld +import UHC.Light.Compiler.CodeGen.Tag +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Strictness +import qualified Control.Monad.State as ST +import UHC.Light.Compiler.Base.RLList +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + + + + +{-# LINE 90 "src/ehc/Base/Common.chs" #-} +ppHsnEscapeWith :: Char -> (Char -> Bool) -> (String -> Bool) -> (HsName -> Bool) -> HsName -> (PP_Doc,Bool) +ppHsnEscapeWith escChar okChars notOkStr leaveAsIs n = flip ST.runState False $ do + let shown = hsnShow' showUIDParseable show (\s -> "{" ++ s ++ "}") "." "``" n + if leaveAsIs n + then return $ pp n + else do cs <- fmap concat $ forM shown esc + isEscaped <- ST.get + return $ pp $ if isEscaped || notOkStr shown then escChar:cs else cs + where esc c | okChars c = return [c] + | otherwise = ST.put True >> return [escChar,c] + +ppHsnEscaped :: Either Char (Set.Set Char) -> Char -> Set.Set Char -> HsName -> PP_Doc +ppHsnEscaped first escChar escapeeChars + = \n -> let (nh:nt) = show n + in pp $ hd ++ chkhd nh ++ (concatMap esc nt) + where (hd,chkhd) = either (\c -> ([c],(:""))) (\chs -> ("",\h -> if Set.member h chs then [escChar,h] else esc h)) first + escapeeChars' = Set.unions [escapeeChars, Set.fromList [escChar]] + hexChars = Set.fromList $ ['\NUL'..' '] ++ "\t\r\n" + esc c | Set.member c escapeeChars' = [escChar,c] + | Set.member c hexChars = [escChar,'x'] ++ pad_out (showHex (ord c) "") + | otherwise = [c] + pad_out ls = (replicate (2 - length ls) '0') ++ ls + +hsnEscapeeChars :: Char -> ScanOpts -> Set.Set Char +hsnEscapeeChars escChar scanOpts + = Set.fromList [escChar] `Set.union` scoSpecChars scanOpts `Set.union` scoOpChars scanOpts + +hsnOkChars :: Char -> ScanOpts -> Char -> Bool +hsnOkChars escChar scanOpts c + = c /= escChar && (scanpredIsIdChar c || scanpredIsKeywExtra scanOpts c) + +hsnNotOkStrs :: ScanOpts -> String -> Bool +hsnNotOkStrs scanOpts s = s `Set.member` scoKeywordsTxt scanOpts + +ppHsnNonAlpha :: ScanOpts -> HsName -> PP_Doc +ppHsnNonAlpha scanOpts + = p + where escapeeChars = hsnEscapeeChars '$' scanOpts + p n = let name = show n + in {- if name `elem` scoKeywordsTxt scanOpts + then pp ('$' : '_' : name) + else -} + let s = foldr (\c r -> if c `Set.member` escapeeChars then '$':c:r else c:r) [] name + in pp ('$':s) + +{-# LINE 141 "src/ehc/Base/Common.chs" #-} +newtype PredOccId + = PredOccId + { poiId :: UID + } + deriving (Show,Eq,Ord) + +{-# LINE 149 "src/ehc/Base/Common.chs" #-} +mkPrId :: UID -> PredOccId +mkPrId u = PredOccId u + +poiHNm :: PredOccId -> HsName +poiHNm = uidHNm . poiId + +{-# LINE 157 "src/ehc/Base/Common.chs" #-} +mkPrIdCHR :: UID -> PredOccId +mkPrIdCHR = mkPrId + +{-# LINE 162 "src/ehc/Base/Common.chs" #-} +emptyPredOccId :: PredOccId +emptyPredOccId = mkPrId uidStart + +{-# LINE 171 "src/ehc/Base/Common.chs" #-} +ppAppTop :: PP arg => (HsName,arg) -> [arg] -> PP_Doc -> PP_Doc +ppAppTop (conNm,con) argL dflt + = if ( hsnIsArrow conNm + || hsnIsPrArrow conNm + ) && length argL == 2 + then ppListSep "" "" (" " >|< con >|< " ") argL + else if hsnIsProd conNm then ppParensCommas argL + else if hsnIsList conNm then ppBracketsCommas argL + else if hsnIsRec conNm then ppListSep (hsnORec >|< con) hsnCRec "," argL + else if hsnIsSum conNm then ppListSep (hsnOSum >|< con) hsnCSum "," argL + else if hsnIsRow conNm then ppListSep (hsnORow >|< con) hsnCRow "," argL + else dflt + +{-# LINE 192 "src/ehc/Base/Common.chs" #-} +ppAppTop' :: PP arg => (HsName,arg) -> [arg] -> [Bool] -> PP_Doc -> PP_Doc +ppAppTop' cc@(conNm,_) [_,a] [True,_] _ | hsnIsArrow conNm || hsnIsPrArrow conNm = pp a +ppAppTop' cc argL _ dflt = ppAppTop cc argL dflt + +{-# LINE 198 "src/ehc/Base/Common.chs" #-} +ppCon :: HsName -> PP_Doc +ppCon nm = if hsnIsProd nm + then ppParens (text (replicate (hsnProdArity nm - 1) ',')) + else pp nm + +ppCmt :: PP_Doc -> PP_Doc +ppCmt p = "{-" >#< p >#< "-}" + +{-# LINE 208 "src/ehc/Base/Common.chs" #-} + +ppSpaced :: PP a => [a] -> PP_Doc +ppSpaced = ppListSep "" "" " " + + +{-# LINE 215 "src/ehc/Base/Common.chs" #-} +ppFld :: String -> Maybe HsName -> HsName -> PP_Doc -> PP_Doc -> PP_Doc +ppFld sep positionalNm nm nmPP f + = case positionalNm of + Just pn | pn == nm -> f + _ -> nmPP >#< sep >#< f + +mkPPAppFun' :: String -> HsName -> PP_Doc -> PP_Doc +mkPPAppFun' sep c p = if c == hsnRowEmpty then empty else p >|< sep + +mkPPAppFun :: HsName -> PP_Doc -> PP_Doc +mkPPAppFun = mkPPAppFun' "|" + +{-# LINE 229 "src/ehc/Base/Common.chs" #-} +mkExtAppPP' :: String -> (HsName,PP_Doc,[PP_Doc]) -> (HsName,PP_Doc,[PP_Doc],PP_Doc) -> (PP_Doc,[PP_Doc]) +mkExtAppPP' sep (funNm,funNmPP,funPPL) (argNm,argNmPP,argPPL,argPP) + = if hsnIsRec funNm || hsnIsSum funNm + then (mkPPAppFun' sep argNm argNmPP,argPPL) + else (funNmPP,funPPL ++ [argPP]) + +mkExtAppPP :: (HsName,PP_Doc,[PP_Doc]) -> (HsName,PP_Doc,[PP_Doc],PP_Doc) -> (PP_Doc,[PP_Doc]) +mkExtAppPP = mkExtAppPP' "|" + +{-# LINE 245 "src/ehc/Base/Common.chs" #-} +ppPair :: (PP a, PP b) => (a,b) -> PP_Doc +ppPair (x,y) = ppParens (pp x >|< "," >|< pp y) + +{-# LINE 250 "src/ehc/Base/Common.chs" #-} +showPP :: PP a => a -> String +showPP x = disp (pp x) 100 "" + +{-# LINE 255 "src/ehc/Base/Common.chs" #-} +ppFM :: (PP k,PP v) => Map.Map k v -> PP_Doc +ppFM = ppAssocL . Map.toList + +{-# LINE 260 "src/ehc/Base/Common.chs" #-} +ppListV :: PP a => [a] -> PP_Doc +ppListV = vlist . map pp + +{-# LINE 269 "src/ehc/Base/Common.chs" #-} +putCompileMsg :: Verbosity -> Verbosity -> String -> Maybe String -> HsName -> FPath -> IO () +putCompileMsg v optsVerbosity msg mbMsg2 modNm fNm + = if optsVerbosity >= v + then do { hPutStrLn stdout (strBlankPad 40 msg ++ " " ++ strBlankPad 22 (show modNm) ++ " (" ++ fpathToStr fNm ++ maybe "" (\m -> ", " ++ m) mbMsg2 ++ ")") + ; hFlush stdout + } + else return () + +{-# LINE 279 "src/ehc/Base/Common.chs" #-} +writePP :: (a -> PP_Doc) -> a -> FPath -> IO () +writePP f text fp = writeToFile (show.f $ text) fp + +writeToFile' :: Bool -> String -> FPath -> IO () +writeToFile' binary str fp + = do { (fn, fh) <- openFPath fp WriteMode binary + ; (if binary then hPutStr else hPutStrLn) fh str + ; hClose fh + } + +writeToFile :: String -> FPath -> IO () +writeToFile = writeToFile' False + + +{-# LINE 304 "src/ehc/Base/Common.chs" #-} +data ParNeed = ParNotNeeded | ParNeededLow | ParNeeded | ParNeededHigh | ParOverrideNeeded + deriving (Eq,Ord) + +type ParNeedL = [ParNeed] + +parNeedApp :: HsName -> (ParNeed,ParNeedL) +parNeedApp conNm + = let pr | hsnIsArrow conNm = (ParNeededLow,[ParNotNeeded,ParNeeded]) + | hsnIsProd conNm = (ParOverrideNeeded,repeat ParNotNeeded) + | hsnIsList conNm = (ParOverrideNeeded,[ParNotNeeded]) + | hsnIsRec conNm = (ParOverrideNeeded,[ParNotNeeded]) + | hsnIsSum conNm = (ParOverrideNeeded,[ParNotNeeded]) + | hsnIsRow conNm = (ParOverrideNeeded,repeat ParNotNeeded) + | otherwise = (ParNeeded,repeat ParNeededHigh) + in pr + +{-# LINE 326 "src/ehc/Base/Common.chs" #-} +ppParNeed :: PP p => ParNeed -> ParNeed -> p -> PP_Doc +ppParNeed locNeed globNeed p + = par (pp p) + where par = if globNeed > locNeed then ppParens else id + +{-# LINE 352 "src/ehc/Base/Common.chs" #-} +-- | Expressions in a CBound position optionally may be labelled +data CLbl + = CLbl_None + | CLbl_Nm + { clblNm :: !HsName + } + | CLbl_Tag + { clblTag :: !CTag + } + deriving (Show,Eq,Ord) + +clbl :: a -> (HsName -> a) -> (CTag -> a) -> CLbl -> a +clbl f _ _ CLbl_None = f +clbl _ f _ (CLbl_Nm n) = f n +clbl _ _ f (CLbl_Tag t) = f t + +{-# LINE 370 "src/ehc/Base/Common.chs" #-} +instance PP CLbl where + pp = clbl empty pp pp + +{-# LINE 379 "src/ehc/Base/Common.chs" #-} +data Unbox + = Unbox_FirstField + | Unbox_Tag !Int + | Unbox_None + +{-# LINE 390 "src/ehc/Base/Common.chs" #-} +unions :: Eq a => [[a]] -> [a] +unions = foldr union [] + +{-# LINE 395 "src/ehc/Base/Common.chs" #-} +listCombineUniq :: Eq a => [[a]] -> [a] +listCombineUniq = nub . concat + +{-# LINE 415 "src/ehc/Base/Common.chs" #-} +replicateBy :: [a] -> b -> [b] +replicateBy l e = replicate (length l) e + +{-# LINE 424 "src/ehc/Base/Common.chs" #-} +strPadLeft :: Char -> Int -> String -> String +strPadLeft c n s = replicate (n - length s) c ++ s + +strBlankPad :: Int -> String -> String +strBlankPad n s = s ++ replicate (n - length s) ' ' + +{-# LINE 432 "src/ehc/Base/Common.chs" #-} +snd3 :: (a,b,c) -> b +snd3 (a,b,c) = b + +thd :: (a,b,c) -> c +thd (a,b,c) = c + +{-# LINE 444 "src/ehc/Base/Common.chs" #-} +data Verbosity + = VerboseQuiet | VerboseMinimal | VerboseNormal | VerboseALot | VerboseDebug + deriving (Eq,Ord,Enum) + +{-# LINE 454 "src/ehc/Base/Common.chs" #-} +data CHRScoped + = CHRScopedInstOnly | CHRScopedMutualSuper | CHRScopedAll + deriving (Eq,Ord) + +{-# LINE 464 "src/ehc/Base/Common.chs" #-} +data CompilePoint + = CompilePoint_Imports + | CompilePoint_Parse + | CompilePoint_AnalHS + | CompilePoint_AnalEH + | CompilePoint_Core + | CompilePoint_All + deriving (Eq,Ord,Show) + +{-# LINE 481 "src/ehc/Base/Common.chs" #-} +data Fixity + = Fixity_Infix | Fixity_Infixr | Fixity_Infixl + deriving (Eq,Ord,Show,Enum) + +instance PP Fixity where + pp Fixity_Infix = pp "infix" + pp Fixity_Infixl = pp "infixl" + pp Fixity_Infixr = pp "infixr" + +{-# LINE 492 "src/ehc/Base/Common.chs" #-} +fixityMaxPrio :: Int +fixityMaxPrio = 9 + +{-# LINE 497 "src/ehc/Base/Common.chs" #-} +fixityAppPrio :: Int +fixityAppPrio = fixityMaxPrio + 1 + +{-# LINE 506 "src/ehc/Base/Common.chs" #-} +data InstVariant + = InstNormal | InstDefault + | InstDeriving InstDerivingFrom + deriving (Eq,Ord,Show) + +{-# LINE 515 "src/ehc/Base/Common.chs" #-} +-- | Either a deriving combined from a datatype directly or a standalone +data InstDerivingFrom + = InstDerivingFrom_Datatype + | InstDerivingFrom_Standalone + deriving (Eq,Ord,Show) + +{-# LINE 527 "src/ehc/Base/Common.chs" #-} +type NmLev = Int + +nmLevAbsent, nmLevBuiltin, nmLevOutside, nmLevModule :: NmLev +nmLevAbsent = -3 +nmLevBuiltin = -2 +nmLevOutside = -1 +nmLevModule = 0 + + +{-# LINE 548 "src/ehc/Base/Common.chs" #-} +-- Assumption: tokTpIsInt (genTokTp t) == True +tokMkInt :: Token -> Int +tokMkInt t + = case genTokTp t of + Just TkInteger10 -> read v + _ -> 0 + where v = tokenVal t + +tokMkStr :: Token -> String +tokMkStr = tokenVal + +{-# LINE 566 "src/ehc/Base/Common.chs" #-} +tokMkQName :: Token -> HsName +tokMkQName t + = case genTokTp t of + Just tp | tokTpIsInt tp -> mkHNmPos $ tokMkInt t + _ -> mkHNm $ map hsnFromString $ tokenVals t + +{-# LINE 576 "src/ehc/Base/Common.chs" #-} +tokMkQNames :: [Token] -> [HsName] +tokMkQNames = map tokMkQName + +instance HSNM Token where + mkHNm = tokMkQName + +{-# LINE 588 "src/ehc/Base/Common.chs" #-} +hsnLclSupplyWith :: HsName -> [HsName] +hsnLclSupplyWith n = map (\i -> hsnSuffix n $ "_" ++ show i) [1..] + +hsnLclSupply :: [HsName] +hsnLclSupply = hsnLclSupplyWith (hsnFromString "") + +{-# LINE 600 "src/ehc/Base/Common.chs" #-} +splitByRadix :: (Integral b) => Int -> Int -> b -> (Int,[Int]) +splitByRadix len radix num + = ( fromIntegral $ signum num + , replicate difflen 0 ++ drop (-difflen) repr + ) + where radix' = fromIntegral radix + repr = reverse $ + unfoldr + (\b -> if b == 0 + then Nothing + else let (q,r) = b `divMod` radix' + in Just (fromIntegral r, q)) + (abs num) + difflen = len - length repr + +{-# LINE 617 "src/ehc/Base/Common.chs" #-} +strHex :: (Show a, Integral a) => Int -> a -> String +strHex prec x + = replicate (prec - length h) '0' ++ h + where h = showHex x [] + +{-# LINE 628 "src/ehc/Base/Common.chs" #-} +data Backend + = BackendGrinByteCode + | BackendSilly + deriving (Eq, Ord) + +{-# LINE 639 "src/ehc/Base/Common.chs" #-} +data VarUIDHsName + = VarUIDHs_Name { vunmId :: !UID, vunmNm' :: !HsName } + | VarUIDHs_UID { vunmId :: !UID } + | VarUIDHs_Var !UID + deriving (Eq, Ord) + +vunmNm :: VarUIDHsName -> HsName +vunmNm (VarUIDHs_Name _ n) = n +vunmNm (VarUIDHs_UID i ) = mkHNm i +vunmNm _ = panic "Common.assnmNm" + +{-# LINE 652 "src/ehc/Base/Common.chs" #-} +vunmMbVar :: VarUIDHsName -> Maybe UID +vunmMbVar (VarUIDHs_Var v) = Just v +vunmMbVar _ = Nothing + +{-# LINE 658 "src/ehc/Base/Common.chs" #-} +instance Show VarUIDHsName where + show (VarUIDHs_Name _ n) = show n + show (VarUIDHs_UID i ) = show i + show (VarUIDHs_Var i ) = show i + +instance PP VarUIDHsName where + pp a = pp $ show a + +{-# LINE 672 "src/ehc/Base/Common.chs" #-} +withLkupLiftCyc2 :: (t -> Maybe UID) -> (t -> UIDS) -> (UID -> Maybe t) -> x -> (UIDS -> t -> x) -> (t -> x) -> UIDS -> UID -> x +withLkupLiftCyc2 get noVisit lookup dflt yes no vsVisited v + = case lookup v of + Just t | not (v `Set.member` vsVisited) + -> yes (Set.insert v $ Set.union (noVisit t) vsVisited) t + _ -> dflt + +{-# LINE 681 "src/ehc/Base/Common.chs" #-} +withLkupLiftCyc1 :: (t -> Maybe UID) -> (t -> UIDS) -> (UID -> Maybe t) -> (UIDS -> t -> x) -> (t -> x) -> UIDS -> t -> x +withLkupLiftCyc1 get noVisit lookup yes no vsVisited t + = maybe dflt (withLkupLiftCyc2 get noVisit lookup dflt yes no vsVisited) $ get t + where dflt = no t + +withLkupChkVisitLift :: (t -> Maybe UID) -> (t -> UIDS) -> (UID -> Maybe t) -> (t -> x) -> (t -> x) -> t -> x +withLkupChkVisitLift get noVisit lookup yes no t + = withLkupLiftCyc1 get noVisit lookup (\_ t -> yes t) no Set.empty t + +withLkupLift :: (t -> Maybe UID) -> (UID -> Maybe t) -> (t -> x) -> (t -> x) -> t -> x +withLkupLift get + = withLkupChkVisitLift get (const Set.empty) + +{-# LINE 696 "src/ehc/Base/Common.chs" #-} +lookupLiftCyc1 :: (x -> Maybe UID) -> (UID -> Maybe x) -> x' -> (x->x') -> x -> x' +lookupLiftCyc1 get lookup dflt found x + = lk Set.empty dflt found x + where lk s dflt found x = withLkupLiftCyc1 get (const Set.empty) lookup (\s t -> lk s (found t) found t) (const dflt) s x + +lookupLiftCyc2 :: (x -> Maybe UID) -> (UID -> Maybe x) -> x' -> (x->x') -> UID -> x' +lookupLiftCyc2 get lookup dflt found x + = maybe dflt (\x -> lookupLiftCyc1 get lookup (found x) found x) $ lookup x + +{-# LINE 707 "src/ehc/Base/Common.chs" #-} +lookupLiftCycMb1 :: (x -> Maybe UID) -> (UID -> Maybe x) -> x -> Maybe x +lookupLiftCycMb1 get lookup x = lookupLiftCyc1 get lookup Nothing Just x + +lookupLiftCycMb2 :: (x -> Maybe UID) -> (UID -> Maybe x) -> UID -> Maybe x +lookupLiftCycMb2 get lookup x = lookupLiftCyc2 get lookup Nothing Just x + +{-# LINE 719 "src/ehc/Base/Common.chs" #-} +data Presence = Present | Absent deriving (Eq,Ord,Show) + +{-# LINE 727 "src/ehc/Base/Common.chs" #-} +-- | Combine [[x1..xn],..,[y1..ym]] to [[x1..y1],[x2..y1],..,[xn..ym]]. +-- Each element [xi..yi] is distinct based on the the key k in xi==(k,_) +combineToDistinguishedElts :: Eq k => [AssocL k v] -> [AssocL k v] +combineToDistinguishedElts [] = [] +combineToDistinguishedElts [[]] = [] +combineToDistinguishedElts [x] = map (:[]) x +combineToDistinguishedElts (l:ls) + = combine l $ combineToDistinguishedElts ls + where combine l ls + = concatMap (\e@(k,_) + -> mapMaybe (\ll -> maybe (Just (e:ll)) (const Nothing) $ lookup k ll) + ls + ) l + +{-# LINE 750 "src/ehc/Base/Common.chs" #-} +data AlwaysEq a = AlwaysEq a + +instance Eq (AlwaysEq a) where + _ == _ = True + +instance Ord (AlwaysEq a) where + _ `compare` _ = EQ + +instance Show a => Show (AlwaysEq a) where + show (AlwaysEq x) = show x + +instance PP a => PP (AlwaysEq a) where + pp (AlwaysEq x) = pp x + +{-# LINE 770 "src/ehc/Base/Common.chs" #-} +type PkgName = String + +emptyPkgName = "" + +{-# LINE 780 "src/ehc/Base/Common.chs" #-} +-- | How to do linking/packaging +data LinkingStyle + = LinkingStyle_None -- ^ no linking (e.g. indicated by --compile-only flag) + | LinkingStyle_Exec -- ^ executable linking + | LinkingStyle_Pkg -- ^ package linking + deriving (Eq,Ord,Enum,Bounded) + + +{-# LINE 820 "src/ehc/Base/Common.chs" #-} +metaLevTy, metaLevKi, metaLevSo :: MetaLev +metaLevTy = metaLevVal + 1 +metaLevKi = metaLevTy + 1 +metaLevSo = metaLevKi + 1 + +{-# LINE 831 "src/ehc/Base/Common.chs" #-} +-- | Use as variable id +type VarId = UID +type VarIdS = Set.Set UID + +{-# LINE 841 "src/ehc/Base/Common.chs" #-} +uidHNm :: UID -> HsName +uidHNm = mkHNm -- hsnFromString . show + +{-# LINE 846 "src/ehc/Base/Common.chs" #-} +uidQualHNm :: HsName -> UID -> HsName +uidQualHNm modnm uid = + hsnPrefixQual modnm $ + uidHNm uid + + +{-# LINE 864 "src/ehc/Base/Common.chs" #-} +data SrcConst + = SrcConst_Int Integer + | SrcConst_Char Char + | SrcConst_Ratio Integer Integer + deriving (Eq,Show,Ord) + +{-# LINE 876 "src/ehc/Base/Common.chs" #-} +fmap2Tuple :: Functor f => snd -> f x -> f (x,snd) +fmap2Tuple snd = fmap (\x -> (x,snd)) + +{-# LINE 885 "src/ehc/Base/Common.chs" #-} +-- | Variation of `when` where Boolean condition is computed in a monad +whenM :: Monad m => m Bool -> m () -> m () +whenM c m = do + c' <- c + when c' m +{-# INLINE whenM #-} + +-- | Variation of `unless` where Boolean condition is computed in a monad +unlessM :: Monad m => m Bool -> m () -> m () +unlessM c m = do + c' <- c + unless c' m +{-# INLINE unlessM #-} + +{-# LINE 905 "src/ehc/Base/Common.chs" #-} +genNmMap :: Ord x => (String->s) -> [x] -> Map.Map x s -> (Map.Map x s, [s]) +genNmMap mk xs m + = (m',reverse ns) + where (m',_,ns) + = foldl (\(m,sz,ns) x + -> case Map.lookup x m of + Just n -> (m, sz, n:ns) + _ -> (Map.insert x n m, sz+1, n:ns) + where n = mk $ ch sz + ) + (m,Map.size m,[]) xs + ch x | x < 26 = [chr $ ord 'a' + x] + | otherwise = let (q,r) = x `quotRem` 26 in ch q ++ ch r + +{-# LINE 925 "src/ehc/Base/Common.chs" #-} +data MaybeOk a + = JustOk a + | NotOk String + deriving (Eq,Ord,Show) + +isJustOk (JustOk _) = True +isJustOk _ = False + +fromJustOk (JustOk x) = x +fromJustOk _ = panic "fromJustOk" + +isNotOk (NotOk _) = True +isNotOk _ = False + +fromNotOk (NotOk x) = x +fromNotOk _ = panic "fromNotOk" + +maybeOk :: (String -> x) -> (a -> x) -> MaybeOk a -> x +maybeOk _ j (JustOk x) = j x +maybeOk n _ (NotOk x) = n x + +{-# LINE 952 "src/ehc/Base/Common.chs" #-} +-- | Abstract graph visit, over arbitrary structures +graphVisit + :: (Ord node) + => (thr -> graph -> node -> (thr,Set.Set node)) -- fun: visit node, get new thr and nodes to visit next + -> (Set.Set node -> Set.Set node -> Set.Set node) -- fun: combine new to visit + already known to visit (respectively) + -> thr -- the accumulator, threaded as state + -> Set.Set node -- root/start + -> graph -- graph over which we visit + -> thr -- accumulator is what we are interested in +graphVisit visit unionUnvisited thr start graph + = snd $ v ((Set.empty,start),thr) + where v st@((visited,unvisited),thr) + | Set.null unvisited = st + | otherwise = let (n,unvisited2) = Set.deleteFindMin unvisited + (thr',newUnvisited) = visit thr graph n + visited' = Set.insert n visited + unvisited3 = unionUnvisited (newUnvisited `Set.difference` visited') unvisited2 + in v ((visited',unvisited3),thr') + +{-# LINE 977 "src/ehc/Base/Common.chs" #-} +data KnownPrim + = + -- platform Int + KnownPrim_AddI + | KnownPrim_SubI + | KnownPrim_MulI + + -- platform Float + | KnownPrim_AddF + | KnownPrim_SubF + | KnownPrim_MulF + + -- platform Double + | KnownPrim_AddD + | KnownPrim_SubD + | KnownPrim_MulD + + -- 8 bit + | KnownPrim_Add8 -- add: 1 byte / 8 bit, etc etc + | KnownPrim_Sub8 + | KnownPrim_Mul8 + + -- 16 bit + | KnownPrim_Add16 + | KnownPrim_Sub16 + | KnownPrim_Mul16 + + -- 32 bit + | KnownPrim_Add32 + | KnownPrim_Sub32 + | KnownPrim_Mul32 + + -- 64 bit + | KnownPrim_Add64 + | KnownPrim_Sub64 + | KnownPrim_Mul64 + deriving (Show,Eq,Enum,Bounded) + +{-# LINE 1023 "src/ehc/Base/Common.chs" #-} +instance PP KnownPrim where + pp = pp . show + +{-# LINE 1028 "src/ehc/Base/Common.chs" #-} +allKnownPrimMp :: Map.Map String KnownPrim +allKnownPrimMp + = Map.fromList [ (drop prefixLen $ show t, t) | t <- [ minBound .. maxBound ] ] + where prefixLen = length "KnownPrim_" + +{-# LINE 1043 "src/ehc/Base/Common.chs" #-} +str2stMpWithOmit :: (Show opt, Enum opt, Bounded opt, Eq opt) => [opt] -> Map.Map String opt +str2stMpWithOmit omits = Map.fromList [ (show o, o) | o <- [minBound .. maxBound] \\ omits ] + +str2stMp :: (Show opt, Enum opt, Bounded opt, Eq opt) => Map.Map String opt +str2stMp = str2stMpWithOmit [] + +showStr2stMp :: Map.Map String opt -> String +showStr2stMp = concat . intersperse " " . Map.keys + +{-# LINE 1058 "src/ehc/Base/Common.chs" #-} +deriving instance Data KnownPrim +deriving instance Typeable KnownPrim + +{-# LINE 1063 "src/ehc/Base/Common.chs" #-} +deriving instance Typeable VarUIDHsName +deriving instance Data VarUIDHsName + +deriving instance Typeable TagDataInfo +deriving instance Data TagDataInfo + +deriving instance Typeable Fixity +deriving instance Data Fixity + +deriving instance Typeable1 AlwaysEq +deriving instance Data x => Data (AlwaysEq x) + +deriving instance Typeable PredOccId +deriving instance Data PredOccId + +deriving instance Typeable CLbl +deriving instance Data CLbl + + +{-# LINE 1088 "src/ehc/Base/Common.chs" #-} +instance Binary KnownPrim where + put = putEnum8 + get = getEnum8 + +instance Serialize KnownPrim where + sput = sputPlain + sget = sgetPlain + +instance Serialize TagDataInfo where + sput (TagDataInfo a b) = sput a >> sput b + sget = liftM2 TagDataInfo sget sget + +instance Serialize VarUIDHsName where + sput (VarUIDHs_Name a b) = sputWord8 0 >> sput a >> sput b + sput (VarUIDHs_UID a ) = sputWord8 1 >> sput a + sput (VarUIDHs_Var a ) = sputWord8 2 >> sput a + sget = do t <- sgetWord8 + case t of + 0 -> liftM2 VarUIDHs_Name sget sget + 1 -> liftM VarUIDHs_UID sget + 2 -> liftM VarUIDHs_Var sget + +instance Serialize CLbl where + sput (CLbl_Nm a ) = sputWord8 0 >> sput a + sput (CLbl_Tag a ) = sputWord8 1 >> sput a + sput (CLbl_None ) = sputWord8 2 + sget = do t <- sgetWord8 + case t of + 0 -> liftM CLbl_Nm sget + 1 -> liftM CLbl_Tag sget + 2 -> return CLbl_None + +instance Binary Fixity where + put = putEnum8 + get = getEnum8 + +instance Serialize Fixity where + sput = sputPlain + sget = sgetPlain + +instance Binary x => Binary (AlwaysEq x) where + put (AlwaysEq x) = put x + get = liftM AlwaysEq get + +instance Serialize x => Serialize (AlwaysEq x) where + sput (AlwaysEq x) = sput x + sget = liftM AlwaysEq sget + +instance Binary PredOccId where + put (PredOccId a) = put a + get = liftM PredOccId get + +instance Serialize PredOccId where + sput = sputPlain + sget = sgetPlain + + diff --git a/src/UHC/Light/Compiler/Base/Debug.hs b/src/UHC/Light/Compiler/Base/Debug.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Debug.hs @@ -0,0 +1,18 @@ +module UHC.Light.Compiler.Base.Debug +( tr, trm, trPP ) +where +import Debug.Trace +import UHC.Util.Pretty + +{-# LINE 18 "src/ehc/Base/Debug.chs" #-} +showPP :: PP a => a -> String +showPP p = disp (pp p) 1000 "" + +trm :: String -> (a -> PP_Doc) -> a -> a +trm msg pp x = trace msg (trace (showPP (msg >|< ":" >|< pp x)) x) + +tr :: String -> PP_Doc -> a -> a +tr msg p x = trm msg (const p) x + +trPP :: PP a => String -> a -> a +trPP msg x = trace msg (trace (showPP (msg >|< ":" >|< x)) x) diff --git a/src/UHC/Light/Compiler/Base/FileSearchLocation.hs b/src/UHC/Light/Compiler/Base/FileSearchLocation.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/FileSearchLocation.hs @@ -0,0 +1,154 @@ +module UHC.Light.Compiler.Base.FileSearchLocation +( mkDirFileLoc +, StringPath, FileLocPath +, FileLocKind (..) +, FileLoc (..), emptyFileLoc, fileLocPkgDb +, mkPkgFileLoc +, filelocIsPkg +, FileSearchLoc +, PkgKey, PkgKey1, PkgKey2 +, showPkgKey +, PackageSearchFilter (..) +, pkgSearchFilter +, PackageCfgKeyVals, PackageInfo (..), PackageMp, Module2PackageMp, PackageDatabase (..), emptyPackageMp, emptyPackageDatabase +, mkInternalPkgFileBase ) +where +import UHC.Light.Compiler.Base.Common +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import Data.Version +import Data.List +import UU.Parsing +import UHC.Util.ParseUtils +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.Target +import qualified UHC.Light.Compiler.ConfigInstall as Cfg + + + + +{-# LINE 38 "src/ehc/Base/FileSearchLocation.chs" #-} +data FileLocKind + = FileLocKind_Dir -- plain directory + | FileLocKind_Pkg PkgKey -- specific package + String -- with the dir inside package it was found + | FileLocKind_PkgDb -- yet unknown package in the package database + deriving Eq + +instance Show FileLocKind where + show FileLocKind_Dir = "directory" + show (FileLocKind_Pkg p d) = "package: " ++ showPkgKey p ++ "(in: " ++ d ++ ")" + show FileLocKind_PkgDb = "package database" + +{-# LINE 66 "src/ehc/Base/FileSearchLocation.chs" #-} +data FileLoc + = FileLoc + { filelocKind :: FileLocKind + , filelocDir :: String + } + deriving Eq + +instance Show FileLoc where + show (FileLoc k d) = d ++ " (" ++ show k ++ ")" + +emptyFileLoc :: FileLoc +emptyFileLoc = FileLoc FileLocKind_Dir "" + +fileLocPkgDb :: FileLoc +fileLocPkgDb = FileLoc FileLocKind_PkgDb "" + +{-# LINE 84 "src/ehc/Base/FileSearchLocation.chs" #-} +mkDirFileLoc + = FileLoc FileLocKind_Dir + +{-# LINE 93 "src/ehc/Base/FileSearchLocation.chs" #-} +mkPkgFileLoc :: PkgKey -> String -> FileLoc +mkPkgFileLoc p d = FileLoc (FileLocKind_Pkg p d) d + +{-# LINE 98 "src/ehc/Base/FileSearchLocation.chs" #-} +filelocIsPkg :: FileLoc -> Bool +filelocIsPkg (FileLoc (FileLocKind_Pkg _ _) _) = True +filelocIsPkg (FileLoc FileLocKind_PkgDb _) = True +filelocIsPkg _ = False + +{-# LINE 105 "src/ehc/Base/FileSearchLocation.chs" #-} +type StringPath = [String] +type FileLocPath = [FileLoc] + +{-# LINE 114 "src/ehc/Base/FileSearchLocation.chs" #-} +type FileSearchLoc = FileLoc + +{-# LINE 122 "src/ehc/Base/FileSearchLocation.chs" #-} +type PkgKey1 = PkgName +type PkgKey2 = Maybe Version +type PkgKey = (PkgKey1,PkgKey2) + +instance HSNM PkgKey where + mkHNm (n,Just v) = mkHNmBase (n ++ "-" ++ (concat $ intersperse "." $ map show $ versionBranch v)) + mkHNm (n,_ ) = mkHNm n + +{-# LINE 136 "src/ehc/Base/FileSearchLocation.chs" #-} +showPkgKey :: PkgKey -> String +showPkgKey = show . mkHNm + +{-# LINE 145 "src/ehc/Base/FileSearchLocation.chs" #-} +-- | Description of hiding/exposing pkgs, determining the used packages for looking up modules. +data PackageSearchFilter + -- Note: the below order is important, it is used for sorting just before having its effect on searchable packages. + -- The current order means that in its filtering hiding is done first, thereby starting out with all available pkgs, then hide (all), then expose selectively + = PackageSearchFilter_HideAll + | PackageSearchFilter_HidePkg [PkgKey] + | PackageSearchFilter_ExposePkg [PkgKey] + deriving (Show, Eq, Ord) + +{-# LINE 156 "src/ehc/Base/FileSearchLocation.chs" #-} +pkgSearchFilter :: (x -> Maybe PkgKey) -> ([PkgKey] -> PackageSearchFilter) -> [x] -> [PackageSearchFilter] +pkgSearchFilter mkKey mk ss + = if null ps then [] else [mk ps] + where ps = catMaybes $ map mkKey ss + +{-# LINE 167 "src/ehc/Base/FileSearchLocation.chs" #-} +type PackageCfgKeyVals = Map.Map String String + +-- | Per package info +data PackageInfo + = PackageInfo + { pkginfoLoc :: !FileLoc -- ^ directory location + , pkginfoOrder :: !Int -- ^ for multiple packages the relative order + -- , pkginfoKeyVals :: PackageCfgKeyVals -- key/value pairs of pkg config info + , pkginfoExposedModules :: !HsNameS -- ^ exposed modules + , pkginfoBuildDepends :: !(Set.Set PkgKey) -- ^ pkgs dependend on + , pkginfoIsExposed :: !Bool -- ^ pkg is exposed? + } + deriving Show + +-- | content of a package (keys are name, then version) +type PackageMp = Map.Map PkgKey1 (Map.Map PkgKey2 [PackageInfo]) + +emptyPackageMp :: PackageMp +emptyPackageMp = Map.empty + +-- | reverse map from module name to package key +type Module2PackageMp = Map.Map HsName [PkgKey] + +-- | A package database contains an actual package map, plus a function +-- that maps modules to associated package maps. The latter is computed +-- by "freezing" the package database using "pkgDbFreeze". +data PackageDatabase + = PackageDatabase + { pkgDbPkgMp :: PackageMp + , pkgDbMod2PkgMp :: Module2PackageMp + } + deriving Show + +emptyPackageDatabase :: PackageDatabase +emptyPackageDatabase = PackageDatabase emptyPackageMp Map.empty + +{-# LINE 209 "src/ehc/Base/FileSearchLocation.chs" #-} + +mkInternalPkgFileBase :: PkgKey -> String {- compiler name/version -} -> Target -> TargetFlavor -> FilePath +mkInternalPkgFileBase pkgKey compversion tgt tgtv = + Cfg.mkInternalPkgFileBase (showPkgKey pkgKey) compversion (show tgt) (show tgtv) + diff --git a/src/UHC/Light/Compiler/Base/Fld.hs b/src/UHC/Light/Compiler/Base/Fld.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Fld.hs @@ -0,0 +1,111 @@ +module UHC.Light.Compiler.Base.Fld +( Fld' (..), Fld, noFld +, mkFldNm, mkFldInx +, fldFoldNmInx, fldFoldInxNm +, fldInt, fldNm +, fldMapNm +, RefOfFld (..) ) +where +import Control.Monad +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 30 "src/ehc/Base/Fld.chs" #-} +-- | Field (combined dereference + field access), doubly represented by index and name +data Fld' inx + = Fld + { _fldNm :: !(Maybe HsName) + , _fldInx :: !(Maybe inx) + } + +type Fld = Fld' Int + +noFld :: Fld +noFld = Fld (Just hsnUnknown) (Just 0) + +{-# LINE 44 "src/ehc/Base/Fld.chs" #-} +-- | Make a Fld holding only a name +mkFldNm :: HsName -> Fld' inx +mkFldNm n = Fld (Just n) Nothing +{-# INLINE mkFldNm #-} + +-- | Make a Fld holding only an inx +mkFldInx :: inx -> Fld' inx +mkFldInx i = Fld Nothing (Just i) +{-# INLINE mkFldInx #-} + +{-# LINE 56 "src/ehc/Base/Fld.chs" #-} +instance Eq inx => Eq (Fld' inx) where + (Fld {_fldInx=Just i1}) == (Fld {_fldInx=Just i2}) = i1 == i2 + (Fld {_fldNm = n1}) == (Fld {_fldNm = n2}) = n1 == n2 + +instance Ord inx => Ord (Fld' inx) where + (Fld {_fldInx=Just i1}) `compare` (Fld {_fldInx=Just i2}) = i1 `compare` i2 + (Fld {_fldNm = n1}) `compare` (Fld {_fldNm = n2}) = n1 `compare` n2 + +instance Show inx => Show (Fld' inx) where + -- show f = maybe (maybe "??Fld" show $ _fldNm f) show $ _fldInx f + show (Fld {_fldNm=Just n , _fldInx=Just i }) = show n ++ "(" ++ show i ++ ")" + show (Fld {_fldNm=Nothing, _fldInx=Just i }) = show i + show (Fld {_fldNm=Just n , _fldInx=Nothing}) = show n + show _ = "??Fld" + +instance Show inx => PP (Fld' inx) where + pp = pp . show + +instance HSNM inx => HSNM (Fld' inx) where + mkHNm = fldNm + +{-# LINE 79 "src/ehc/Base/Fld.chs" #-} +-- | Fold over Fld, preference to name +fldFoldNmInx :: (HsName -> x) -> (inx -> x) -> x -> Fld' inx -> x +fldFoldNmInx n i dflt f = maybe (maybe dflt i $ _fldInx f) n $ _fldNm f + +-- | Fold over Fld, preference to inx +fldFoldInxNm :: (HsName -> x) -> (inx -> x) -> x -> Fld' inx -> x +fldFoldInxNm n i dflt f = maybe (maybe dflt n $ _fldNm f) i $ _fldInx f + +{-# LINE 89 "src/ehc/Base/Fld.chs" #-} +-- | Fld access preferred by name +fldNm :: HSNM inx => Fld' inx -> HsName +fldNm = fldFoldNmInx id mkHNm hsnUnknown -- maybe (maybe hsnUnknown mkHNm $ _fldInx f) id $ _fldNm f +{-# INLINE fldNm #-} + +-- | Fld access preferred by index +fldInt :: Fld -> Int +fldInt = fldFoldInxNm (const 0) id 0 -- maybe 0 id $ _fldInx f +{-# INLINE fldInt #-} + +{-# LINE 101 "src/ehc/Base/Fld.chs" #-} +-- | +fldMapNm :: (HsName -> HsName) -> Fld' inx -> Fld' inx +fldMapNm f fld = fld {_fldNm = fmap f $ _fldNm fld} + +{-# LINE 107 "src/ehc/Base/Fld.chs" #-} +class RefOfFld fld a where + refOfFld :: fld -> a + +instance RefOfFld (Fld' inx) (Fld' inx) where + refOfFld = id + +instance RefOfFld Fld Int where + refOfFld = fldInt + +instance HSNM inx => RefOfFld (Fld' inx) HsName where + refOfFld = fldNm + + +{-# LINE 126 "src/ehc/Base/Fld.chs" #-} +deriving instance Typeable1 Fld' +deriving instance Data x => Data (Fld' x) + +{-# LINE 135 "src/ehc/Base/Fld.chs" #-} +instance Serialize x => Serialize (Fld' x) where + sput (Fld a b) = sput a >> sput b + sget = liftM2 Fld sget sget + diff --git a/src/UHC/Light/Compiler/Base/HsName.hs b/src/UHC/Light/Compiler/Base/HsName.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/HsName.hs @@ -0,0 +1,826 @@ +module UHC.Light.Compiler.Base.HsName +( HSNM (..) +, HsName +, hsnEmpty +, mkHNmBase +, hsnEnsureIsBase +, hsnBaseUnpack', hsnBaseUnpack +, hsnMbBaseString, hsnIsBaseString, hsnBaseString +, hsnFromString +, hsnInitLast +, hsnPrefix, hsnSuffix, mkHNmPrefix +, IdOccKind (..) +, IdOcc (..) +, hsnUnknown +, HsNameS +, HsNameUniqifier (..) +, HsNameUnique (..) +, HsNameUniqifierMp +, hsnUniqify, hsnUniqifyUID, hsnUniqifyStr, hsnUniqifyInt, hsnUniqifyEval +, hsnMbPos, hsnIsPos +, hsnMkModf +, mkHNmPos +, cmpHsNameOnNm +, hsnShow, hsnShow' +, rowLabCmp +, OrigName (..) +, hsnStripUniqify +, hsnSimplifications +, hsnMbNr, hsnIsNr +, hsnMkNr +, hsnShowAlphanumeric, hsnShowAlphanumericShort +, hsnSplitQualify, hsnQualified, hsnPrefixQual, hsnMapQualified +, hsnQualifier, hsnSetQual, hsnIsQual +, hsnFixUniqifiers +, hsnStripUniqifiers +, hsnSafeJavaLike +, FvS, FvSMp +, HsNameMp, hsnRepl +, RPatNm (..) +, rpatNmIsOrig +, Track (..) +, hsnConcat +, hsnMapQual, hsnSetLevQual +, hsnQualUniqify ) +where +import UHC.Util.Utils +import UHC.Util.Pretty +import Data.List +import UHC.Light.Compiler.Base.UID +import UU.Scanner.Position +import qualified Data.Set as Set +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import Data.Char +import Numeric +import UHC.Util.FPath +import Data.Char +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Hashable + + + + + + + + + +{-# LINE 57 "src/ehc/Base/HsName.chs" #-} +-- | A HsNameUniqifier represents the 'type' of unification +data HsNameUniqifier + = HsNameUniqifier_Blank -- just a new identifier, with an empty show + | HsNameUniqifier_New -- just a new identifier + | HsNameUniqifier_Error -- error + | HsNameUniqifier_GloballyUnique -- globally unique + | HsNameUniqifier_Evaluated -- evaluated + | HsNameUniqifier_Field -- extracted field + | HsNameUniqifier_Class -- class + | HsNameUniqifier_ClassDict -- dictionary + | HsNameUniqifier_SelfDict -- dictionary under construction itself, passed as arg in tying the knot recursion + | HsNameUniqifier_ResultDict -- dictionary under construction result + | HsNameUniqifier_SuperClass -- super class field + | HsNameUniqifier_DictField -- dictionary field + | HsNameUniqifier_Inline -- new identifier because of inlining + | HsNameUniqifier_GloballyUniqueDict -- globally unique dictionary + | HsNameUniqifier_FieldOffset -- offset for a field + | HsNameUniqifier_CaseContinuation -- continuation of a case expression + | HsNameUniqifier_GrinUpdated -- Grin: updated value + | HsNameUniqifier_FFIArg -- arg evaluated for FFI + | HsNameUniqifier_LacksLabel -- label used in lacking predicates + | HsNameUniqifier_BindAspect -- binding aspect + | HsNameUniqifier_Strict -- strict variant of binding + | HsNameUniqifier_GenericClass -- a name introduced by generics + | HsNameUniqifier_FFE -- name of value to be ff exported + | HsNameUniqifier_FFECoerced -- name of possibly coerced value to be ff exported + deriving (Eq,Ord,Enum) + +-- | The show of a HsNameUniqifier is found back in the pretty printed code, current convention is 3 uppercase letters, as a balance between size and clarity of meaning +instance Show HsNameUniqifier where + show HsNameUniqifier_Blank = "" + show HsNameUniqifier_New = "NEW" + show HsNameUniqifier_Error = "ERR" + show HsNameUniqifier_GloballyUnique = "UNQ" + show HsNameUniqifier_Evaluated = "EVL" + show HsNameUniqifier_Field = "FLD" + show HsNameUniqifier_Class = "CLS" + show HsNameUniqifier_ClassDict = "DCT" + show HsNameUniqifier_SelfDict = "SDC" + show HsNameUniqifier_ResultDict = "RDC" + show HsNameUniqifier_SuperClass = "SUP" + show HsNameUniqifier_DictField = "DFL" + show HsNameUniqifier_Inline = "INL" + show HsNameUniqifier_GloballyUniqueDict = "UND" + show HsNameUniqifier_FieldOffset = "OFF" + show HsNameUniqifier_CaseContinuation = "CCN" + show HsNameUniqifier_GrinUpdated = "UPD" + show HsNameUniqifier_FFIArg = "FFI" + show HsNameUniqifier_LacksLabel = "LBL" + show HsNameUniqifier_BindAspect = "ASP" + show HsNameUniqifier_Strict = "STR" + show HsNameUniqifier_GenericClass = "GEN" + show HsNameUniqifier_FFE = "FFE" + show HsNameUniqifier_FFECoerced = "FFC" + +{-# LINE 140 "src/ehc/Base/HsName.chs" #-} +-- | A HsNameUnique represents the optional additional info to make the uniqification even more unique +data HsNameUnique + = HsNameUnique_None + | HsNameUnique_String !String + | HsNameUnique_Int !Int + | HsNameUnique_UID !UID + deriving (Eq,Ord) + +showHsNameUnique :: (UID -> String) -> (String -> String) -> HsNameUnique -> String +showHsNameUnique _ _ (HsNameUnique_None ) = "" +showHsNameUnique _ shws (HsNameUnique_String s) = shws s +showHsNameUnique _ _ (HsNameUnique_Int i) = show i +showHsNameUnique shwu _ (HsNameUnique_UID u) = shwu u + +instance Show HsNameUnique where + show = showHsNameUnique hsnShowUID id + +{-# LINE 159 "src/ehc/Base/HsName.chs" #-} +type HsNameUniqifierMp = Map.Map HsNameUniqifier [HsNameUnique] + +emptyHsNameUniqifierMp :: HsNameUniqifierMp +emptyHsNameUniqifierMp = Map.empty + +-- | Show uniqifier map, parseable back again when properly parameterized. +showHsNameUniqifierMp'' :: (UID -> String) -> (String -> String) -> (String -> String) -> Bool -> String -> HsNameUniqifierMp -> [String] +showHsNameUniqifierMp'' shwu shws brk showLen usep us + = [ usep ++ slen u ++ show uqf ++ (brk $ concat [ usep ++ showHsNameUnique shwu shws uu | uu <- u, uu /= HsNameUnique_None ]) | (uqf,u) <- Map.toList us ] + where slen u | showLen && l /= 1 = usep ++ show l + | otherwise = "" + where l = length u + +showHsNameUniqifierMp' :: Bool -> String -> HsNameUniqifierMp -> [String] +showHsNameUniqifierMp' = showHsNameUniqifierMp'' hsnShowUID id id + +showHsNameUniqifierMp :: String -> HsNameUniqifierMp -> [String] +showHsNameUniqifierMp = showHsNameUniqifierMp' True + +{-# LINE 194 "src/ehc/Base/HsName.chs" #-} +uniqifierMpAdd :: HsNameUniqifier -> HsNameUnique -> HsNameUniqifierMp -> HsNameUniqifierMp +uniqifierMpAdd ufier u m = Map.unionWith (++) (Map.singleton ufier [u]) m + +uniqifierMpUnion :: HsNameUniqifierMp -> HsNameUniqifierMp -> HsNameUniqifierMp +uniqifierMpUnion = Map.unionWith (++) + +{-# LINE 206 "src/ehc/Base/HsName.chs" #-} +hsnUniqify' :: HsNameUniqifier -> HsNameUnique -> HsName -> HsName +hsnUniqify' ufier u + = mk + where mk n@(HsName_Modf {hsnUniqifiers=us}) = hsnFixateHash (n {hsnUniqifiers = uniqifierMpAdd ufier u us}) + mk n = mk (hsnMkModf [] n Map.empty) + +-- | Uniqify with just a name suffix +hsnUniqify :: HsNameUniqifier -> HsName -> HsName +hsnUniqify ufier = hsnUniqify' ufier HsNameUnique_None + +-- | Uniqify with a name suffix + extra Int uniq info +hsnUniqifyInt :: HsNameUniqifier -> Int -> HsName -> HsName +hsnUniqifyInt ufier u = hsnUniqify' ufier (HsNameUnique_Int u) + +-- | Uniqify with a name suffix + extra UID uniq info +hsnUniqifyUID :: HsNameUniqifier -> UID -> HsName -> HsName +hsnUniqifyUID ufier u = hsnUniqify' ufier (HsNameUnique_UID u) + +-- | Uniqify with a name suffix + extra String uniq info +hsnUniqifyStr :: HsNameUniqifier -> String -> HsName -> HsName +hsnUniqifyStr ufier u = hsnUniqify' ufier (HsNameUnique_String u) + +-- | Uniqify for use as evaluated name +hsnUniqifyEval :: HsName -> HsName +hsnUniqifyEval = hsnUniqify HsNameUniqifier_Evaluated + +{-# LINE 234 "src/ehc/Base/HsName.chs" #-} +-- | Remove uniqification, if present +hsnStripUniqify :: HsName -> Maybe HsName +hsnStripUniqify n@(HsName_Modf {hsnUniqifiers=us}) + | Map.null us = Nothing + | otherwise = Just $ n {hsnUniqifiers = Map.empty} +hsnStripUniqify _ = Nothing + +{-# LINE 243 "src/ehc/Base/HsName.chs" #-} +-- | Simplify name into list of simplifications of increasing complexity, all strictly simpler than the one given. [] therefore means no simplifications exist +hsnSimplifications :: HsName -> [HsName] +hsnSimplifications n@(HsName_Modf {}) = case hsnStripUniqify n of + Just n' -> hsnSimplifications n' ++ [n'] + _ -> hsnSimplifications $ hsnBase n +hsnSimplifications (HsName_UID {hsnUID = u}) = map mkHNm $ uidSimplifications u +-- hsnSimplifications n@(HsName_Base {} ) = [] -- [n] +hsnSimplifications _ = [] + +{-# LINE 258 "src/ehc/Base/HsName.chs" #-} +hsnHashWithSalt :: Int -> HsName -> Int +hsnHashWithSalt salt (HsName_Base s ) = hashWithSalt salt s +hsnHashWithSalt salt (HsName_UID i ) = hashWithSalt salt i +hsnHashWithSalt salt (HsName_Pos p ) = hashWithSalt salt p +hsnHashWithSalt salt (HsName_Modf _ q b u) = hashWithSalt salt q `hashWithSalt` hashWithSalt salt b `hashWithSalt` hashWithSalt salt (Map.toList u) +hsnHashWithSalt salt (HsName_Nr i n ) = i `hashWithSalt` hashWithSalt salt n + +instance Hashable HsName where + hashWithSalt salt n@(HsName_Modf h _ _ _) | h /= 0 = h + hashWithSalt salt n = hsnHashWithSalt salt n + +instance Hashable OrigName where + hashWithSalt salt (OrigNone ) = salt + hashWithSalt salt (OrigLocal n) = 23 `hashWithSalt` hashWithSalt salt n + hashWithSalt salt (OrigGlobal n) = 19 `hashWithSalt` hashWithSalt salt n + hashWithSalt salt (OrigFunc n) = 17 `hashWithSalt` hashWithSalt salt n + +instance Hashable HsNameUnique where + hashWithSalt salt (HsNameUnique_None ) = salt + hashWithSalt salt (HsNameUnique_String s) = hashWithSalt salt s + hashWithSalt salt (HsNameUnique_Int i) = hashWithSalt salt i + hashWithSalt salt (HsNameUnique_UID u) = hashWithSalt salt u + +instance Hashable HsNameUniqifier where + hashWithSalt salt u = hashWithSalt salt (fromEnum u) + +{-# LINE 286 "src/ehc/Base/HsName.chs" #-} +-- | Fixate hash +hsnFixateHash :: HsName -> HsName +hsnFixateHash n@(HsName_Modf _ _ _ _) = n {hsnHash = hsnHashWithSalt 17 n} +hsnFixateHash n = n +{-# INLINE hsnFixateHash #-} + +{-# LINE 300 "src/ehc/Base/HsName.chs" #-} +-- | Haskell name representation, exports of constructors only intented for internal use +data HsName + = HsName_Base + { hsnBaseStr :: !String + } + | HsName_UID + { hsnUID :: !UID + } + | HsName_Modf + { + -- a secret hash, prefixing other fields as to enforce comparison on the hash first; only used at variant 99 and onwards to avoid clutter + hsnHash :: !Int + , hsnQualifiers :: ![String] + , hsnBase :: !HsName + , hsnUniqifiers :: !HsNameUniqifierMp + } + | HsName_Pos !Int + | HsName_Nr !Int !OrigName + deriving (Eq,Ord) + +{-# LINE 326 "src/ehc/Base/HsName.chs" #-} +hsnEmpty :: HsName +hsnEmpty = mkHNm "" + +{-# LINE 340 "src/ehc/Base/HsName.chs" #-} +-- | Is HsName a HsName_Pos? +hsnMbPos :: HsName -> Maybe Int +hsnMbPos (HsName_Pos p) = Just p +hsnMbPos _ = Nothing + +hsnIsPos :: HsName -> Bool +hsnIsPos = isJust . hsnMbPos +{-# INLINE hsnIsPos #-} + +{-# LINE 351 "src/ehc/Base/HsName.chs" #-} +-- | Is HsName a HsName_Pos? +hsnMbNr :: HsName -> Maybe (Int,OrigName) +hsnMbNr (HsName_Nr i o) = Just (i,o) +hsnMbNr _ = Nothing + +hsnIsNr :: HsName -> Bool +hsnIsNr = isJust . hsnMbNr +{-# INLINE hsnIsNr #-} + +{-# LINE 362 "src/ehc/Base/HsName.chs" #-} +-- | Smart constructor for HsName_Modf +hsnMkModf :: [String] -> HsName -> HsNameUniqifierMp -> HsName +-- hsnMkModf q b u = hsnFixateHash $ HsName_Modf 0 q b u +hsnMkModf q b u = hsnFixateHash $ either (\(_,n) -> n {hsnQualifiers = q, hsnUniqifiers = hsnUniqifiers n `uniqifierMpUnion` u}) (\b -> HsName_Modf 0 q b u) $ hsnCanonicSplit b +{-# INLINE hsnMkModf #-} + +{-# LINE 374 "src/ehc/Base/HsName.chs" #-} +-- | Smart constructor for HsName_Nr +hsnMkNr :: Int -> OrigName -> HsName +hsnMkNr = HsName_Nr +{-# INLINE hsnMkNr #-} + +{-# LINE 389 "src/ehc/Base/HsName.chs" #-} +-- | Just lift a string to the base HsName variant +mkHNmBase :: String -> HsName +mkHNmBase s = hsnMkModf [] (HsName_Base s) Map.empty + +{-# LINE 399 "src/ehc/Base/HsName.chs" #-} +-- | Eliminate alternative internal representations +hsnEnsureIsBase :: HsName -> HsName +hsnEnsureIsBase n@(HsName_UID _) = mkHNm $ show n +hsnEnsureIsBase (HsName_Pos i) = mkHNm $ show i +hsnEnsureIsBase n = n + +{-# LINE 409 "src/ehc/Base/HsName.chs" #-} +-- | unpack a HsName into qualifiers + base string + repack function +hsnBaseUnpack' :: HsName -> Maybe ([String],String,[String] -> String -> HsName) +hsnBaseUnpack' (HsName_Base s ) = Just ([],s,\_ s -> HsName_Base s) +hsnBaseUnpack' (HsName_Modf _ q b u) = fmap (\(bs,mk) -> (q, bs, \q s -> hsnMkModf q (mk s) u)) (hsnBaseUnpack b) +hsnBaseUnpack' _ = Nothing + +-- | unpack a HsName into base string + repack function +hsnBaseUnpack :: HsName -> Maybe (String,String -> HsName) +hsnBaseUnpack (HsName_Base s ) = Just (s,HsName_Base) +hsnBaseUnpack (HsName_Modf _ q b u) = fmap (\(bs,mk) -> (bs, \s -> hsnMkModf q (mk s) u)) (hsnBaseUnpack b) +hsnBaseUnpack _ = Nothing + +{-# LINE 427 "src/ehc/Base/HsName.chs" #-} +-- | If name is a HsName_Base after some unpacking, return the base string, without qualifiers, without uniqifiers +hsnMbBaseString :: HsName -> Maybe String +hsnMbBaseString = fmap fst . hsnBaseUnpack +{-# INLINE hsnMbBaseString #-} + +-- | Is name is a HsName_Base after some unpacking? +hsnIsBaseString :: HsName -> Bool +hsnIsBaseString = isJust . hsnMbBaseString +{-# INLINE hsnIsBaseString #-} + +hsnBaseString :: HsName -> String +hsnBaseString = maybe "??" id . hsnMbBaseString + + +{-# LINE 443 "src/ehc/Base/HsName.chs" #-} +-- | Just lift a int to the int HsName variant +mkHNmPos :: Int -> HsName +mkHNmPos s = hsnMkModf [] (HsName_Pos s) Map.empty + +{-# LINE 453 "src/ehc/Base/HsName.chs" #-} +-- | Compare, ignoring hash +cmpHsNameOnNm :: HsName -> HsName -> Ordering +cmpHsNameOnNm (HsName_Modf _ q1 b1 u1) (HsName_Modf _ q2 b2 u2) = compare (HsName_Modf 0 q1 b1 u1) (HsName_Modf 0 q2 b2 u2) +cmpHsNameOnNm n1 n2 = compare n1 n2 + +{-# LINE 468 "src/ehc/Base/HsName.chs" #-} +hsnFromString :: String -> HsName +hsnFromString = mkHNmBase +{-# INLINE hsnFromString #-} + +{-# LINE 479 "src/ehc/Base/HsName.chs" #-} +data OrigName + = OrigNone + | OrigLocal HsName + | OrigGlobal HsName + | OrigFunc HsName + deriving (Eq,Ord) + +{-# LINE 488 "src/ehc/Base/HsName.chs" #-} +instance PP HsName where + pp h = pp (show h) + +{-# LINE 494 "src/ehc/Base/HsName.chs" #-} +-- | Parameterizable show of HsName when used from within the Show instance for HsName, or for a parseable representation used by (e.g.) Core pretty printing +hsnShow' :: (UID -> String) -> (String -> String) -> (String -> String) -> String -> String -> HsName -> String +hsnShow' shwu shws brk qsep usep n + = shw n + where shw n = case n of + HsName_Base s -> s + HsName_UID i -> shwu i + HsName_Modf _ qs b us -> concat $ (intersperse qsep $ qs ++ [shw b]) ++ showHsNameUniqifierMp'' shwu shws brk False usep us + HsName_Pos p -> show p + HsName_Nr n OrigNone -> "x_" ++ show n + HsName_Nr n (OrigLocal hsn) -> "x_" ++ show n ++ "_" ++ shw hsn + HsName_Nr n (OrigGlobal hsn) -> "global_x_" ++ show n ++ "_" ++ shw hsn + HsName_Nr n (OrigFunc hsn) -> "fun_x_" ++ show n ++ "_" ++ shw hsn + +-- | Parseable show of HsName when used from within the Show instance for HsName +hsnShow :: String -> String -> HsName -> String +hsnShow q u n = hsnShow' hsnShowUID id id q u n +{-# INLINE hsnShow #-} + +hsnShowUID i = 'u' : show i + +{-# LINE 519 "src/ehc/Base/HsName.chs" #-} +instance Show HsName where + show = hsnShow "." "_@" + +{-# LINE 529 "src/ehc/Base/HsName.chs" #-} +-- | A HsName is either a complex/aggregrate name or a base case +hsnCanonicSplit :: HsName -> Either ([String],HsName) HsName +hsnCanonicSplit n@(HsName_Modf _ qs _ _) = Left $ (qs, hsnFixateHash (n {hsnQualifiers = []})) +hsnCanonicSplit n = Right n + +{-# LINE 538 "src/ehc/Base/HsName.chs" #-} +hsnToList :: HsName -> [HsName] +hsnToList n = either (\(qs,b) -> map mkHNmBase qs ++ [b]) (:[]) (hsnCanonicSplit n) + +{-# LINE 543 "src/ehc/Base/HsName.chs" #-} +hsnInitLast :: HsName -> ([HsName],HsName) +hsnInitLast n = either (\(qs,b) -> (map mkHNmBase qs, b)) (\x -> ([],x)) (hsnCanonicSplit n) + +{-# LINE 548 "src/ehc/Base/HsName.chs" #-} +hsnPrefix :: String -> HsName -> HsName +hsnPrefix p hsn + = maybe (mkHNmBase $ p ++ show hsn) (\(s,mk) -> mk $ p ++ s) $ hsnBaseUnpack hsn + +hsnSuffix :: HsName -> String -> HsName +hsnSuffix hsn p + = maybe (mkHNmBase $ show hsn ++ p) (\(s,mk) -> mk $ s ++ p) $ hsnBaseUnpack hsn + +mkHNmPrefix :: HSNM x => String -> x -> HsName +mkHNmPrefix p = hsnPrefix p . mkHNm + +{-# LINE 561 "src/ehc/Base/HsName.chs" #-} +stringAlphanumeric :: String -> String +stringAlphanumeric s + = concat (map (charAlphanumeric) s) + +{-# LINE 574 "src/ehc/Base/HsName.chs" #-} +charAlphanumeric :: Char -> String +charAlphanumeric '\'' = "prime" +charAlphanumeric ':' = "colon" +charAlphanumeric '!' = "exclam" +charAlphanumeric '@' = "at" +charAlphanumeric '#' = "number" +charAlphanumeric '$' = "dollar" +charAlphanumeric '%' = "percent" +charAlphanumeric '^' = "circon" +charAlphanumeric '&' = "amp" +charAlphanumeric '*' = "star" +charAlphanumeric '+' = "plus" +charAlphanumeric '-' = "minus" +charAlphanumeric '.' = "dot" +charAlphanumeric '/' = "slash" +charAlphanumeric '\\' = "backsl" +charAlphanumeric '|' = "bar" +charAlphanumeric '<' = "lt" +charAlphanumeric '=' = "eq" +charAlphanumeric '>' = "gt" +charAlphanumeric '?' = "quest" +charAlphanumeric '~' = "tilde" +charAlphanumeric '[' = "sub" -- although this is not a legal Haskell operator symbol, it can be part of the Nil constructor +charAlphanumeric ']' = "bus" +charAlphanumeric '(' = "open" -- although this is not a legal Haskell operator symbol, it can be part of the tuple constructor +charAlphanumeric ',' = "comma" +charAlphanumeric ')' = "close" +charAlphanumeric c = [c] + +{-# LINE 607 "src/ehc/Base/HsName.chs" #-} +dontStartWithDigit :: String -> String +dontStartWithDigit xs@(a:_) | isDigit a || a=='_' = "y"++xs + | otherwise = xs + +hsnShowAlphanumericShort :: HsName -> String +hsnShowAlphanumericShort (HsName_Nr n (OrigFunc orig)) = hsnShowAlphanumeric orig +hsnShowAlphanumericShort x = hsnShowAlphanumeric x + +hsnShowAlphanumeric :: HsName -> String +hsnShowAlphanumeric (HsName_Base s ) = dontStartWithDigit(stringAlphanumeric s) +hsnShowAlphanumeric (HsName_UID i ) = "u" ++ show i +hsnShowAlphanumeric (HsName_Pos p) = "y" ++ show p +hsnShowAlphanumeric (HsName_Nr n OrigNone) = "x" ++ show n +hsnShowAlphanumeric (HsName_Nr n (OrigLocal orig)) = "x" ++ show n -- hsnShowAlphanumeric orig +hsnShowAlphanumeric (HsName_Nr n (OrigGlobal orig)) = "global_" ++ hsnShowAlphanumeric orig +hsnShowAlphanumeric (HsName_Nr n (OrigFunc orig)) = "fun_" ++ hsnShowAlphanumeric orig +hsnShowAlphanumeric (HsName_Modf _ q b u) = concat $ intersperse "_" $ q ++ [hsnShowAlphanumeric b] ++ map stringAlphanumeric (showHsNameUniqifierMp "_" u) +-- hsnShowAlphanumeric n = concat $ intersperse "_" $ map hsnShowAlphanumeric $ hsnToList n + +{-# LINE 631 "src/ehc/Base/HsName.chs" #-} +hsnToFPath :: HsName -> FPath +hsnToFPath n + = mkFPathFromDirsFile qs b + where (qs,b) = hsnInitLast n + +instance FPATH HsName where + mkFPath = hsnToFPath + +{-# LINE 642 "src/ehc/Base/HsName.chs" #-} +hsnConcat :: HsName -> HsName -> HsName +hsnConcat h1 h2 = hsnFromString (show h1 ++ show h2) + +{-# LINE 651 "src/ehc/Base/HsName.chs" #-} +-- compare for row labels, lexicographic ordering (currently) +rowLabCmp :: HsName -> HsName -> Ordering +rowLabCmp = cmpHsNameOnNm + +{-# LINE 661 "src/ehc/Base/HsName.chs" #-} +-- qualifier (i.e. module name) and qualified part of name +hsnSplitQualify :: HsName -> (Maybe HsName,HsName) +hsnSplitQualify n + = case hsnInitLast n of + ([],n') -> (Nothing,n') + (ns,n') -> (Just (mkHNm ns),n') + +-- qualified part of a name +hsnQualified :: HsName -> HsName +hsnQualified = snd . hsnSplitQualify + +-- prefix/qualify with module name, on top of possible previous qualifier +hsnPrefixQual :: HsName -> HsName -> HsName +hsnPrefixQual m n = mkHNm (hsnToList m ++ hsnToList n) + +-- map qualified part +hsnMapQualified :: (String -> String) -> HsName -> HsName +hsnMapQualified f qn + = maybe qn (\(s,mk) -> mk $ f s) $ hsnBaseUnpack qn +{- + = case hsnSplitQualify qn of + (Nothing,n) -> f n + (Just q ,n) -> hsnPrefixQual q (f n) +-} + +{-# LINE 688 "src/ehc/Base/HsName.chs" #-} +-- qualifier (i.e. module name) of name +hsnQualifier :: HsName -> Maybe HsName +hsnQualifier = fst . hsnSplitQualify + +-- replace/set qualifier +hsnSetQual :: HsName -> HsName -> HsName +hsnSetQual m = hsnPrefixQual m . hsnQualified + +-- is qualified? +hsnIsQual :: HsName -> Bool +hsnIsQual = isJust . hsnQualifier + +{-# LINE 714 "src/ehc/Base/HsName.chs" #-} +hsnMapQual :: (HsName -> HsName) -> HsName -> HsName +hsnMapQual f qn + = case hsnSplitQualify qn of + (Nothing,n) -> qn + (Just q ,n) -> hsnSetQual (f q) n + +hsnSetLevQual :: Int -> HsName -> HsName -> HsName +hsnSetLevQual 0 m n = hsnSetQual m n +hsnSetLevQual _ _ n = n + +{-# LINE 730 "src/ehc/Base/HsName.chs" #-} +hsnFixUniqifiers' :: Bool -> String -> HsName -> HsName +hsnFixUniqifiers' showlen sep (HsName_Modf _ qs n us) = hsnMkModf qs (hsnSuffix n (concat $ showHsNameUniqifierMp' showlen sep us)) Map.empty +hsnFixUniqifiers' _ _ n = n + +hsnFixUniqifiers :: HsName -> HsName +hsnFixUniqifiers = hsnFixUniqifiers' True "_@" + +hsnJavalikeFixUniqifiers :: HsName -> HsName +hsnJavalikeFixUniqifiers = hsnFixUniqifiers' False "" + +{-# LINE 746 "src/ehc/Base/HsName.chs" #-} +hsnStripUniqifiers :: HsName -> HsName +hsnStripUniqifiers (HsName_Modf _ qs n us) = hsnMkModf qs n emptyHsNameUniqifierMp +hsnStripUniqifiers n = n + +{-# LINE 756 "src/ehc/Base/HsName.chs" #-} +hsnQualUniqify :: HsName -> HsName -> HsName +hsnQualUniqify modNm n + = if hsnIsQual n + then n + else hsnSetQual modNm n + +{-# LINE 768 "src/ehc/Base/HsName.chs" #-} +class HSNM a where + mkHNm :: a -> HsName + +instance HSNM HsName where + mkHNm = id + +instance HSNM Int where + mkHNm = mkHNm . show + + +{-# LINE 780 "src/ehc/Base/HsName.chs" #-} +instance HSNM UID where + mkHNm = HsName_UID + -- mkHNm x = hsnFromString ('_' : show x) + +{-# LINE 791 "src/ehc/Base/HsName.chs" #-} +instance HSNM String where + mkHNm s + = mkHNm $ map hsnFromString $ splitForQualified s + +{-# LINE 797 "src/ehc/Base/HsName.chs" #-} +instance HSNM ([HsName],HsName) where + mkHNm (l,n) = mkHNm (l ++ [n]) + +instance HSNM [HsName] where + mkHNm [n] = n + mkHNm [] = hsnFromString "" -- ????, or empty alternative of HsName + mkHNm ns = case initlast ns of + Just (i,l) -> case l of + n@(HsName_Modf _ _ _ _) -> hsnFixateHash (n {hsnQualifiers = qs}) + n -> hsnMkModf qs n Map.empty + where qs = catMaybes $ map hsnMbBaseString i + +{-# LINE 820 "src/ehc/Base/HsName.chs" #-} +instance Position HsName where + line _ = (-1) + column _ = (-1) + file _ = "" + +{-# LINE 831 "src/ehc/Base/HsName.chs" #-} +deriving instance Typeable HsNameUniqifier +deriving instance Data HsNameUniqifier + +deriving instance Typeable HsNameUnique +deriving instance Data HsNameUnique + +deriving instance Typeable HsName +deriving instance Data HsName + +deriving instance Typeable OrigName +deriving instance Data OrigName + +deriving instance Typeable IdOccKind +deriving instance Data IdOccKind + +deriving instance Typeable IdOcc +deriving instance Data IdOcc + +{-# LINE 855 "src/ehc/Base/HsName.chs" #-} +instance Binary HsNameUniqifier where + put = putEnum8 + get = getEnum8 + +instance Binary HsNameUnique where + put (HsNameUnique_String a ) = putWord8 0 >> put a + put (HsNameUnique_Int a ) = putWord8 1 >> put a + put (HsNameUnique_UID a ) = putWord8 2 >> put a + put (HsNameUnique_None ) = putWord8 3 + get = do t <- getWord8 + case t of + 0 -> liftM HsNameUnique_String get + 1 -> liftM HsNameUnique_Int get + 2 -> liftM HsNameUnique_UID get + 3 -> return HsNameUnique_None + +instance Binary HsName where + put (HsName_Base a ) = putWord8 0 >> put a + put (HsName_UID a ) = putWord8 1 >> put a + put (HsName_Pos a ) = putWord8 2 >> put a + put (HsName_Nr a b ) = putWord8 3 >> put a >> put b + put (HsName_Modf a b c d) = putWord8 4 >> put a >> put b >> put c >> put d + get = do t <- getWord8 + case t of + 0 -> liftM HsName_Base get + 1 -> liftM HsName_UID get + 2 -> liftM HsName_Pos get + 3 -> liftM2 HsName_Nr get get + 4 -> liftM4 HsName_Modf get get get get + +instance Serialize HsName where + sput = sputShared + sget = sgetShared + sputNested = sputPlain + sgetNested = sgetPlain + +instance Binary OrigName where + put (OrigNone ) = putWord8 0 + put (OrigLocal a) = putWord8 1 >> put a + put (OrigGlobal a) = putWord8 2 >> put a + put (OrigFunc a) = putWord8 3 >> put a + get = do t <- getWord8 + case t of + 0 -> return OrigNone + 1 -> liftM OrigLocal get + 2 -> liftM OrigGlobal get + 3 -> liftM OrigFunc get + +instance Binary IdOccKind where + put = putEnum8 + get = getEnum8 + +instance Serialize IdOccKind where + sput = sputPlain + sget = sgetPlain + +instance Binary IdOcc where + put (IdOcc a b) = put a >> put b + get = liftM2 IdOcc get get + +instance Serialize IdOcc where + sput = sputShared + sget = sgetShared + sputNested = sputPlain + sgetNested = sgetPlain + +{-# LINE 927 "src/ehc/Base/HsName.chs" #-} +data IdOccKind + = IdOcc_Val + | IdOcc_Pat + | IdOcc_Type + | IdOcc_Kind + | IdOcc_Fld + | IdOcc_Class + | IdOcc_Inst + | IdOcc_Dflt + | IdOcc_Any + | IdOcc_Data + | IdOcc_Fusion + deriving (Eq,Ord,Enum) + +{-# LINE 953 "src/ehc/Base/HsName.chs" #-} +-- intended for parsing +instance Show IdOccKind where + show IdOcc_Val = "Value" + show IdOcc_Pat = "Pat" + show IdOcc_Type = "Type" + show IdOcc_Kind = "Kind" + show IdOcc_Fld = "Field" + show IdOcc_Class = "Class" + show IdOcc_Inst = "Instance" + show IdOcc_Dflt = "Default" + show IdOcc_Any = "Any" + show IdOcc_Data = "Data" + show IdOcc_Fusion = "Fusion" + +{-# LINE 979 "src/ehc/Base/HsName.chs" #-} +-- intended for parsing +instance PP IdOccKind where + pp = text . show + +{-# LINE 985 "src/ehc/Base/HsName.chs" #-} +data IdOcc + = IdOcc { ioccNm :: !HsName, ioccKind :: !IdOccKind } + deriving (Show,Eq,Ord) + + +{-# LINE 996 "src/ehc/Base/HsName.chs" #-} +type HsNameS = Set.Set HsName + +{-# LINE 1004 "src/ehc/Base/HsName.chs" #-} +-- ensure a name valid for backends which are more restrictive in their allowed identifier character set +hsnSafeJavaLike :: HsName -> HsName +hsnSafeJavaLike + = hsnMapQualified (concatMap safe . first) . hsnJavalikeFixUniqifiers . hsnEnsureIsBase + where safe '_' = "__" + safe c | isDigit c || isLetter c || c == '_' = [c] + | otherwise = "_" ++ showHex (ord c) "" + first s@(c:_) | isDigit c = '_' : s + first s = s + +{-# LINE 1031 "src/ehc/Base/HsName.chs" #-} +type FvS = HsNameS +type FvSMp = Map.Map HsName FvS + +{-# LINE 1040 "src/ehc/Base/HsName.chs" #-} +type HsNameMp = Map.Map HsName HsName + +hsnRepl :: HsNameMp -> HsName -> HsName +hsnRepl m n = Map.findWithDefault n n m + +{-# LINE 1051 "src/ehc/Base/HsName.chs" #-} +data RPatNm + = RPatNmOrig {rpatNmNm :: !HsName} + | RPatNmUniq {rpatNmNm :: !HsName} + deriving Eq + +instance Ord RPatNm where + x `compare` y = rpatNmNm x `cmpHsNameOnNm` rpatNmNm y + +instance Show RPatNm where + show pnm = show (rpatNmNm pnm) + +instance PP RPatNm where + pp (RPatNmOrig n) = n >|< "(O)" + pp (RPatNmUniq n) = n >|< "(U)" + +{-# LINE 1068 "src/ehc/Base/HsName.chs" #-} +rpatNmIsOrig :: RPatNm -> Bool +rpatNmIsOrig (RPatNmOrig _) = True +rpatNmIsOrig _ = False + +{-# LINE 1078 "src/ehc/Base/HsName.chs" #-} +hsnUnknown :: HsName +hsnUnknown = hsnFromString "??" + +{-# LINE 1087 "src/ehc/Base/HsName.chs" #-} + +data Track + = TrackNone + | TrackSelf + | TrackCtx Int + | TrackSelect Int Track + | TrackVarApply HsName [Track] + deriving (Eq, Ord, Show) + + +{-# LINE 1099 "src/ehc/Base/HsName.chs" #-} + +instance Serialize Track where + sput (TrackNone ) = sputWord8 0 + sput (TrackSelf ) = sputWord8 1 + sput (TrackCtx a ) = sputWord8 2 >> sput a + sput (TrackSelect a b ) = sputWord8 3 >> sput a >> sput b + sput (TrackVarApply a b ) = sputWord8 4 >> sput a >> sput b + + sget + = do t <- sgetWord8 + case t of + 0 -> return TrackNone + 1 -> return TrackSelf + 2 -> liftM TrackCtx sget + 3 -> liftM2 TrackSelect sget sget + 4 -> liftM2 TrackVarApply sget sget + +deriving instance Data Track +deriving instance Typeable Track + + + diff --git a/src/UHC/Light/Compiler/Base/HsName/Builtin.hs b/src/UHC/Light/Compiler/Base/HsName/Builtin.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/HsName/Builtin.hs @@ -0,0 +1,803 @@ +module UHC.Light.Compiler.Base.HsName.Builtin +( hsnWild, hsnArrow, strProd, hsnProd, hsnProdArity, hsnUnknown, hsnIsArrow, hsnIsProd, hsnInt, hsnChar +, hsnIsWild +, hsnStrHiddenPrefix +, mkHNmHidden +, hsnNegate +, hsnError +, hsnUn, hsnIsUn, hsnUnUn +, hsnEqTilde, hsnIsEqTilde +, hsnCovariant, hsnContravariant, hsnInvariant +, hsnIsList +, hsnEnumFromThenTo, hsnEnumFromThen, hsnEnumFromTo, hsnEnumFrom +, hsnBool, hsnTrue, hsnFalse, hsnDataList, hsnDataListAltCons, hsnDataListAltNil, hsnClassEqFldEq, hsnPrelConcatMap +, charKindStar, hsnKindStar +, mkHNmSpecial +, hsnORow, hsnCRow, hsnORec, hsnCRec, hsnOSum, hsnCSum +, hsnRow, hsnRec, hsnSum, hsnRowEmpty, hsnIsRec, hsnIsSum, hsnIsRow +, positionalFldNames +, hsnKindRow +, hsnMain +, hsnIsConstructorName +, hsnUndefined, hsnPackedString, hsnPackedStringToString, hsnPrelId, hsnPrimAddInt +, EHBuiltinNames (..), mkEHBuiltinNames +, hsnOImpl, hsnCImpl, hsnPrArrow, hsnIsPrArrow, hsnIsUnknown +, hsnMonadSeq, hsnMonadBind, hsnMonadFail, hsnClassEq +, hsnClass2Dict +, hsnClass2Kind +, hsnClass2Polarity +, hsnDynVar +, hsnPolNegation +, hsnFldUpd +, hsnModBuiltin +, hsnDataOrderingAltEQ, hsnDataOrderingAltLT, hsnDataOrderingAltGT +, hsnNm2Gener, hsnNm2GenerReprSyn, hsnNm2GenerDatatype, hsnNm2GenerConstructor, hsnNm2GenerSelector, hsnNm2GenerReprTuple +, builtinGenerClassNmL +, hsnInteger +, hsnInt8Unboxed, hsnInt16Unboxed, hsnInt32Unboxed, hsnInt64Unboxed, hsnWordUnboxed, hsnWord8Unboxed, hsnWord16Unboxed, hsnWord32Unboxed, hsnWord64Unboxed +, hsnPackedStringToInteger, hsnPrimIntegerToInt, hsnPrimIntToInteger +, hsnFromInteger +, hsnFromRational +, hsnMkRatio +, hsnIO +, hsnAddrUnboxed +, hsnDataStringFromString +, hsnEhcRunMain +, hsnStackTracePush +, hsnIsInPrelude +, hsnModPrelude, hsnModIntlBase +, hsnModDataString ) +where +import UHC.Light.Compiler.Base.HsName +import Data.Maybe +import UHC.Util.Utils +import Data.List +import Data.Char (isUpper) + + + + + +{-# LINE 28 "src/ehc/Base/HsName/Builtin.chs" #-} +strProd :: Int -> String + +{-# LINE 32 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnArrow, hsnInt, hsnChar, hsnWild :: HsName +hsnProd :: Int -> HsName +hsnProdArity :: HsName -> Int + +{-# LINE 38 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnArrow = hsnFromString "->" +hsnInt = hsnFromString "Int" +hsnChar = hsnFromString "Char" +hsnWild = hsnFromString "_" +strProd i = ',' : show i +hsnProd = hsnFromString . strProd + +hsnIsArrow, hsnIsProd :: HsName -> Bool +hsnIsArrow hsn = hsn == hsnArrow + +hsnIsProd n | isJust ms = case m of + (',':_) -> True + _ -> False + where ms@(~(Just m)) = hsnMbBaseString n +hsnIsProd _ = False + +hsnProdArity n | isJust ms = case m of + (_:ar) -> read ar + _ -> 0 + where ms@(~(Just m)) = hsnMbBaseString n + +{-# LINE 63 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnIsWild :: HsName -> Bool +hsnIsWild x = hsnQualified x == hsnWild + +{-# LINE 72 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnStrHiddenPrefix = "_'" + +{-# LINE 76 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnStrSpecialPrefix = "_" + +{-# LINE 80 "src/ehc/Base/HsName/Builtin.chs" #-} +mkHNmHidden :: HSNM x => x -> HsName +mkHNmHidden = mkHNmPrefix hsnStrHiddenPrefix + +{-# LINE 85 "src/ehc/Base/HsName/Builtin.chs" #-} +mkHNmSpecial :: HSNM x => x -> HsName +mkHNmSpecial = mkHNmPrefix hsnStrSpecialPrefix + +{-# LINE 95 "src/ehc/Base/HsName/Builtin.chs" #-} +strUn = hsnStrHiddenPrefix ++ "un" + +{-# LINE 99 "src/ehc/Base/HsName/Builtin.chs" #-} +strFldUpd = hsnStrHiddenPrefix ++ "upd_" + +{-# LINE 108 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnUn :: HsName -> HsName +hsnUn nm = strUn `hsnPrefix` nm + +{-# LINE 113 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnIsUn :: HsName -> Bool +hsnIsUn = maybe False (isPrefixOf strUn) . hsnMbBaseString + +{-# LINE 126 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnUnUn :: HsName -> HsName +hsnUnUn n = maybe n (\(s,mk) -> mk $ drop (length strUn) s) $ hsnBaseUnpack n + +{-# LINE 144 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnFldUpd :: HsName -> HsName +hsnFldUpd nm = strFldUpd `hsnPrefix` nm + +{-# LINE 149 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnIsList hsn = hsn == hsnDataList + +{-# LINE 153 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnORow = hsnFromString "{|" +hsnCRow = hsnFromString "|}" +hsnOSum = hsnFromString "{<" +hsnCSum = hsnFromString ">}" +hsnORec = hsnFromString "(" +hsnCRec = hsnFromString ")" + +{-# LINE 162 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnRow = hsnFromString (hsnStrSpecialPrefix ++ "Row") +hsnRec = hsnFromString (hsnStrSpecialPrefix ++ "Rec") +hsnSum = hsnFromString (hsnStrSpecialPrefix ++ "Var") +hsnRowEmpty = hsnFromString (show hsnORow ++ show hsnCRow) + +hsnIsRec, hsnIsSum, hsnIsRow :: HsName -> Bool +hsnIsRec hsn = hsn == hsnRec +hsnIsSum hsn = hsn == hsnSum +hsnIsRow hsn = hsn == hsnRow + +{-# LINE 174 "src/ehc/Base/HsName/Builtin.chs" #-} +positionalFldNames :: [HsName] +positionalFldNames = map mkHNmPos [1..] + +{-# LINE 179 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnMain = hsnFromString "main" + +{-# LINE 183 "src/ehc/Base/HsName/Builtin.chs" #-} +constructorInitial :: Char -> Bool +constructorInitial ':' = True +constructorInitial '[' = True +constructorInitial ',' = True +constructorInitial '(' = True +constructorInitial c = isUpper c + +hsnIsConstructorName :: HsName -> Bool +hsnIsConstructorName n | isJust ms = constructorInitial x + | hsnIsPos n = False + where ms@(~(Just (~(x:xs)))) = hsnMbBaseString n +{-# LINE 196 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnIsConstructorName n = hsnIsConstructorName (snd $ hsnInitLast n) + +{-# LINE 200 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnOImpl = hsnFromString "{!" +hsnCImpl = hsnFromString "!}" +hsnPrArrow = hsnFromString "=>" + +hsnIsPrArrow :: HsName -> Bool +hsnIsPrArrow hsn = hsn == hsnPrArrow +hsnIsUnknown = (==hsnUnknown) + +{-# LINE 210 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnDynVar = hsnFromString "?" + +{-# LINE 214 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnEqTilde = hsnFromString "~" + +hsnIsEqTilde = (==hsnEqTilde) + +{-# LINE 220 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnCovariant, hsnContravariant, hsnInvariant :: HsName +hsnCovariant = mkHNm "+Covariant" +hsnContravariant = mkHNm "-Contravariant" +hsnInvariant = mkHNm "*Invariant" + +{-# LINE 227 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnPolNegation :: HsName +hsnPolNegation = mkHNm "^Negate" + +{-# LINE 241 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnInteger = hsnFromString "Integer" + +{-# LINE 249 "src/ehc/Base/HsName/Builtin.chs" #-} +charKindStar = '*' +hsnKindStar = hsnFromString [charKindStar] + +{-# LINE 254 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnKindRow = hsnRow + +{-# LINE 273 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnInt8Unboxed = hsnFromString "Int8#" +hsnInt16Unboxed = hsnFromString "Int16#" +hsnInt32Unboxed = hsnFromString "Int32#" +hsnInt64Unboxed = hsnFromString "Int64#" +hsnWordUnboxed = hsnFromString "Word#" +hsnWord8Unboxed = hsnFromString "Word8#" +hsnWord16Unboxed = hsnFromString "Word16#" +hsnWord32Unboxed = hsnFromString "Word32#" +hsnWord64Unboxed = hsnFromString "Word64#" + +{-# LINE 285 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnAddrUnboxed = hsnFromString "Addr#" + +{-# LINE 306 "src/ehc/Base/HsName/Builtin.chs" #-} +mkRV' :: HsName -> HsName -> HsName +mkRV' m = hsnSetQual m + +mkRV :: HsName -> String -> HsName +mkRV m = mkRV' m . hsnFromString + +mkGenerRV :: String -> HsName +mkGenerRV = mkRV hsnModIntlBase + +{-# LINE 317 "src/ehc/Base/HsName/Builtin.chs" #-} +mkGenerRVN' :: Int -> String -> String -> HsName +mkGenerRVN' n s suff = mkGenerRV (s ++ show n ++ suff) + +mkGenerRVN :: Int -> String -> HsName +mkGenerRVN n s = mkGenerRVN' n s "" + +mkGenerRVN2 :: Int -> String -> HsName +mkGenerRVN2 n s = mkGenerRVN' n s "_" + +{-# LINE 332 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnNegate] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlNum) + [ "negate" ] + +{-# LINE 343 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnError] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlBase) + [ "error" ] + +{-# LINE 360 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnEnumFromThenTo,hsnEnumFromThen,hsnEnumFromTo,hsnEnumFrom] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlEnum) + [ "enumFromThenTo", "enumFromThen", "enumFromTo", "enumFrom" ] + +{-# LINE 371 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnClassIx, hsnClassIxFldRange, hsnClassIxFldIndex, hsnClassIxFldInRange] + = map + (mkRV hsnModIntlIx) -- (mkRV hsnModIntlEnum) + [ "Ix", "range", "index", "inRange" ] + +{-# LINE 378 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnDataList,hsnDataListAltCons,hsnDataListAltNil,hsnPrelConcatMap + , hsnBool,hsnTrue,hsnFalse + , hsnDataOrdering, hsnDataOrderingAltEQ, hsnDataOrderingAltLT, hsnDataOrderingAltGT + , hsnPrelString + , hsnClassEqFldEq + , hsnMap + , hsnClassBounded, hsnClassBoundedFldMinBound, hsnClassBoundedFldMaxBound + , hsnClassEnum, hsnClassEnumFldFromEnum, hsnClassEnumFldToEnum, hsnClassEnumFldSucc, hsnClassEnumFldPred + ] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlBase) + [ "[]", ":", "[]", "concatMap" + , "Bool", "True", "False" + , "Ordering", "EQ", "LT", "GT" + , "String" + , "==" + , "map" + , "Bounded", "minBound", "maxBound" + , "Enum", "fromEnum", "toEnum", "succ", "pred" + ] + + +{-# LINE 418 "src/ehc/Base/HsName/Builtin.chs" #-} +[ hsnUndefined + , hsnPackedString + , hsnPackedStringToString + , hsnPrelId + , hsnPrimAddInt + , hsnPrimGtInt + , hsnPrimLtInt + , hsnPackedStringToInteger + , hsnPrimIntegerToInt + , hsnPrimIntToInteger + , hsnPrimEqChar + ] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlBase) + [ "undefined" + , "PackedString" + , "packedStringToString" + , "id" + , "primAddInt" + , "primGtInt" + , "primLtInt" + , "packedStringToInteger" + , "primIntegerToInt" + , "primIntToInteger" + , "primEqChar" + ] + +{-# LINE 469 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnMonadSeq,hsnMonadBind,hsnMonadFail + , hsnClassEq + , hsnBoolAnd + , hsnBoolOr + , hsnClassOrd, hsnClassOrdFldCompare + , hsnPrelConcat2, hsnPrelConcat + , hsnPrelCompose + ] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlBase) + [ ">>", ">>=", "fail" + , "Eq" + , "&&" + , "||" + , "Ord", "compare" + , "++", "concat" + , "." + ] + +{-# LINE 502 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnFunPtr] + = map + (mkRV hsnModIntlPtr) + [ "FunPtr" + ] + +{-# LINE 514 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnAddr] + = map + (mkRV hsnModIntlTypes) + [ "Addr" + ] + +{-# LINE 526 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnClassShow + , hsnClassShowFldShow, hsnClassShowFldShowsPrec + , hsnPrelShowString, hsnPrelShowParen + ] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlShow) + [ "Show" + , "show", "showsPrec" + , "showString", "showParen" + ] + +{-# LINE 543 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnClassRead + , hsnClassReadFldRead, hsnClassReadFldReadsPrec + , hsnPrelLex, hsnPrelReadParen + ] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlRead) + [ "Read" + , "read", "readsPrec" + , "lex", "readParen" + ] + +{-# LINE 564 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnFromInteger] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlNum) + [ "fromInteger" ] + +{-# LINE 575 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnFloat,hsnDouble + ] + = map + (mkRV hsnModIntlBase) + [ "Float", "Double" + ] + +{-# LINE 588 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnWord,hsnWord8,hsnWord16,hsnWord32,hsnWord64 + ] + = map + (mkRV hsnModIntlTypes) + [ "Word", "Word8", "Word16", "Word32", "Word64" + ] + +{-# LINE 601 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnInt8, hsnInt16, hsnInt32, hsnInt64 + ] + = map + (mkRV hsnModIntlTypes) + [ "Int8" , "Int16" , "Int32" , "Int64" + ] + +{-# LINE 614 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnFromRational] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlFractional) + [ "fromRational" ] + +{-# LINE 625 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnMkRatio] + = map + (mkRV hsnModIntlBase) -- (mkRV hsnModIntlRatio) + [ ":%" ] + +{-# LINE 640 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnIO,hsnHandle,hsnByteArray,hsnRealWorld] + = map + (mkRV hsnModIntlBase) + [ "IO", "Handle", "ByteArray", "RealWorld" ] + +{-# LINE 655 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnDataStringFromString] + = map + (mkRV hsnModDataString) + [ "fromString" ] + +{-# LINE 666 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnEhcRunMain] + = map + (mkRV hsnModIntlRun) + [ "ehcRunMain" ] + +{-# LINE 677 "src/ehc/Base/HsName/Builtin.chs" #-} +[hsnStackTracePush] + = map + (mkRV hsnModIntlBase) + [ "pushExplicitStackTrace" ] + +{-# LINE 688 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnModBuiltin = mkHNm "#Builtin" + +{-# LINE 696 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnUHC = hsnFromString "UHC" + +{-# LINE 700 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnData = hsnFromString "Data" + +{-# LINE 704 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnIsInPrelude :: HsName -> Bool +hsnIsInPrelude n + = case hsnInitLast n of + ((m:_),_) -> m == hsnUHC + _ -> False + +{-# LINE 712 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnModIntlGenericsTuple = hsnPrefixQual hsnUHC (mkHNm "Generics.Tuple") + +{-# LINE 716 "src/ehc/Base/HsName/Builtin.chs" #-} +-- hsnModIntlRatio = hsnPrefixQual hsnUHC (hsnFromString "Ratio") +-- hsnModIntlReal = hsnPrefixQual hsnUHC (hsnFromString "Real") +-- hsnModIntlFractional = hsnPrefixQual hsnUHC (hsnFromString "Fractional") +hsnModIntlBase = hsnPrefixQual hsnUHC (hsnFromString "Base") +hsnModIntlEnum = hsnPrefixQual hsnUHC (hsnFromString "Enum") +hsnModIntlIx = hsnPrefixQual hsnUHC (hsnFromString "Ix") +hsnModIntlNum = hsnPrefixQual hsnUHC (hsnFromString "Num") +hsnModIntlGenerics = hsnPrefixQual hsnUHC (hsnFromString "Generics") +hsnModIntlRead = hsnPrefixQual hsnUHC (hsnFromString "Read") +hsnModIntlShow = hsnPrefixQual hsnUHC (hsnFromString "Show") +hsnModPrelude = hsnFromString "Prelude" + +{-# LINE 730 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnModDataString = hsnPrefixQual hsnData (hsnFromString "String") + +{-# LINE 734 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnModIntlTypes = hsnPrefixQual hsnUHC (hsnFromString "Types") +hsnModIntlPtr = hsnPrefixQual hsnUHC (hsnFromString "Ptr") +hsnModIntlRun = hsnPrefixQual hsnUHC (hsnFromString "Run") +hsnModIntlIOBase = hsnPrefixQual hsnUHC (hsnFromString "IOBase") +hsnModIntlStackTrace = hsnPrefixQual hsnUHC (hsnFromString "StackTrace") + +{-# LINE 746 "src/ehc/Base/HsName/Builtin.chs" #-} +-- Dict datatype name for class name, only used when `not ehcCfgClassViaRec' +hsnClass2Dict :: HsName -> HsName +hsnClass2Dict = mkHNmHidden . hsnPrefix "Dict_" + +{-# LINE 752 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnClass2Kind :: HsName -> HsName +hsnClass2Kind = mkHNmHidden . hsnPrefix "ClassKind_" + +{-# LINE 757 "src/ehc/Base/HsName/Builtin.chs" #-} +hsnClass2Polarity :: HsName -> HsName +hsnClass2Polarity = mkHNmHidden . hsnPrefix "ClassPolarity_" + +{-# LINE 766 "src/ehc/Base/HsName/Builtin.chs" #-} +-- | a hidden name corresponding to visible names +hsnNm2Gener :: HsName -> HsName +hsnNm2Gener = mkHNmHidden -- . hsnPrefix "Dict-" + +-- | a hidden, but programmer accessible, name for representation type synonym, for datatypes +hsnNm2GenerReprSyn :: Int -> HsName -> HsName +hsnNm2GenerReprSyn i = mkHNmSpecial . hsnPrefix ("Rep" ++ show i) + +-- | a hidden, but programmer accessible, name for representation type synonym, for tuples +hsnNm2GenerReprTuple :: Int -> Int -> HsName +hsnNm2GenerReprTuple arity i = hsnNm2GenerReprSyn i (mkHNm $ "Tuple" ++ show arity) + +-- | a hidden name for representation datatype for a datatype +hsnNm2GenerDatatype :: HsName -> HsName +hsnNm2GenerDatatype = hsnNm2Gener . hsnPrefix ("D_") + +-- | a hidden name for representation datatype for a datatype constructor +hsnNm2GenerConstructor :: HsName -> HsName +hsnNm2GenerConstructor = hsnNm2Gener . hsnPrefix ("C_") + +-- | a hidden name for representation datatype for a datatype field selector +hsnNm2GenerSelector :: HsName -> HsName +hsnNm2GenerSelector = hsnNm2Gener . hsnPrefix ("S_") + +{-# LINE 796 "src/ehc/Base/HsName/Builtin.chs" #-} +builtinGenerClassNmL :: [HsName] +builtinGenerClassNmL + = [ bi i + | bi <- [ ehbnGenerClassConstructor + , ehbnGenerClassDatatype + , ehbnGenerClassSelector + ] + ] + where i = mkEHBuiltinNames (\_ n -> hsnQualified n) + +{-# LINE 812 "src/ehc/Base/HsName/Builtin.chs" #-} +data EHBuiltinNames + = EHBuiltinNames + { ehbnId :: HsName + , ehbnUndefined :: HsName + , ehbnError :: HsName + , ehbnPackedString :: HsName + , ehbnPackedStringToString :: HsName + , ehbnPrimAddInt :: HsName + , ehbnPrimGtInt :: HsName + , ehbnBoolTrue :: HsName + , ehbnBoolFalse :: HsName + , ehbnDataListAltNil :: HsName + , ehbnDataListAltCons :: HsName + , ehbnDataOrderingAltLT :: HsName + , ehbnDataOrderingAltEQ :: HsName + , ehbnDataOrderingAltGT :: HsName + , ehbnDataList :: HsName + , ehbnDataBool :: HsName + , ehbnPrelString :: HsName + , ehbnFunPtr :: HsName + , ehbnMap :: HsName + , ehbnBoolAnd :: HsName + , ehbnBoolOr :: HsName + , ehbnClassEq :: HsName + , ehbnClassEqFldEq :: HsName + , ehbnClassOrd :: HsName + , ehbnClassOrdFldCompare :: HsName + , ehbnDataOrdering :: HsName + , ehbnClassShow :: HsName + , ehbnClassShowFldShow :: HsName + , ehbnClassShowFldShowsPrec :: HsName + , ehbnPrelShowString :: HsName + , ehbnPrelShowParen :: HsName + , ehbnPrelConcat :: HsName + , ehbnPrelConcat2 :: HsName + , ehbnPrelConcatMap :: HsName + , ehbnPrelCompose :: HsName + , ehbnClassEnum :: HsName + , ehbnClassEnumFldFromEnum :: HsName + , ehbnClassEnumFldToEnum :: HsName + , ehbnClassEnumFldSucc :: HsName + , ehbnClassEnumFldPred :: HsName + , ehbnClassEnumFldEnumFrom :: HsName + , ehbnClassEnumFldEnumFromTo :: HsName + , ehbnClassEnumFldEnumFromThen :: HsName + , ehbnClassEnumFldEnumFromThenTo :: HsName + , ehbnClassBounded :: HsName + , ehbnClassBoundedFldMinBound :: HsName + , ehbnClassBoundedFldMaxBound :: HsName + , ehbnPrimLtInt :: HsName + -- for generic deriving + , ehbnGenerClassRepresentableN :: Int -> HsName + , ehbnGenerClassRepresentableNFldFrom :: Int -> HsName + , ehbnGenerClassRepresentableNFldTo :: Int -> HsName + , ehbnGenerClassDatatype :: HsName + , ehbnGenerClassDatatypeFldName :: HsName + , ehbnGenerClassDatatypeFldModule :: HsName + , ehbnGenerClassSelector :: HsName + , ehbnGenerClassSelectorFldName :: HsName + , ehbnGenerDataNoSelector :: HsName + , ehbnGenerClassConstructor :: HsName + , ehbnGenerClassConstructorFldName :: HsName + , ehbnGenerClassConstructorFldFixity :: HsName + , ehbnGenerClassConstructorFldIsRec :: HsName + , ehbnGenerDataVoid1 :: HsName + , ehbnGenerDataUnit1 :: HsName + , ehbnGenerDataUnit1AltU1 :: HsName + , ehbnGenerDataKonst1 :: HsName + , ehbnGenerDataKonst1AltK1 :: HsName + , ehbnGenerDataMeta1 :: HsName + , ehbnGenerDataMeta1AltM1 :: HsName + , ehbnGenerDataFixity :: HsName + , ehbnGenerDataFixityAltPrefix :: HsName + , ehbnGenerDataFixityAltInfix :: HsName + , ehbnGenerDataAssociativity :: HsName + , ehbnGenerDataAssociativityAltLeft :: HsName + , ehbnGenerDataAssociativityAltRight :: HsName + , ehbnGenerDataAssociativityAltNot :: HsName + , ehbnGenerDataSum :: HsName + , ehbnGenerDataSumAltLeft :: HsName + , ehbnGenerDataSumAltRight :: HsName + , ehbnGenerDataProd :: HsName + , ehbnGenerDataProdAltProd :: HsName + , ehbnGenerDataPar0 :: HsName + , ehbnGenerDataPar1 :: HsName + , ehbnGenerDataPar1AltPar1 :: HsName + , ehbnGenerDataRec0 :: HsName + , ehbnGenerDataRec1 :: HsName + , ehbnGenerDataRec1AltRec1 :: HsName + , ehbnGenerDataComp1 :: HsName + , ehbnGenerDataComp1AltComp1 :: HsName + , ehbnGenerDataMetaB :: HsName + , ehbnGenerDataMetaR :: HsName + , ehbnGenerDataMetaP :: HsName + , ehbnGenerDataMetaD :: HsName + , ehbnGenerDataMetaC :: HsName + , ehbnGenerDataMetaS :: HsName + , ehbnGenerDataMetaDN :: Int -> HsName + , ehbnGenerDataMetaCN :: Int -> HsName + , ehbnGenerDataMetaS1 :: HsName + , ehbnGenerTupleRepresentableN :: Int -> Int -> HsName + , ehbnInt8 :: HsName + , ehbnInt16 :: HsName + , ehbnInt32 :: HsName + , ehbnInt64 :: HsName + , ehbnWord :: HsName + , ehbnWord8 :: HsName + , ehbnWord16 :: HsName + , ehbnWord32 :: HsName + , ehbnWord64 :: HsName + , ehbnFloat :: HsName + , ehbnDouble :: HsName + , ehbnPackedStringToInteger :: HsName + , ehbnPrimIntToInteger :: HsName + , ehbnFromInteger :: HsName + , ehbnIO :: HsName + , ehbnHandle :: HsName + , ehbnByteArray :: HsName + , ehbnRealWorld :: HsName + , ehbnClassIx :: HsName + , ehbnClassIxFldRange :: HsName + , ehbnClassIxFldIndex :: HsName + , ehbnClassIxFldInRange :: HsName + , ehbnClassRead :: HsName + , ehbnClassReadFldRead :: HsName + , ehbnClassReadFldReadsPrec :: HsName + , ehbnPrelLex :: HsName + , ehbnPrelReadParen :: HsName + , ehbnPrimEqChar :: HsName + , ehbnAddr :: HsName + -- , ehbnStackTracePush :: HsName + } + +mkEHBuiltinNames :: (IdOccKind -> HsName -> HsName) -> EHBuiltinNames +mkEHBuiltinNames f + = EHBuiltinNames + { ehbnId = f IdOcc_Val hsnPrelId + , ehbnUndefined = f IdOcc_Val hsnUndefined + , ehbnError = f IdOcc_Val hsnError + , ehbnPackedString = f IdOcc_Type hsnPackedString + , ehbnPackedStringToString = f IdOcc_Val hsnPackedStringToString + , ehbnPrimAddInt = f IdOcc_Val hsnPrimAddInt + , ehbnPrimGtInt = f IdOcc_Val hsnPrimGtInt + , ehbnBoolTrue = f IdOcc_Val hsnTrue + , ehbnBoolFalse = f IdOcc_Val hsnFalse + , ehbnDataListAltNil = f IdOcc_Val hsnDataListAltNil + , ehbnDataListAltCons = f IdOcc_Val hsnDataListAltCons + , ehbnDataOrderingAltLT = f IdOcc_Val hsnDataOrderingAltLT + , ehbnDataOrderingAltEQ = f IdOcc_Val hsnDataOrderingAltEQ + , ehbnDataOrderingAltGT = f IdOcc_Val hsnDataOrderingAltGT + , ehbnDataBool = f IdOcc_Type hsnBool + , ehbnDataList = f IdOcc_Type hsnDataList + , ehbnPrelString = f IdOcc_Type hsnPrelString + , ehbnFunPtr = f IdOcc_Type hsnFunPtr + , ehbnMap = f IdOcc_Type hsnMap + , ehbnBoolAnd = f IdOcc_Val hsnBoolAnd + , ehbnBoolOr = f IdOcc_Val hsnBoolOr + , ehbnClassEq = f IdOcc_Class hsnClassEq + , ehbnClassEqFldEq = f IdOcc_Val hsnClassEqFldEq + , ehbnClassOrd = f IdOcc_Class hsnClassOrd + , ehbnClassOrdFldCompare = f IdOcc_Val hsnClassOrdFldCompare + , ehbnDataOrdering = f IdOcc_Type hsnDataOrdering + , ehbnClassShow = f IdOcc_Class hsnClassShow + , ehbnClassShowFldShow = f IdOcc_Val hsnClassShowFldShow + , ehbnClassShowFldShowsPrec = f IdOcc_Val hsnClassShowFldShowsPrec + , ehbnPrelShowString = f IdOcc_Val hsnPrelShowString + , ehbnPrelShowParen = f IdOcc_Val hsnPrelShowParen + , ehbnPrelConcat = f IdOcc_Val hsnPrelConcat + , ehbnPrelConcat2 = f IdOcc_Val hsnPrelConcat2 + , ehbnPrelConcatMap = f IdOcc_Val hsnPrelConcatMap + , ehbnPrelCompose = f IdOcc_Val hsnPrelCompose + , ehbnClassEnum = f IdOcc_Class hsnClassEnum + , ehbnClassEnumFldFromEnum = f IdOcc_Val hsnClassEnumFldFromEnum + , ehbnClassEnumFldToEnum = f IdOcc_Val hsnClassEnumFldToEnum + , ehbnClassEnumFldSucc = f IdOcc_Val hsnClassEnumFldSucc + , ehbnClassEnumFldPred = f IdOcc_Val hsnClassEnumFldPred + , ehbnClassEnumFldEnumFrom = f IdOcc_Val hsnEnumFrom + , ehbnClassEnumFldEnumFromTo = f IdOcc_Val hsnEnumFromTo + , ehbnClassEnumFldEnumFromThen = f IdOcc_Val hsnEnumFromThen + , ehbnClassEnumFldEnumFromThenTo = f IdOcc_Val hsnEnumFromThenTo + , ehbnClassBounded = f IdOcc_Class hsnClassBounded + , ehbnClassBoundedFldMinBound = f IdOcc_Val hsnClassBoundedFldMinBound + , ehbnClassBoundedFldMaxBound = f IdOcc_Val hsnClassBoundedFldMaxBound + , ehbnPrimLtInt = f IdOcc_Val hsnPrimLtInt + -- for generic deriving + , ehbnGenerClassRepresentableN = \n -> f IdOcc_Class (mkGenerRVN n "Representable" ) + , ehbnGenerClassRepresentableNFldFrom = \n -> f IdOcc_Val (mkGenerRVN n "from" ) + , ehbnGenerClassRepresentableNFldTo = \n -> f IdOcc_Val (mkGenerRVN n "to" ) + , ehbnGenerClassDatatype = f IdOcc_Class (mkGenerRV "Datatype" ) + , ehbnGenerClassDatatypeFldName = f IdOcc_Val (mkGenerRV "datatypeName" ) + , ehbnGenerClassDatatypeFldModule = f IdOcc_Val (mkGenerRV "moduleName" ) + , ehbnGenerClassSelector = f IdOcc_Class (mkGenerRV "Selector" ) + , ehbnGenerClassSelectorFldName = f IdOcc_Val (mkGenerRV "selName" ) + , ehbnGenerDataNoSelector = f IdOcc_Type (mkGenerRV "NoSelector" ) + , ehbnGenerClassConstructor = f IdOcc_Class (mkGenerRV "Constructor" ) + , ehbnGenerClassConstructorFldName = f IdOcc_Val (mkGenerRV "conName" ) + , ehbnGenerClassConstructorFldFixity = f IdOcc_Val (mkGenerRV "conFixity" ) + , ehbnGenerClassConstructorFldIsRec = f IdOcc_Val (mkGenerRV "conIsRecord" ) + , ehbnGenerDataVoid1 = f IdOcc_Type (mkGenerRV "V1" ) + , ehbnGenerDataUnit1 = f IdOcc_Type (mkGenerRV "U1" ) + , ehbnGenerDataUnit1AltU1 = f IdOcc_Val (mkGenerRV "U1" ) + , ehbnGenerDataKonst1 = f IdOcc_Type (mkGenerRV "K1" ) + , ehbnGenerDataKonst1AltK1 = f IdOcc_Val (mkGenerRV "K1" ) + , ehbnGenerDataMeta1 = f IdOcc_Type (mkGenerRV "M1" ) + , ehbnGenerDataMeta1AltM1 = f IdOcc_Val (mkGenerRV "M1" ) + , ehbnGenerDataFixity = f IdOcc_Type (mkGenerRV "Fixity" ) + , ehbnGenerDataFixityAltPrefix = f IdOcc_Val (mkGenerRV "Prefix" ) + , ehbnGenerDataFixityAltInfix = f IdOcc_Val (mkGenerRV "Infix" ) + , ehbnGenerDataAssociativity = f IdOcc_Type (mkGenerRV "Associativity" ) + , ehbnGenerDataAssociativityAltLeft = f IdOcc_Val (mkGenerRV "LeftAssociative" ) + , ehbnGenerDataAssociativityAltRight = f IdOcc_Val (mkGenerRV "RightAssociative" ) + , ehbnGenerDataAssociativityAltNot = f IdOcc_Val (mkGenerRV "NotAssociative" ) + , ehbnGenerDataSum = f IdOcc_Type (mkGenerRV ":+:" ) + , ehbnGenerDataSumAltLeft = f IdOcc_Val (mkGenerRV "L1" ) + , ehbnGenerDataSumAltRight = f IdOcc_Val (mkGenerRV "R1" ) + , ehbnGenerDataProd = f IdOcc_Type (mkGenerRV ":*:" ) + , ehbnGenerDataProdAltProd = f IdOcc_Val (mkGenerRV ":*:" ) + , ehbnGenerDataPar0 = f IdOcc_Type (mkGenerRV "Par0" ) + , ehbnGenerDataPar1 = f IdOcc_Type (mkGenerRV "Par1" ) + , ehbnGenerDataPar1AltPar1 = f IdOcc_Val (mkGenerRV "Par1" ) + , ehbnGenerDataRec0 = f IdOcc_Type (mkGenerRV "Rec0" ) + , ehbnGenerDataRec1 = f IdOcc_Type (mkGenerRV "Rec1" ) + , ehbnGenerDataRec1AltRec1 = f IdOcc_Val (mkGenerRV "Rec1" ) + , ehbnGenerDataComp1 = f IdOcc_Type (mkGenerRV ":.:" ) + , ehbnGenerDataComp1AltComp1 = f IdOcc_Val (mkGenerRV "Comp1" ) + , ehbnGenerDataMetaB = f IdOcc_Type (mkGenerRV "B" ) + , ehbnGenerDataMetaR = f IdOcc_Type (mkGenerRV "R" ) + , ehbnGenerDataMetaP = f IdOcc_Type (mkGenerRV "P" ) + , ehbnGenerDataMetaD = f IdOcc_Type (mkGenerRV "D" ) + , ehbnGenerDataMetaC = f IdOcc_Type (mkGenerRV "C" ) + , ehbnGenerDataMetaS = f IdOcc_Type (mkGenerRV "S" ) + , ehbnGenerDataMetaDN = \n -> f IdOcc_Type (mkGenerRVN n "D" ) + , ehbnGenerDataMetaCN = \n -> f IdOcc_Type (mkGenerRVN n "C" ) + , ehbnGenerDataMetaS1 = f IdOcc_Type (mkGenerRV "S1" ) + , ehbnGenerTupleRepresentableN = \n a -> f IdOcc_Type (mkRV' hsnModIntlGenericsTuple $ hsnNm2GenerReprTuple a n) + , ehbnInt8 = f IdOcc_Type hsnInt8 + , ehbnInt16 = f IdOcc_Type hsnInt16 + , ehbnInt32 = f IdOcc_Type hsnInt32 + , ehbnInt64 = f IdOcc_Type hsnInt64 + , ehbnWord = f IdOcc_Type hsnWord + , ehbnWord8 = f IdOcc_Type hsnWord8 + , ehbnWord16 = f IdOcc_Type hsnWord16 + , ehbnWord32 = f IdOcc_Type hsnWord32 + , ehbnWord64 = f IdOcc_Type hsnWord64 + , ehbnFloat = f IdOcc_Type hsnFloat + , ehbnDouble = f IdOcc_Type hsnDouble + , ehbnPackedStringToInteger = f IdOcc_Val hsnPackedStringToInteger + , ehbnPrimIntToInteger = f IdOcc_Val hsnPrimIntToInteger + , ehbnFromInteger = f IdOcc_Val hsnFromInteger + , ehbnIO = f IdOcc_Type hsnIO + , ehbnHandle = f IdOcc_Type hsnHandle + , ehbnByteArray = f IdOcc_Type hsnByteArray + , ehbnRealWorld = f IdOcc_Type hsnRealWorld + , ehbnClassIx = f IdOcc_Class hsnClassIx + , ehbnClassIxFldRange = f IdOcc_Val hsnClassIxFldRange + , ehbnClassIxFldIndex = f IdOcc_Val hsnClassIxFldIndex + , ehbnClassIxFldInRange = f IdOcc_Val hsnClassIxFldInRange + , ehbnClassRead = f IdOcc_Class hsnClassRead + , ehbnClassReadFldRead = f IdOcc_Val hsnClassReadFldRead + , ehbnClassReadFldReadsPrec = f IdOcc_Val hsnClassReadFldReadsPrec + , ehbnPrelLex = f IdOcc_Val hsnPrelLex + , ehbnPrelReadParen = f IdOcc_Val hsnPrelReadParen + , ehbnPrimEqChar = f IdOcc_Val hsnPrimEqChar + , ehbnAddr = f IdOcc_Type hsnAddr + -- , ehbnStackTracePush = f IdOcc_Val hsnStackTracePush + } + diff --git a/src/UHC/Light/Compiler/Base/Optimize.hs b/src/UHC/Light/Compiler/Base/Optimize.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Optimize.hs @@ -0,0 +1,181 @@ +module UHC.Light.Compiler.Base.Optimize +( Optimize (..) +, allOptimizeMp +, OptimizeOption (..) +, OptimizeOptionValue (..) +, OptimizeOptionMp +, optimizeOptionMpSingleton +, optimizeOptionStictnessAnalysisQuant +, allOptimizeOptionMp +, allOptimizeOptionMpAnyOption +, OptimizationLevel (..) +, OptimizationScope (..), allOptimScopeMp +, optimizeRequiresClosure +, OptimizeS +, OptimizationLevelMp +, optimizationLevelMp ) +where +import UHC.Light.Compiler.Base.Common +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List +import UHC.Util.AssocL +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Util.Binary +import UHC.Util.Serialize + + +{-# LINE 29 "src/ehc/Base/Optimize.chs" #-} +-- | individual optimizations, unit of turning off/on. (Assumption) Names of alternatives must start with Optimize_ +data Optimize + = Optimize_GrinLocal -- Grin: local base optimizations + | Optimize_StrictnessAnalysis -- Core: relevance analysis + deriving (Eq,Ord,Enum,Show,Bounded) + +{-# LINE 46 "src/ehc/Base/Optimize.chs" #-} +-- | All optimizations, mapped to from string representation derived via show. +-- | See also Optimize def for assumption. +allOptimizeMp :: Map.Map String Optimize +allOptimizeMp + = Map.fromList [ (drop lenPrefix $ show o, o) | o <- [minBound .. maxBound] ] + where lenPrefix = length "Optimize_" + +{-# LINE 72 "src/ehc/Base/Optimize.chs" #-} +-- | extra optimization specific flags/config/tuning/option/etc +data OptimizeOption + = OptimizeOption_StrictnessAnalysisQuant + deriving (Eq,Ord,Show) + +{-# LINE 83 "src/ehc/Base/Optimize.chs" #-} +-- | extra optimization specific flags/config/tuning/option/etc +data OptimizeOptionValue + = OptimizeOptionValue_StrictnessAnalysis_NoQuant -- no quantification of relevance type + | OptimizeOptionValue_StrictnessAnalysis_Quant -- (default) quantification of relevance type + | OptimizeOptionValue_StrictnessAnalysis_QuantInstantiate -- quant + later instantiation + deriving (Eq,Ord,Show,Enum) + +{-# LINE 96 "src/ehc/Base/Optimize.chs" #-} +-- | the map which holds for each optimization additional (optional) configuration +type OptimizeOptionMp' val = Map.Map Optimize (Map.Map OptimizeOption val) +type OptimizeOptionMp = OptimizeOptionMp' OptimizeOptionValue + +{-# LINE 102 "src/ehc/Base/Optimize.chs" #-} +optimizeOptionMpSingleton :: Optimize -> OptimizeOption -> OptimizeOptionValue -> OptimizeOptionMp +optimizeOptionMpSingleton o oo v = Map.singleton o (Map.singleton oo v) + +{-# LINE 107 "src/ehc/Base/Optimize.chs" #-} +-- | quantification options related to strictness analysis +optimizeOptionStictnessAnalysisQuant :: OptimizeOptionMp -> OptimizeOptionValue +optimizeOptionStictnessAnalysisQuant m + = case mapLookup2 Optimize_StrictnessAnalysis OptimizeOption_StrictnessAnalysisQuant m of + Just oo -> maybe OptimizeOptionValue_StrictnessAnalysis_Quant id $ extr oo + _ -> OptimizeOptionValue_StrictnessAnalysis_Quant + where extr = Just + +{-# LINE 130 "src/ehc/Base/Optimize.chs" #-} +-- | All optimization options, map from optimize flag to allowed range of +allOptimizeOptionMp + :: OptimizeOptionMp' + ( OptimizeOptionValue -- default + , (OptimizeOptionValue, OptimizeOptionValue) -- min, max + ) +allOptimizeOptionMp + = Map.fromList $ assocLMapElt Map.fromList + [ ( Optimize_StrictnessAnalysis + , [ ( OptimizeOption_StrictnessAnalysisQuant + , ( OptimizeOptionValue_StrictnessAnalysis_Quant + , (OptimizeOptionValue_StrictnessAnalysis_NoQuant, OptimizeOptionValue_StrictnessAnalysis_QuantInstantiate) + ) + ) + ] + ) + ] + +{-# LINE 154 "src/ehc/Base/Optimize.chs" #-} +-- | Just get any optimize option (if available) with default +allOptimizeOptionMpAnyOption :: Optimize -> (OptimizeOption, OptimizeOptionValue) +allOptimizeOptionMpAnyOption o + = panicJust "allOptimizeOptionMpAnyOption" + $ do { om <- Map.lookup o allOptimizeOptionMp + ; if Map.null om + then panic ("allOptimizeOptionMpAnyOption: " ++ show o) + else do { let (oo,(dflt,_)) = Map.findMin om + ; return (oo,dflt) + } + } + +{-# LINE 176 "src/ehc/Base/Optimize.chs" #-} +data OptimizationLevel + = OptimizationLevel_Off -- no optimizations : -O0 + | OptimizationLevel_Normal -- easy and cheap optimizations : -O1 (default) + | OptimizationLevel_Much -- more and expensive optimizations : -O2 + | OptimizationLevel_Full -- throw everything in it : -O3 + deriving (Eq,Ord,Show,Enum,Bounded) + +{-# LINE 185 "src/ehc/Base/Optimize.chs" #-} +-- | Scope of optimizations, increasingly more global +data OptimizationScope + = OptimizationScope_PerModule -- per module + | OptimizationScope_WholeCore -- whole program, starting with Core + deriving (Eq,Ord,Enum,Bounded) + +instance Show OptimizationScope where + show OptimizationScope_PerModule = "permodule" + show OptimizationScope_WholeCore = "perwholecore" + +allOptimScopeMp :: Map.Map String OptimizationScope +allOptimScopeMp = str2stMp + +{-# LINE 214 "src/ehc/Base/Optimize.chs" #-} +type OptimizeRequiresMp = Map.Map Optimize OptimizeS + +{-# LINE 218 "src/ehc/Base/Optimize.chs" #-} +optimizeRequiresMp :: OptimizeRequiresMp +optimizeRequiresMp + = Map.map Set.fromList $ Map.fromList + [ ( Optimize_StrictnessAnalysis + , [ ] + ) + ] + +{-# LINE 232 "src/ehc/Base/Optimize.chs" #-} +-- | transitive closure of required optimizations +optimizeRequiresClosure :: OptimizeS -> OptimizeS +optimizeRequiresClosure os + = closes Set.empty os + where close o os + = closes (Set.insert o os) + $ Map.findWithDefault Set.empty o optimizeRequiresMp + `Set.difference` os + closes = Set.fold close + +{-# LINE 248 "src/ehc/Base/Optimize.chs" #-} +type OptimizeS = Set.Set Optimize + +{-# LINE 252 "src/ehc/Base/Optimize.chs" #-} +-- | mapping to group of optimizations +type OptimizationLevelMp = Map.Map OptimizationLevel OptimizeS + +{-# LINE 257 "src/ehc/Base/Optimize.chs" #-} +-- | map from level to optimizations, specified as increments relative to previous in Enum ordering of level +optimizationLevelMp :: OptimizationLevelMp +optimizationLevelMp + = (\m -> fst $ + foldl (\(m,s) (l,o) -> let s' = Set.union s o in (Map.insert l s' m, s')) + (m, Set.empty) + [ (l, Map.findWithDefault Set.empty l m) | l <- [minBound .. maxBound] ] + ) + $ Map.map Set.fromList + $ Map.fromList + $ [ ( OptimizationLevel_Off + , [ ] + ) + , ( OptimizationLevel_Much + , [ ] + ) + , ( OptimizationLevel_Full + , [] -- [ Optimize_StrictnessAnalysis ] + ) + ] + diff --git a/src/UHC/Light/Compiler/Base/PackageDatabase.hs b/src/UHC/Light/Compiler/Base/PackageDatabase.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/PackageDatabase.hs @@ -0,0 +1,343 @@ +module UHC.Light.Compiler.Base.PackageDatabase +( pkgDbLookup +, pkgWritePkgOptionAsCfg +, pkgDbFromDirs +, pkgDbSelectBySearchFilter +, PkgModulePartition +, pkgPartInclDirs +, pkgExposedPackages +, pkgDbFreeze +, fileLocSearch ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Error +import qualified UHC.Light.Compiler.Config as Cfg +import UU.Parsing +import UHC.Util.ParseUtils +import UHC.Light.Compiler.Base.Parser2 +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.ParseUtils +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Version +import Data.List +import Data.Maybe +import Data.Char +import System.Environment +import System.Directory +import Control.Monad +import Control.Monad.State +import System.IO +import System.Exit +import System.Environment +import UHC.Util.FPath +import UHC.Util.Utils +import UHC.Util.Debug + +{-# LINE 50 "src/ehc/Base/PackageDatabase.chs" #-} +-- | The config file name, wrapped inside a Maybe when it can indeed be created +pkgCfgFPath :: Bool -> FPath -> IO (Maybe (FPath, FilePath)) +pkgCfgFPath createIfAbsent pkgfp = do + when createIfAbsent $ createDirectoryIfMissing True pkgdir + isDir <- doesDirectoryExist pkgdir -- remove this...?? + if isDir + then return $ Just (fpathSetDir pkgdir $ fpathFromStr Cfg.ehcPkgConfigfileName, pkgdir) + else return Nothing + where pkgdir = fpathToStr pkgfp + +{-# LINE 66 "src/ehc/Base/PackageDatabase.chs" #-} +-- | union 2 PackageMp, choosing the first one in the ordering on the fly +pkgMpUnion :: PackageMp -> PackageMp -> PackageMp +pkgMpUnion + = Map.unionWith (Map.unionWith cmb) + where cmb p1s p2s = head $ groupBy eqp $ sortBy cmpp $ p1s ++ p2s + -- cmb = (++) + eqp p1 p2 = pkginfoOrder p1 == pkginfoOrder p2 + cmpp p1 p2 = pkginfoOrder p1 `compare` pkginfoOrder p2 + +-- looking up just picks the first one +-- TBD: fix this: error/warning, etc +pkgMpLookup :: PkgKey -> PackageMp -> Maybe PackageInfo +pkgMpLookup (k1,k2) m1 + = fmap head $ mapLookup2 k1 k2 m1 + +-- | Get an element from a non empty PackageMp +pkgMpFindMin :: PackageMp -> PackageInfo +pkgMpFindMin m1 + = head ps + where (_,m2) = Map.findMin m1 + (_,ps) = Map.findMin m2 + +pkgMpDifference :: PackageMp -> PackageMp -> PackageMp +pkgMpDifference mp mpDiff + = foldr diff mp $ Map.toList mpDiff + where diff (k1,mp2Diff) mp + = case Map.lookup k1 mp of + Just mp2 | Map.null m -> Map.delete k1 mp + | otherwise -> Map.insert k1 m mp + where m = Map.difference mp2 mp2Diff + _ -> mp + +pkgMpUnions :: [PackageMp] -> PackageMp +pkgMpUnions = foldr pkgMpUnion Map.empty + +pkgMpSingletonL :: PkgKey -> [PackageInfo] -> PackageMp +pkgMpSingletonL (k1,k2) i = Map.singleton k1 (Map.singleton k2 i) + +pkgMpSingleton :: PkgKey -> PackageInfo -> PackageMp +pkgMpSingleton k i = pkgMpSingletonL k [i] + +{-# LINE 109 "src/ehc/Base/PackageDatabase.chs" #-} +mod2pkgMpUnion :: Module2PackageMp -> Module2PackageMp -> Module2PackageMp +mod2pkgMpUnion = Map.unionWith (++) + +mod2pkgMpUnions :: [Module2PackageMp] -> Module2PackageMp +mod2pkgMpUnions = foldr mod2pkgMpUnion Map.empty + +{-# LINE 121 "src/ehc/Base/PackageDatabase.chs" #-} +pkgDbLookup:: PkgKey -> PackageDatabase -> Maybe PackageInfo +pkgDbLookup key db + = pkgMpLookup key $ pkgDbPkgMp db + +pkgMpSelectMpOnKey :: PkgKey -> PackageMp -> PackageMp +pkgMpSelectMpOnKey key@(pkgNm,mbVersion) mp + = case mbVersion of + Just pkgVersion -> case lkup of + Just m -> maybe emptyPackageMp (\i -> pkgMpSingletonL key i) $ Map.lookup mbVersion m + _ -> emptyPackageMp + _ -> maybe emptyPackageMp (Map.singleton pkgNm) lkup + where lkup = Map.lookup pkgNm mp + +pkgDbSelectMpOnKey :: PkgKey -> PackageDatabase -> PackageMp +pkgDbSelectMpOnKey key@(pkgNm,mbVersion) db = pkgMpSelectMpOnKey key $ pkgDbPkgMp db +{- + = case mbVersion of + Just pkgVersion -> case lkup of + Just m -> maybe emptyPackageMp (\i -> pkgMpSingletonL key i) $ Map.lookup mbVersion m + _ -> emptyPackageMp + _ -> maybe emptyPackageMp (Map.singleton pkgNm) lkup + where lkup = Map.lookup pkgNm $ pkgDbPkgMp db +-} + +{-# LINE 151 "src/ehc/Base/PackageDatabase.chs" #-} +-- | Write pkg config file into dir, using PkgOption +pkgWritePkgOptionAsCfg :: PkgOption -> FPath -> IO () +pkgWritePkgOptionAsCfg pkgopt pkgfp + = do mbCfgFP@(~(Just (cfgFP, pkgdir))) <- pkgCfgFPath True pkgfp + if isJust mbCfgFP + then writeFile (fpathToStr cfgFP) $ unlines $ map (\(k,v) -> k ++ ": " ++ v) + [ ("exposed-modules", unwords $ pkgoptExposedModules pkgopt ) + , ("build-depends" , unwords $ pkgoptBuildDepends pkgopt ) + ] + else return () + +{-# LINE 171 "src/ehc/Base/PackageDatabase.chs" #-} +-- parse content of a package config file, yielding updates to PackageInfo, ignoring unused fields +pkgCfgParse :: String -> [PackageInfo -> PackageInfo] +pkgCfgParse s + = map (\(k,v) -> case map toLower k of + "exposed-modules" -> add (\ns i -> i {pkginfoExposedModules = Set.fromList ns}) parseModuleNames v + "build-depends" -> add (\ns i -> i {pkginfoBuildDepends = Set.fromList ns}) parsePkgKeys v + "exposed" -> add (\ex i -> i {pkginfoIsExposed = ex }) parseBool v + _ -> id + ) $ Map.toList kvs + where add upd parse v = maybe id upd $ parse v + (kvs,_) = foldr p (Map.empty,"") $ lines s + p s (kvs,saccum) + = case elemIndex ':' s of + Just colpos -> (Map.insert k (appendaccum v) kvs, "") + where (k,_:v) = splitAt colpos s + _ -> (kvs,appendaccum s) + where appendaccum s | null saccum = s + | otherwise = s ++ " " ++ saccum + +{-# LINE 192 "src/ehc/Base/PackageDatabase.chs" #-} +-- | For rhs of field 'exposed-modules' +pModuleNames :: P [HsName] +pModuleNames = pList (tokMkQName <$> (pQConidTk <|> pConidTk)) + +parseModuleNames :: String -> Maybe [HsName] +parseModuleNames = parseString (hsScanOpts defaultEHCOpts) pModuleNames + +{-# LINE 201 "src/ehc/Base/PackageDatabase.chs" #-} +-- | For rhs of field 'exposed' +pBool :: P Bool +pBool = True <$ pKeyTk "True" <|> False <$ pKeyTk "False" + +parseBool :: String -> Maybe Bool +parseBool = parseString (defaultScanOpts {scoKeywordsTxt = Set.fromList ["True","False"]}) pBool + +{-# LINE 214 "src/ehc/Base/PackageDatabase.chs" #-} +-- read content of package dir + config file +pkgMpFromDirFile :: EHCOpts -> PkgKey -> Int -> FPath -> IO PackageMp +pkgMpFromDirFile opts pkgkey order pkgfp + = do -- print pkgfp + -- print mbKey + -- isDir <- doesDirectoryExist pkgdir + mbCfgFP@(~(Just (cfgFP, pkgdir))) <- pkgCfgFPath False pkgfp + if isJust mbCfgFP -- isDir + then do { let fpCfg = fpathToStr cfgFP + pkgInfo = PackageInfo (mkPkgFileLoc pkgkey pkgdir) order Set.empty Set.empty True + ; cfgExists <- doesFileExist fpCfg + ; pm <- if cfgExists + then do h <- openFile fpCfg ReadMode + cfg <- hGetContents h + let i = foldr ($) pkgInfo (pkgCfgParse cfg) + i `seq` hClose h + return $ pkgMpSingleton pkgkey i + else return $ pkgMpSingleton pkgkey pkgInfo + -- ; print pm + ; return pm + } + else return Map.empty + -- where pkgdir = fpathToStr pkgfp + +-- read content of a dir containing package dirs +pkgMpFromDir :: EHCOpts -> Int -> FilePath -> IO PackageMp +pkgMpFromDir opts order fp + = do { isDir <- doesDirectoryExist fp + -- ; putStrLn ("dir-exists: " ++ show (fp,isDir)) + ; if isDir + then do { pkgWithVersions <- getDirectoryContents fp + ; let pkgWithVersionsBases = catMaybes $ + map (\f -> do { k <- parsePkgKey f + ; return $ (k,fpathPrependDir fp $ fpathFromStr $ + mkInternalPkgFileBase k (Cfg.installVariant opts) + (ehcOptTarget opts) (ehcOptTargetFlavor opts)) + }) + pkgWithVersions + -- putStrLn (show fp) + -- putStrLn (show pkgWithVersions) + -- putStrLn (show pkgWithVersionsBases) + ; mps <- mapM (\ (k,f) -> pkgMpFromDirFile opts k order f) pkgWithVersionsBases + -- ; putStrLn (show mps) + ; let mpsu = pkgMpUnions mps + ; return mpsu + } + else return Map.empty + } + +-- read and combine contents of multiple package database directories +pkgDbFromDirs :: EHCOpts -> [FilePath] -> IO PackageDatabase +pkgDbFromDirs opts fps + = do mps <- zipWithM (pkgMpFromDir opts) [1..] fps + let mpsu = pkgMpUnions mps + -- putStrLn ("unions: " ++ show mpsu) + return (emptyPackageDatabase {pkgDbPkgMp = mpsu}) + +{-# LINE 277 "src/ehc/Base/PackageDatabase.chs" #-} +data SearchFilterState + = SearchFilterState + { sfstMp :: PackageMp + , sfstErr :: [Err] + } + +-- | select from full package db, building a db according to the search filter, monadically +pkgDbSelectBySearchFilterM :: [PackageSearchFilter] -> PackageDatabase -> State SearchFilterState () +pkgDbSelectBySearchFilterM searchFilters fullDb + = all searchFilters + where all searchFilters = forM_ searchFilters sel + sel PackageSearchFilter_HideAll = modify $ \st -> st {sfstMp = emptyPackageMp} + sel (PackageSearchFilter_HidePkg keys) = forM_ keys (one (\_ -> return ()) (flip pkgMpDifference) (\_ m -> m)) + sel (PackageSearchFilter_ExposePkg keys) = forM_ keys (one onerec (\_ m -> m ) pkgMpUnion ) + one onerec cmbPresent cmbAbsent k = do + -- get the package info (inside a map) from the full db + let s = pkgDbSelectMpOnKey k fullDb + if Map.null s + -- if not in full db, error + then modify $ \st -> st {sfstErr = sfstErr st ++ [mkErr_NamesNotIntrod emptyRange "package" [mkHNm k]]} + else do + -- get the package map under construction + mp <- gets sfstMp + let inMp = pkgMpSelectMpOnKey k mp + if Map.null inMp + then do + -- if not yet encountered, add it, and recurse over the dependends + modify $ \st -> st {sfstMp = cmbAbsent s mp} + onerec s + else + modify $ \st -> st {sfstMp = cmbPresent s mp} + onerec s = all [PackageSearchFilter_ExposePkg $ Set.toList $ pkginfoBuildDepends $ pkgMpFindMin s] + +-- | select from full package db, building a db according to the search filter +pkgDbSelectBySearchFilter :: [PackageSearchFilter] -> PackageDatabase -> (PackageDatabase, [Err]) +pkgDbSelectBySearchFilter searchFilters fullDb + = (emptyPackageDatabase {pkgDbPkgMp = sfstMp st}, sfstErr st) + where st = execState (pkgDbSelectBySearchFilterM searchFilters fullDb) (SearchFilterState emptyPackageMp []) + +{-# LINE 337 "src/ehc/Base/PackageDatabase.chs" #-} +type PkgModulePartition + = ( PkgKey -- package + , String -- unused: dir + , [HsName] -- unused: mod names + ) + +{-# LINE 351 "src/ehc/Base/PackageDatabase.chs" #-} +-- | Obtain the locations to be included in general and per package (together with modules from pkg) +pkgPartInclDirs :: EHCOpts -> [PkgModulePartition] -> ([FilePath], Map.Map PkgKey (FilePath,[HsName])) +pkgPartInclDirs opts pkgKeyDirL + = ( [ mki kind dir | FileLoc kind dir <- ehcOptImportFileLocPath opts, not (null dir) ] + , Map.fromList $ catMaybes [ mkp p | p <- pkgKeyDirL ] + ) + where mki (FileLocKind_Dir ) d = d + mki (FileLocKind_Pkg _ _) d = Cfg.mkPkgIncludeDir $ filePathMkPrefix d + mki FileLocKind_PkgDb d = Cfg.mkPkgIncludeDir $ filePathMkPrefix d + mkp (k,_,ms) = fmap (\d -> (k, (Cfg.mkPkgIncludeDir $ filePathMkPrefix $ filelocDir $ pkginfoLoc d, ms))) $ pkgDbLookup k $ ehcOptPkgDb opts + +{-# LINE 371 "src/ehc/Base/PackageDatabase.chs" #-} +pkgExposedPackages :: PackageDatabase -> [PkgModulePartition] +pkgExposedPackages db + = [ ((k1,k2),"",[]) + | (k1,mp1) <- Map.toList $ pkgDbPkgMp db + , (k2,is ) <- Map.toList mp1 + , i <- is -- TBD: disambiguation + , pkginfoIsExposed i + ] + +{-# LINE 386 "src/ehc/Base/PackageDatabase.chs" #-} +pkgDbFreeze :: PackageDatabase -> PackageDatabase +pkgDbFreeze db + = db {pkgDbMod2PkgMp = m2p} + where m2p + = mod2pkgMpUnions + [ mod2pkgMpUnions + [ Map.singleton m [(k1,k2)] + | m <- Set.toList $ pkginfoExposedModules i + ] + | (k1,mp1) <- Map.toList $ pkgDbPkgMp db + , (k2,is) <- Map.toList mp1 + , i <- is + ] + +{-# LINE 406 "src/ehc/Base/PackageDatabase.chs" #-} +-- | For a module, find the package to use and the location of the root dir of that package. +pkgDbSearch :: PackageDatabase -> HsName -> Maybe (PkgKey,FilePath,[Err]) +pkgDbSearch db modNm + = do pkgs <- mbPkgs + dirOf $ disambig pkgs + where mbPkgs = Map.lookup modNm $ pkgDbMod2PkgMp db + disambig pks + = case sortBy cmp pks of + [k] -> (k,[]) -- no ambiguity + (k@(_,Nothing):_) -> (k,[]) -- versionless overrides others + ks@(k:_) -> (k,[rngLift emptyRange Err_AmbiguousNameRef "module" "package" modNm (map (mkHNm . strOf) ks)]) + where cmp (_,Nothing) (_,Nothing) = EQ -- versionless goes first + cmp (_,Nothing) (_,_ ) = LT + cmp (_,k21 ) (_,k22 ) = compare k22 k21 -- then highest version + pkgOf k = pkgMpLookup k $ pkgDbPkgMp db + strOf k = showPkgKey k ++ ": " ++ maybe "" (\i -> show (pkginfoLoc i) ++ ":" ++ show (pkginfoOrder i)) (pkgOf k) + dirOf (k,e) = fmap (\i -> (k,filelocDir $ pkginfoLoc i,e)) $ pkgOf k + +{-# LINE 426 "src/ehc/Base/PackageDatabase.chs" #-} +-- look up a file location, defaults to plain file search except for a package db which is then queried +fileLocSearch :: EHCOpts -> FileLoc -> HsName -> FPath -> [(FileLoc,FPath,[Err])] +fileLocSearch opts loc modNm fp + = case {- tr "fileLocSearch1" (show modNm ++ ": " ++ show fp ++ " " ++ show loc) $ -} filelocKind loc of + FileLocKind_PkgDb + -> maybe [] srch $ pkgDbSearch (ehcOptPkgDb opts) modNm + where srch (k,d,e) = [ (mkPkgFileLoc k d',fp',e) | (d',fp') <- searchFPathFromLoc d fp ] + _ -> [ (loc,fp',[]) | (_,fp') <- searchFPathFromLoc (filelocDir loc) fp ] + diff --git a/src/UHC/Light/Compiler/Base/ParseUtils.hs b/src/UHC/Light/Compiler/Base/ParseUtils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/ParseUtils.hs @@ -0,0 +1,25 @@ +module UHC.Light.Compiler.Base.ParseUtils +( P +, parseString ) +where +import UHC.Light.Compiler.Base.Common +import UU.Parsing +import UHC.Util.ParseUtils +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Base.HsName +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import Data.Version +import Data.List + +{-# LINE 34 "src/ehc/Base/ParseUtils.chs" #-} +type P p = PlainParser Token p + +{-# LINE 42 "src/ehc/Base/ParseUtils.chs" #-} +parseString :: ScanOpts -> P res -> String -> Maybe res +parseString scanOpts p s + = if null errs then Just res else Nothing + where tokens = scan scanOpts (initPos s) s + (res,errs) = parseToResMsgs p tokens diff --git a/src/UHC/Light/Compiler/Base/Parser.hs b/src/UHC/Light/Compiler/Base/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Parser.hs @@ -0,0 +1,176 @@ +module UHC.Light.Compiler.Base.Parser +( module UHC.Light.Compiler.Base.ParseUtils +, pDollNm, pUID, pInt +, pCTag, pCTagExtensive +, pBool +, parseHsName +, pStr +, pUIDHI +, pPredOccId +, pIdOcc, pIdOccKind +, pAssocL +, pCurlySemiBlock, pCurlys, pSemiBlock, pCurlyCommaBlock ) +where +import UU.Parsing +import UHC.Util.Utils +import UHC.Util.ParseUtils +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Scanner.Scanner +import UHC.Light.Compiler.Base.ParseUtils +import UHC.Light.Compiler.Base.ParseUtils +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified UHC.Util.Rel as Rel +import Data.List + +{-# LINE 30 "src/ehc/Base/Parser.chs" #-} +pDollNm :: P HsName +pDollNm + = (parseHsName . tokenVals) -- tokMkQName + <$> ( pVaridTk <|> pConidTk + <|> pQVaridTk <|> pQConidTk + ) + +-- counterpart of ppUIDParseable/showUIDParseable +pUID :: P UID +-- pUID = mkUID <$ pOCURLY <*> pList1Sep pCOMMA pInt <* pCCURLY +pUID = mkUID <$ pBACKQUOTE <* pOCURLY <*> pList1Sep pCOMMA pInt <* pCCURLY +-- pUID = mkUID <$ pPERCENT <* pOBRACK <*> pList1Sep pSLASH pInt <* pCBRACK + +pInt :: P Int +pInt = tokMkInt <$> pInteger10Tk + + +{-# LINE 51 "src/ehc/Base/Parser.chs" #-} +pUIDHI :: P UID +pUIDHI = pKeyTk "uid" *> pUID + +{-# LINE 56 "src/ehc/Base/Parser.chs" #-} +-- | counterpart of ppCTag' +pCTag :: P CTag +pCTag + = pCurly ( (\tyNm conNm tg -> CTag tyNm conNm tg (-1) (-1)) + <$> pDollNm <* pCOMMA <*> pDollNm <* pCOMMA <*> pInt + <|> CTagRec <$ pKeyTk "Rec" + ) +-- | counterpart of pCTagExtensive' +pCTagExtensive :: P CTag +pCTagExtensive + = pCurly ( CTag <$> pDollNm <* pCOMMA <*> pDollNm <* pCOMMA <*> pInt <* pCOMMA <*> pInt <* pCOMMA <*> pInt + <|> CTagRec <$ pKeyTk "Rec" + ) + +{-# LINE 72 "src/ehc/Base/Parser.chs" #-} +pBool :: P Bool +pBool = True <$ pKeyTk "True" <|> False <$ pKeyTk "False" + +{-# LINE 78 "src/ehc/Base/Parser.chs" #-} +pPredOccId :: P PredOccId +pPredOccId + = mkPrId <$> pUIDHI + +{-# LINE 84 "src/ehc/Base/Parser.chs" #-} +-- counterpart of PP IdOccKind instance +pIdOccKind :: P IdOccKind +pIdOccKind + = IdOcc_Val <$ pKeyTk "Value" + <|> IdOcc_Pat <$ pKeyTk "Pat" + <|> IdOcc_Type <$ pKeyTk "Type" + <|> IdOcc_Kind <$ pKeyTk "Kind" + <|> IdOcc_Class <$ pKeyTk "Class" + <|> IdOcc_Inst <$ pKeyTk "Instance" + <|> IdOcc_Dflt <$ pKeyTk "Default" + <|> IdOcc_Data <$ pKeyTk "Data" + <|> IdOcc_Any <$ pKeyTk "Any" + +pIdOcc :: P IdOcc +pIdOcc = IdOcc <$ pOCURLY <*> pDollNm <* pCOMMA <*> pIdOccKind <* pCCURLY + +{-# LINE 102 "src/ehc/Base/Parser.chs" #-} +pAssocL :: P a -> P b -> P (AssocL a b) +pAssocL pA pB = pOCURLY *> pListSep pCOMMA ((,) <$> pA <* pEQUAL <*> pB) <* pCCURLY + +{-# LINE 111 "src/ehc/Base/Parser.chs" #-} +pHsNameUnique :: P HsNameUnique +pHsNameUnique + = HsNameUnique_Int <$> pInt + <|> HsNameUnique_UID <$> pUID + <|> HsNameUnique_String <$> pStr + +pHsNameUniqifier :: P HsNameUniqifier +pHsNameUniqifier + = HsNameUniqifier_New <$ pKeyTk "NEW" + <|> HsNameUniqifier_Error <$ pKeyTk "ERR" + <|> HsNameUniqifier_GloballyUnique <$ pKeyTk "UNQ" + <|> HsNameUniqifier_Evaluated <$ pKeyTk "EVL" + <|> HsNameUniqifier_Field <$ pKeyTk "FLD" + <|> HsNameUniqifier_Class <$ pKeyTk "CLS" + <|> HsNameUniqifier_ClassDict <$ pKeyTk "DCT" + <|> HsNameUniqifier_SelfDict <$ pKeyTk "SDC" + <|> HsNameUniqifier_ResultDict <$ pKeyTk "RDC" + <|> HsNameUniqifier_SuperClass <$ pKeyTk "SUP" + <|> HsNameUniqifier_DictField <$ pKeyTk "DFL" + <|> HsNameUniqifier_Inline <$ pKeyTk "INL" + <|> HsNameUniqifier_GloballyUniqueDict <$ pKeyTk "UND" + <|> HsNameUniqifier_FieldOffset <$ pKeyTk "OFF" + <|> HsNameUniqifier_CaseContinuation <$ pKeyTk "CCN" + <|> HsNameUniqifier_GrinUpdated <$ pKeyTk "UPD" + <|> HsNameUniqifier_FFIArg <$ pKeyTk "FFI" + <|> HsNameUniqifier_LacksLabel <$ pKeyTk "LBL" + <|> HsNameUniqifier_BindAspect <$ pKeyTk "ASP" + <|> HsNameUniqifier_Strict <$ pKeyTk "STR" + <|> HsNameUniqifier_GenericClass <$ pKeyTk "GEN" + <|> HsNameUniqifier_FFE <$ pKeyTk "FFE" + <|> HsNameUniqifier_FFECoerced <$ pKeyTk "FFC" + +pHsNameUniqifierMp :: P HsNameUniqifierMp +pHsNameUniqifierMp + = Map.fromList <$> pList ((pSep *> pHsNameUniqifier) <+> (pOCURLY *> pList (pSep *> pHsNameUnique)) <* pCCURLY) + where pSep = tokConcat <$> pBACKQUOTE <*> pBACKQUOTE -- pAT + +pHsName :: P HsName +pHsName + = (\qs (b,u) -> hsnMkModf qs b u) <$> pList_ng (pHsName_Qual <* pDOT) <*> pHsName_Base + +pHsName_Qual :: P String +pHsName_Qual + = tokMkStr <$> (pVaridTk <|> pConidTk <|> pVarsymTk <|> pConsymTk <|> pK) + where pK = pAnyKey pKeyTk $ Set.toList $ scoKeywordsTxt hsnScanOpts + +pHsName_Base :: P (HsName, HsNameUniqifierMp) +pHsName_Base + = pB <+> pHsNameUniqifierMp + where pB = mkHNmBase . concat <$> pList1 pHsName_Qual + <|> mkHNm <$> pUID + <|> tokMkQName <$> pDOT + +{-# LINE 179 "src/ehc/Base/Parser.chs" #-} +parseHsName :: [String] -> HsName +parseHsName ss + = p $ concat $ intersperse "." ss + where p s = case parseToResMsgs pHsName $ scan hsnScanOpts (initPos s) s of + (res,[]) -> res + (res,ms) -> hsnUniqifyStr HsNameUniqifier_Error (show ms) res + +{-# LINE 206 "src/ehc/Base/Parser.chs" #-} +pStr :: P String +pStr = tokMkStr <$> pStringTk + +{-# LINE 211 "src/ehc/Base/Parser.chs" #-} +pSemiBlock :: P p -> P [p] +pSemiBlock p = pListSep pSEMI p + +pCurlys :: P p -> P p +pCurlys p = pOCURLY *> p <* pCCURLY + +pCurlySemiBlock :: P p -> P [p] +pCurlySemiBlock p = pCurlys (pListSep pSEMI p) + +pCurlyCommaBlock :: P p -> P [p] +pCurlyCommaBlock p = pCurlys (pListSep pCOMMA p) + diff --git a/src/UHC/Light/Compiler/Base/Parser2.hs b/src/UHC/Light/Compiler/Base/Parser2.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Parser2.hs @@ -0,0 +1,49 @@ +module UHC.Light.Compiler.Base.Parser2 +( pModEntRel +, parsePkgKey, parsePkgKeys ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Scanner.Scanner +import UHC.Light.Compiler.Base.ParseUtils +import UHC.Light.Compiler.Base.Parser +import UU.Parsing +import UHC.Util.ParseUtils +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Base.FileSearchLocation +import UHC.Light.Compiler.Module.ImportExport +import qualified Data.Set as Set +import qualified UHC.Util.Rel as Rel +import Data.Version + + + +{-# LINE 41 "src/ehc/Base/Parser2.chs" #-} +pPkgKey :: P PkgKey +pPkgKey = (concat <$> pList1_ng (pVarid <|> pConid <|> ("-" <$ pMINUS))) <+> pMb (pMINUS *> pVersion) + +pVersion :: P Version +pVersion = (\v -> Version (map read v) []) <$> pList1Sep pDOT pInteger10 + +{-# LINE 49 "src/ehc/Base/Parser2.chs" #-} +scanOptsPkgKey = defaultScanOpts {scoSpecChars = Set.fromList ".-", scoAllowFloat = False} + +parsePkgKey :: String -> Maybe PkgKey +parsePkgKey = parseString scanOptsPkgKey pPkgKey + +parsePkgKeys :: String -> Maybe [PkgKey] +parsePkgKeys = parseString scanOptsPkgKey (pList pPkgKey) + +{-# LINE 63 "src/ehc/Base/Parser2.chs" #-} +pModEnt :: P ModEnt +pModEnt + = (\kind occ owns -> ModEnt kind occ owns emptyRange) + <$ pOCURLY <*> pIdOccKind <* pCOMMA <*> pIdOcc + <*> pMaybe Set.empty id (Set.fromList <$ pCOMMA <* pOCURLY <*> pListSep pCOMMA pModEnt <* pCCURLY) + <* pCCURLY + +pModEntRel :: P ModEntRel +pModEntRel + = Rel.fromList <$> pAssocL pDollNm pModEnt + diff --git a/src/UHC/Light/Compiler/Base/Pragma.hs b/src/UHC/Light/Compiler/Base/Pragma.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Pragma.hs @@ -0,0 +1,126 @@ +module UHC.Light.Compiler.Base.Pragma +( Pragma (..) +, allSimplePragmaMp, showAllSimplePragmas', showAllSimplePragmas +, pragmaIsExcludeTarget +, pragmaInvolvesCmdLine ) +where +import qualified Data.Map as Map +import Data.List +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.Target +import UHC.Util.Binary +import UHC.Util.Serialize +import Control.Monad +import UHC.Light.Compiler.Opts.CommandLine + +{-# LINE 30 "src/ehc/Base/Pragma.chs" #-} +-- | Data type representing pragmas. +-- The names of the constructors must begin with "Pragma_", the string used in the map allSimplePragmaMp. +data Pragma + = Pragma_NoImplicitPrelude -- no implicit prelude + | Pragma_CPP -- preprocess with cpp + | Pragma_Derivable -- generic derivability + { pragmaDerivClassName :: HsName -- the class name for which + , pragmaDerivFieldName :: HsName -- this field is derivable + , pragmaDerivDefaultName :: HsName -- using this default value + } + | Pragma_NoGenericDeriving -- turn off generic deriving + | Pragma_GenericDeriving -- turn on generic deriving (default) + | Pragma_NoBangPatterns -- turn off bang patterns + | Pragma_BangPatterns -- turn on bang patterns (default) + | Pragma_NoPolyKinds -- turn off polymorphic kinds (default) + | Pragma_PolyKinds -- turn on + | Pragma_NoOverloadedStrings -- turn off overloaded strings (default) + | Pragma_OverloadedStrings -- turn on + | Pragma_ExtensibleRecords -- turn on extensible records + | Pragma_Fusion -- turn on fusion syntax + | Pragma_OptionsUHC -- commandline options + { pragmaOptions :: String + } + | Pragma_ExcludeIfTarget + { pragmaExcludeTargets :: [Target] + } + deriving (Eq,Ord,Show,Typeable,Data) + + +{-# LINE 63 "src/ehc/Base/Pragma.chs" #-} +-- | All pragmas not requiring further arguments, these are accepted as LANGUAGE pragma when included in this map. +allSimplePragmaMp :: Map.Map String Pragma +allSimplePragmaMp + = Map.fromList ts + where ts + = [ (drop prefixLen $ show t, t) + | t <- + [ Pragma_NoImplicitPrelude + , Pragma_CPP + , Pragma_GenericDeriving + , Pragma_NoGenericDeriving + , Pragma_BangPatterns + , Pragma_NoBangPatterns + , Pragma_NoPolyKinds + , Pragma_PolyKinds + , Pragma_NoOverloadedStrings + , Pragma_OverloadedStrings + , Pragma_ExtensibleRecords + , Pragma_Fusion + ] + ] + prefixLen = length "Pragma_" + +showAllSimplePragmas' :: String -> String +showAllSimplePragmas' + = showStringMapKeys allSimplePragmaMp + +showAllSimplePragmas :: String +showAllSimplePragmas + = showAllSimplePragmas' " " + +{-# LINE 100 "src/ehc/Base/Pragma.chs" #-} +pragmaIsExcludeTarget :: Target -> Pragma -> Bool +pragmaIsExcludeTarget t (Pragma_ExcludeIfTarget ts) = t `elem` ts +pragmaIsExcludeTarget _ _ = False + +{-# LINE 106 "src/ehc/Base/Pragma.chs" #-} +pragmaInvolvesCmdLine :: Pragma -> Bool +pragmaInvolvesCmdLine (Pragma_CPP ) = True +pragmaInvolvesCmdLine (Pragma_OptionsUHC _) = True +pragmaInvolvesCmdLine _ = False + +{-# LINE 117 "src/ehc/Base/Pragma.chs" #-} +instance Serialize Pragma where + sput (Pragma_NoImplicitPrelude ) = sputWord8 0 + sput (Pragma_CPP ) = sputWord8 1 + sput (Pragma_Derivable a b c ) = sputWord8 2 >> sput a >> sput b >> sput c + sput (Pragma_NoGenericDeriving ) = sputWord8 3 + sput (Pragma_GenericDeriving ) = sputWord8 4 + sput (Pragma_ExtensibleRecords ) = sputWord8 5 + sput (Pragma_ExcludeIfTarget a ) = sputWord8 6 >> sput a + sput (Pragma_Fusion ) = sputWord8 7 + sput (Pragma_NoBangPatterns ) = sputWord8 8 + sput (Pragma_BangPatterns ) = sputWord8 9 + sput (Pragma_OptionsUHC a ) = sputWord8 10 >> sput a + sput (Pragma_NoPolyKinds ) = sputWord8 11 + sput (Pragma_PolyKinds ) = sputWord8 12 + sput (Pragma_NoOverloadedStrings ) = sputWord8 13 + sput (Pragma_OverloadedStrings ) = sputWord8 14 + sget = do t <- sgetWord8 + case t of + 0 -> return Pragma_NoImplicitPrelude + 1 -> return Pragma_CPP + 2 -> liftM3 Pragma_Derivable sget sget sget + 3 -> return Pragma_NoGenericDeriving + 4 -> return Pragma_GenericDeriving + 5 -> return Pragma_ExtensibleRecords + 6 -> liftM Pragma_ExcludeIfTarget sget + 7 -> return Pragma_Fusion + 8 -> return Pragma_NoBangPatterns + 9 -> return Pragma_BangPatterns + 10 -> liftM Pragma_OptionsUHC sget + 11 -> return Pragma_NoPolyKinds + 12 -> return Pragma_PolyKinds + 13 -> return Pragma_NoOverloadedStrings + 14 -> return Pragma_OverloadedStrings + + diff --git a/src/UHC/Light/Compiler/Base/RLList.hs b/src/UHC/Light/Compiler/Base/RLList.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/RLList.hs @@ -0,0 +1,107 @@ +module UHC.Light.Compiler.Base.RLList +( RLList (..) +, rllConcat, rllSingleton, rllEmpty, rllToList, rllFromList +, rllLength, rllNull +, rllIsPrefixOf +, rllInits, rllInit, rllInitLast +, rllHeadTail ) +where +import Data.Maybe +import Data.List +import Control.Monad +import UHC.Util.Utils +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 30 "src/ehc/Base/RLList.chs" #-} +newtype RLList a + = RLList [(a,Int)] + deriving (Eq) + +instance Ord a => Ord (RLList a) where + (RLList []) `compare` (RLList []) = EQ + (RLList []) `compare` (RLList _ ) = LT + (RLList _ ) `compare` (RLList []) = GT + (RLList ((x1,c1):l1)) `compare` (RLList ((x2,c2):l2)) | x1 == x2 = if c1 == c2 + then RLList l1 `compare` RLList l2 + else c1 `compare` c2 + | x1 < x2 = LT + | x1 > x2 = GT + +{-# LINE 46 "src/ehc/Base/RLList.chs" #-} +rllConcat :: Eq a => RLList a -> RLList a -> RLList a +rllConcat (RLList []) rll2 = rll2 +rllConcat rll1 (RLList []) = rll1 +rllConcat (RLList l1) (RLList l2@(h2@(x2,c2):t2)) + | x1 == x2 = RLList (h1 ++ [(x1,c1+c2)] ++ t2) + | otherwise = RLList (l1 ++ l2) + where (h1,t1@(x1,c1)) = fromJust (initlast l1) + +rllEmpty :: RLList a +rllEmpty = RLList [] + +rllSingleton :: a -> RLList a +rllSingleton x = RLList [(x,1)] + +rllToList :: RLList a -> [a] +rllToList (RLList l) = concatMap (\(x,c) -> replicate c x) l + +rllFromList :: Eq a => [a] -> RLList a +rllFromList l = RLList [ (x,length g) | g@(x:_) <- group l ] + +{-# LINE 68 "src/ehc/Base/RLList.chs" #-} +rllLength :: RLList a -> Int +rllLength (RLList l) = sum $ map snd l + +rllNull :: RLList a -> Bool +rllNull (RLList []) = True +rllNull (RLList _ ) = False + +{-# LINE 77 "src/ehc/Base/RLList.chs" #-} +rllIsPrefixOf :: Eq a => RLList a -> RLList a -> Bool +rllIsPrefixOf (RLList []) _ = True +rllIsPrefixOf _ (RLList []) = False +rllIsPrefixOf (RLList ((x1,c1):l1)) (RLList ((x2,c2):l2)) + | x1 == x2 = if c1 < c2 + then True + else if c1 > c2 + then False + else rllIsPrefixOf (RLList l1) (RLList l2) + | otherwise = False + +{-# LINE 90 "src/ehc/Base/RLList.chs" #-} +rllInitLast :: Eq a => RLList a -> Maybe (RLList a,a) +rllInitLast (RLList l ) = il [] l + where il acc [(x,1)] = Just (RLList (reverse acc),x) + il acc [(x,c)] = Just (RLList (reverse ((x,c-1):acc)),x) + il acc (a:as) = il (a:acc) as + il _ _ = Nothing + +rllInit :: Eq a => RLList a -> RLList a +rllInit = fst . fromJust . rllInitLast + +rllInits :: Eq a => RLList a -> [RLList a] +rllInits = map rllFromList . inits . rllToList + +{-# LINE 105 "src/ehc/Base/RLList.chs" #-} +rllHeadTail :: RLList a -> Maybe (a,RLList a) +rllHeadTail (RLList []) = Nothing +rllHeadTail (RLList ((x,1):t)) = Just (x,RLList t) +rllHeadTail (RLList ((x,c):t)) = Just (x,RLList ((x,c-1):t)) + +{-# LINE 112 "src/ehc/Base/RLList.chs" #-} +instance Show a => Show (RLList a) where + show = show . rllToList + +{-# LINE 121 "src/ehc/Base/RLList.chs" #-} +deriving instance Typeable1 RLList +deriving instance Data x => Data (RLList x) + + +{-# LINE 131 "src/ehc/Base/RLList.chs" #-} +instance Binary a => Binary (RLList a) where + put (RLList a) = put a + get = liftM RLList get + diff --git a/src/UHC/Light/Compiler/Base/Range.hs b/src/UHC/Light/Compiler/Base/Range.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Range.hs @@ -0,0 +1,146 @@ +module UHC.Light.Compiler.Base.Range +( Range (..), emptyRange, builtinRange, mkRange1, mkRange2 +, isEmptyRange +, rangeUnion, rangeUnions +, RngLiftArg, rngLift, rngAntilift ) +where +import Data.Maybe +import Control.Monad +import UHC.Util.Pretty +import UU.Scanner.Position +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 36 "src/ehc/Base/Range.chs" #-} +data Range + = Range_Range !Pos !Pos + | Range_Unknown + | Range_Builtin + +emptyRange :: Range +emptyRange = Range_Unknown + +builtinRange :: Range +builtinRange = Range_Builtin + +mkPos :: Position p => p -> Pos +mkPos p = Pos (line p) (column p) (file p) + +mkRange1 :: Position p => p -> Range +mkRange1 p = Range_Range (mkPos p) noPos + +mkRange2 :: Position p => p -> p -> Range +mkRange2 p1 p2 = Range_Range (mkPos p1) (mkPos p2) + +{-# LINE 58 "src/ehc/Base/Range.chs" #-} +show2Pos :: Pos -> Pos -> String +show2Pos p1 p2 + | p1 /= p2 && p2 /= noPos = if line p1 == line p2 + then mk (show (line p1)) (Just $ show (column p1) ++ "-" ++ show (column p2)) + else mk (show (line p1) ++ "-" ++ show (line p2)) Nothing + | otherwise = mk (show (line p1)) (Just $ show (column p1)) + where mk l c = file p1 ++ ":" ++ l ++ maybe "" (":" ++) c + +{-# LINE 68 "src/ehc/Base/Range.chs" #-} +instance Show Range where + show (Range_Range p q) = show2Pos p q + show Range_Unknown = "??" + show Range_Builtin = "builtin" + +instance PP Range where + pp = pp . show + +{-# LINE 78 "src/ehc/Base/Range.chs" #-} +isEmptyRange :: Range -> Bool +isEmptyRange Range_Unknown = True +isEmptyRange (Range_Range p _) = p == noPos +isEmptyRange _ = False + +{-# LINE 87 "src/ehc/Base/Range.chs" #-} +instance Eq Range where + _ == _ = True -- a Range is ballast, not a criterium to decide equality for + +instance Ord Range where + _ `compare` _ = EQ -- a Range is ballast, not a criterium to decide equality for + +{-# LINE 95 "src/ehc/Base/Range.chs" #-} +rngAdd :: Range -> Range -> Range +rngAdd r1 r2 + = case (r1,r2) of + (Range_Range l1 h1,Range_Range l2 h2) + -> Range_Range (l1 `min` l2) (h1 `max` h2) + (Range_Range _ _,_) + -> r1 + (_,Range_Range _ _) + -> r2 + _ -> Range_Unknown + +{-# LINE 108 "src/ehc/Base/Range.chs" #-} +posMax, posMin :: Pos -> Pos -> Pos +posMax (Pos l1 c1 f1) (Pos l2 c2 _) = Pos (l1 `max` l2) (c1 `max` c2) f1 +posMin (Pos l1 c1 f1) (Pos l2 c2 _) = Pos (l1 `min` l2) (c1 `min` c2) f1 + +rangeUnion :: Range -> Range -> Range +rangeUnion (Range_Range b1 e1) (Range_Range b2 e2) = Range_Range (b1 `posMin` b2) (e1' `posMax` e2') + where e1' = if e1 == noPos then b1 else e1 + e2' = if e2 == noPos then b2 else e2 +rangeUnion Range_Unknown r2 = r2 +rangeUnion r1 _ = r1 + +rangeUnions :: [Range] -> Range +rangeUnions = foldr1 rangeUnion + +{-# LINE 139 "src/ehc/Base/Range.chs" #-} +type RngLiftArg x = Range -> x +type RngLift x = Range -> RngLiftArg x -> x + +rngLift :: RngLift v +rngLift r mkv + = x `seq` x + where x = mkv r + +rngAntilift :: v -> RngLiftArg v +rngAntilift = const + +{-# LINE 156 "src/ehc/Base/Range.chs" #-} +instance Eq Pos where + p1 == p2 = line p1 == line p2 && column p1 == column p2 + +instance Ord Pos where + compare p1 p2 + = case compare (line p1) (line p2) of + EQ -> compare (column p1) (column p2) + c -> c + +{-# LINE 171 "src/ehc/Base/Range.chs" #-} +deriving instance Typeable Range +deriving instance Data Range + +deriving instance Typeable Pos +deriving instance Data Pos + + +{-# LINE 184 "src/ehc/Base/Range.chs" #-} +instance Binary Range where + put (Range_Unknown ) = putWord8 0 + put (Range_Builtin ) = putWord8 1 + put (Range_Range a b) = putWord8 2 >> put a >> put b + get = do t <- getWord8 + case t of + 0 -> return Range_Unknown + 1 -> return Range_Builtin + 2 -> liftM2 Range_Range get get + +instance Serialize Range where + sput = sputShared + sget = sgetShared + sputNested = sputPlain + sgetNested = sgetPlain + +instance Binary Pos where + put (Pos a b c) = put a >> put b >> put c + get = liftM3 Pos get get get diff --git a/src/UHC/Light/Compiler/Base/Strictness.hs b/src/UHC/Light/Compiler/Base/Strictness.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Strictness.hs @@ -0,0 +1,44 @@ +module UHC.Light.Compiler.Base.Strictness +( Strictness (..) ) +where +import UHC.Light.Compiler.Base.HsName +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 20 "src/ehc/Base/Strictness.chs" #-} +data Strictness + = Strictness_Strict + | Strictness_NonStrict + | Strictness_Var HsName + deriving (Eq, Ord) + +instance Show Strictness where + show Strictness_Strict = "strict" + show Strictness_NonStrict = "nonStrict" + show (Strictness_Var n) = "strictness:" ++ show n + +{-# LINE 38 "src/ehc/Base/Strictness.chs" #-} +deriving instance Typeable Strictness +deriving instance Data Strictness + +{-# LINE 47 "src/ehc/Base/Strictness.chs" #-} +instance Binary Strictness where + put (Strictness_Strict ) = putWord8 0 + put (Strictness_NonStrict ) = putWord8 1 + put (Strictness_Var nm ) = putWord8 2 >> put nm + get = do t <- getWord8 + case t of + 0 -> return Strictness_Strict + 1 -> return Strictness_NonStrict + 2 -> liftM Strictness_Var get + +instance Serialize Strictness where + sput = sputShared + sget = sgetShared + sputNested = sputPlain + sgetNested = sgetPlain + + diff --git a/src/UHC/Light/Compiler/Base/Target.hs b/src/UHC/Light/Compiler/Base/Target.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/Target.hs @@ -0,0 +1,301 @@ +module UHC.Light.Compiler.Base.Target +( Target (..) +, defaultTarget +, supportedTargetMp, showSupportedTargets', showSupportedTargets +, TargetFlavor (..) +, defaultTargetFlavor +, allTargetFlavorMp, showAllTargetFlavors', showAllTargetFlavors +, targetDoesHPTAnalysis +, targetIsGrinBytecode +, targetAllowsGrinNodePtrMix +, targetIsC +, targetAllowsOLinking +, targetAllowsJarLinking +, targetIsCore +, targetIsTyCore +, targetIsJVM +, targetIsViaGrinCmmJavaScript +, targetIsViaCoreJavaScript +, targetIsJavaScript +, targetIsOnUnixAndOrC +, FFIWay (..) +, ffiWayForPrim +, TargetInfo (..), TargInfoMp +, allTargetInfoMp, allFFIWays ) +where +import qualified Data.Map as Map +import Data.List +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 78 "src/ehc/Base/Target.chs" #-} +-- | All possible targets, even though they may not be configured (done in supportedTargetMp) +data Target + = Target_None -- no codegen + | Target_None_Core_AsIs -- only Core + | Target_None_TyCore_None -- only TyCore + + -- jazy + | Target_Interpreter_Core_Jazy -- java based on Core, using jazy library + + -- javascript + | Target_Interpreter_Core_JavaScript -- javascript based on Core + | Target_Interpreter_GrinCmm_JavaScript -- javascript based on Grin -> Cmm + + -- grin, wholeprogC + | Target_FullProgAnal_Grin_C -- full program analysis on grin, generating C + + -- grin, llvm, wholeprogC + | Target_FullProgAnal_Grin_LLVM -- full program analysis on grin, generating LLVM + + -- grin, jvm, wholeprogC + | Target_FullProgAnal_Grin_JVM -- full program analysis on grin, generating for Java VM + + -- grin + | Target_Interpreter_Grin_C -- no full program analysis, grin interpreter, generating C + + -- grin, clr, wholeprogC + | Target_FullProgAnal_Grin_CLR -- full program analysis on grin, generating for Common Language Runtime (.NET / Mono) + deriving ( Eq, Ord, Enum ) + +{-# LINE 118 "src/ehc/Base/Target.chs" #-} +instance Show Target where + show Target_None = "NONE" + show Target_None_Core_AsIs = "cr" + show Target_None_TyCore_None = "tycore" + show Target_Interpreter_Core_Jazy = "jazy" + show Target_Interpreter_Core_JavaScript = "js" + show Target_Interpreter_GrinCmm_JavaScript= "cmmjs" + show Target_FullProgAnal_Grin_C = "C" + show Target_FullProgAnal_Grin_LLVM = "llvm" + show Target_FullProgAnal_Grin_JVM = "jvm" + show Target_Interpreter_Grin_C = "bc" + show Target_FullProgAnal_Grin_CLR = "clr" + +{-# LINE 140 "src/ehc/Base/Target.chs" #-} +defaultTarget :: Target +defaultTarget = Target_None_Core_AsIs + +{-# LINE 153 "src/ehc/Base/Target.chs" #-} +supportedTargetMp :: Map.Map String Target +(supportedTargetMp,allTargetInfoMp) + = (Map.fromList ts, Map.fromList is) + where (ts,is) = unzip + [ ((show t, t),(t,i)) + | (t,i) + <- [] + ++ [ mk Target_None_Core_AsIs [] ] + ] + mk t ffis = (t,TargetInfo (FFIWay_Prim : ffis)) + +showSupportedTargets' :: String -> String +showSupportedTargets' + = showStringMapKeys supportedTargetMp + +showSupportedTargets :: String +showSupportedTargets + = showSupportedTargets' " " + +{-# LINE 206 "src/ehc/Base/Target.chs" #-} +data TargetFlavor + = TargetFlavor_Plain -- no special stuff + | TargetFlavor_Debug -- debugging variant + -- more: profiling, .... + deriving (Eq,Ord,Enum) + +{-# LINE 214 "src/ehc/Base/Target.chs" #-} +defaultTargetFlavor :: TargetFlavor +defaultTargetFlavor = TargetFlavor_Plain + +{-# LINE 219 "src/ehc/Base/Target.chs" #-} +instance Show TargetFlavor where + show TargetFlavor_Plain = "plain" + show TargetFlavor_Debug = "debug" + +{-# LINE 227 "src/ehc/Base/Target.chs" #-} +allTargetFlavorMp :: Map.Map String TargetFlavor +allTargetFlavorMp + = Map.fromList ts + where ts + = [ (show t, t) + | t <- + [ TargetFlavor_Plain + , TargetFlavor_Debug + ] + ] + +showAllTargetFlavors' :: String -> String +showAllTargetFlavors' + = showStringMapKeys allTargetFlavorMp + +showAllTargetFlavors :: String +showAllTargetFlavors + = showAllTargetFlavors' " " + +{-# LINE 252 "src/ehc/Base/Target.chs" #-} +targetDoesHPTAnalysis :: Target -> Bool +targetDoesHPTAnalysis t + = case t of + _ -> False + +{-# LINE 293 "src/ehc/Base/Target.chs" #-} +targetIsGrinBytecode :: Target -> Bool +targetIsGrinBytecode t + = case t of + _ -> False +{-# INLINE targetIsGrinBytecode #-} + +{-# LINE 304 "src/ehc/Base/Target.chs" #-} +targetAllowsGrinNodePtrMix :: Target -> Bool +targetAllowsGrinNodePtrMix t + = case t of + _ -> False +{-# INLINE targetAllowsGrinNodePtrMix #-} + +{-# LINE 316 "src/ehc/Base/Target.chs" #-} +targetIsC :: Target -> Bool +targetIsC t + = case t of + _ -> False +{-# INLINE targetIsC #-} + +{-# LINE 330 "src/ehc/Base/Target.chs" #-} +targetAllowsOLinking :: Target -> Bool +targetAllowsOLinking t + = case t of + _ -> False +{-# INLINE targetAllowsOLinking #-} + +{-# LINE 341 "src/ehc/Base/Target.chs" #-} +targetAllowsJarLinking :: Target -> Bool +targetAllowsJarLinking t + = case t of + _ -> False +{-# INLINE targetAllowsJarLinking #-} + +{-# LINE 352 "src/ehc/Base/Target.chs" #-} +targetIsCore :: Target -> Bool +targetIsCore t + = case t of + Target_None_Core_AsIs -> True + _ -> False +{-# INLINE targetIsCore #-} + +{-# LINE 361 "src/ehc/Base/Target.chs" #-} +targetIsTyCore :: Target -> Bool +targetIsTyCore t + = case t of + Target_None_TyCore_None -> True + _ -> False +{-# INLINE targetIsTyCore #-} + +{-# LINE 370 "src/ehc/Base/Target.chs" #-} +targetIsJVM :: Target -> Bool +targetIsJVM t + = case t of + _ -> False +{-# INLINE targetIsJVM #-} + +{-# LINE 381 "src/ehc/Base/Target.chs" #-} +targetIsViaGrinCmmJavaScript :: Target -> Bool +targetIsViaGrinCmmJavaScript t + = case t of + _ -> False +{-# INLINE targetIsViaGrinCmmJavaScript #-} + +{-# LINE 392 "src/ehc/Base/Target.chs" #-} +targetIsViaCoreJavaScript :: Target -> Bool +targetIsViaCoreJavaScript t + = case t of + _ -> False +{-# INLINE targetIsViaCoreJavaScript #-} + +{-# LINE 403 "src/ehc/Base/Target.chs" #-} +targetIsJavaScript :: Target -> Bool +targetIsJavaScript t + = case t of + _ -> False +{-# INLINE targetIsJavaScript #-} + +{-# LINE 437 "src/ehc/Base/Target.chs" #-} +-- | target runs on (possibly emulated) UNIX / C environment? this should coincide with flag EHC_CFG_USE_UNIX_AND_C in src/ehc/variant.mk +targetIsOnUnixAndOrC :: Target -> Bool +targetIsOnUnixAndOrC t + = targetIsC t || targetIsJVM t +{-# INLINE targetIsOnUnixAndOrC #-} + +{-# LINE 449 "src/ehc/Base/Target.chs" #-} +data FFIWay + = FFIWay_Prim -- as primitive + | FFIWay_CCall -- as C call + | FFIWay_Jazy -- as Java/Jazy + deriving (Eq,Ord,Enum) + +instance Show FFIWay where + show FFIWay_Prim = "prim" + show FFIWay_CCall = "ccall" + show FFIWay_Jazy = "jazy" + +instance PP FFIWay where + pp = pp . show + +{-# LINE 479 "src/ehc/Base/Target.chs" #-} +ffiWayForPrim :: Target -> Maybe FFIWay +ffiWayForPrim t + | targetIsC t = Just FFIWay_CCall + | otherwise = Nothing + +{-# LINE 507 "src/ehc/Base/Target.chs" #-} +data TargetInfo + = TargetInfo + { targiAllowedFFI :: [FFIWay] + } + +type TargInfoMp = Map.Map Target TargetInfo + +{-# LINE 516 "src/ehc/Base/Target.chs" #-} +allTargetInfoMp :: TargInfoMp + +allFFIWays :: [FFIWay] +allFFIWays = nub $ concatMap targiAllowedFFI $ Map.elems allTargetInfoMp + +{-# LINE 527 "src/ehc/Base/Target.chs" #-} +deriving instance Typeable Target +deriving instance Data Target + +deriving instance Typeable FFIWay +deriving instance Data FFIWay + +deriving instance Typeable TargetFlavor +deriving instance Data TargetFlavor + +{-# LINE 542 "src/ehc/Base/Target.chs" #-} +instance Binary Target where + put = putEnum8 + get = getEnum8 + +instance Serialize Target where + sput = sputPlain + sget = sgetPlain + +instance Binary FFIWay where + put = putEnum8 + get = getEnum8 + +instance Serialize FFIWay where + sput = sputPlain + sget = sgetPlain + +instance Binary TargetFlavor where + put = putEnum8 + get = getEnum8 + +instance Serialize TargetFlavor where + sput = sputPlain + sget = sgetPlain + + diff --git a/src/UHC/Light/Compiler/Base/TermLike.hs b/src/UHC/Light/Compiler/Base/TermLike.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/TermLike.hs @@ -0,0 +1,387 @@ +module UHC.Light.Compiler.Base.TermLike +( AppLike (..) +, appToApp +, BndLike (..) +, RecLike (..) +, rowCanonOrderBy, rowCanonOrder +, appTopApp1 +, appRngProdOpt +, appRngParApp +, appConApp, appCon1App +, app1Arr, appArr +, appUnAnn, appUnTop, appUnBind, appUnAnnCanon +, appUnApp +, appUnAppArgs +, appMbApp, appMbConApp +, appMb1MetaArr, appMb1Arr, appMbArr, appUnMetaArrMk, appUnArrMk, appUnMetaArr, appUnArr, appUn1Arr +, appUnArrArgs, appUnArrRes, appUnArrArg +, recUnRecRow +, recRec, recSum, recRecExt, recRecEmp, recSumEmp +, appArrInverse ) +where +import UU.Scanner.Position +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import Control.Applicative ((<|>)) +import Control.Monad +import Data.Maybe + +{-# LINE 29 "src/ehc/Base/TermLike.chs" #-} +-- | Application like terms. +-- Note: defaults for Range and non-Range variants are defined using eachother. Only one needs definition. +class AppLike a boundmeta {- ann bnd | a -> ann bnd -} + | a -> boundmeta + -- , boundmeta -> a + where + ---------- + -- AppLike + ---------- + + -- basic semantics + app1App :: a -> a -> a -- single application + appTop :: a -> a -- top of multiple apps + appVar :: (Position n,HSNM n) => n -> a -- variable + appCon :: (Position n,HSNM n) => n -> a -- constructor + appPar :: a -> a -- parenthesis + -- and the defaults + app1App = appRngApp1 emptyRange + appTop = appRngTop emptyRange + appVar = appRngVar emptyRange + appCon = appRngCon emptyRange + appPar = appRngPar emptyRange + + -- variation with Range + appRngApp1 :: Range -> a -> a -> a + appRngTop :: Range -> a -> a + appRngVar :: (Position n,HSNM n) => Range -> n -> a + appRngCon :: (Position n,HSNM n) => Range -> n -> a + appRngPar :: Range -> a -> a + + -- and the defaults + appRngApp1 _ = app1App + appRngTop _ = appTop + appRngVar _ = appVar + appRngCon _ = appCon + appRngPar _ = appPar + + -- inspection/deconstruction + appMbBind1 :: a -> Maybe (a,a->a) -- strip binding, if any, also giving reconstruction + appMbAnn1 :: a -> Maybe (a,a->a) -- strip annotation, if any, also giving reconstruction + appMbTop1 :: a -> Maybe (a,a->a) -- strip top of app, if any, also giving reconstruction + appMbCanon1 :: a -> Maybe (a,a->a) -- minimal canonicalization (e.g. strip empty implicits), if any, also giving reconstruction + appMbCon :: a -> Maybe (HsName) -- is con? + appMbApp1 :: a -> Maybe (a,a) -- is app? + appMbDbg :: a -> Maybe String -- is dbg? + + -- and the defaults + appMbBind1 = const Nothing + appMbAnn1 = const Nothing + appMbTop1 = appMbAnn1 + appMbCanon1 = const Nothing + appMbCon = const Nothing + appMbApp1 = const Nothing + appMbDbg = const Nothing + + -- specialised constructing + -- | Make application wrapped in top, except for singleton + appTopApp :: [a] -> a + appProdApp :: [a] -> a + app1MetaArr :: (Maybe HsName,boundmeta) -> a -> a -> a + + -- and the defaults + appTopApp = appRngTopApp emptyRange + appProdApp as = appConApp (hsnProd (length as)) as + app1MetaArr _ a r = appConApp hsnArrow [a,r] + + -- variation with Range + appRngTopApp :: Range -> [a] -> a + appRngProdApp :: Range -> [a] -> a + + -- and the defaults + appRngTopApp r [a] = a + appRngTopApp r as = appRngTop r (foldl1 (appRngApp1 r) as) + + appRngProdApp _ as = appProdApp as -- to be done + + -- specialised deconstructing + -- | Wrap 1 arr unpacking into Maybe, together with reconstruction function for toplevel unwrapping + appMb1ArrMk :: a -> Maybe (((HsName,boundmeta),a,a),a->a) + + -- and the defaults + appMb1ArrMk x + = do let (x',mktop) = appUnBind $ fst $ appUnAnn x + (arr,[a,r]) <- appMbConApp x' + if hsnIsArrow arr then return (((mkHNm "??TermLike.appMb1ArrMk",appDfltBoundmeta a),a,r),mktop) else Nothing + + -- misc: debugging (intended to return a more appropriate value of type 'a') + appDbg :: String -> a + appDbg m = panic $ "TermLike.appDbg: " ++ m + + -- misc: evaluatedness (i.e. yes/no lazy/thunk) + -- yes evaluated (no thunk, not lazy) + appEvl :: a -> a + appEvl = id + -- not evaluated (yes thunk, yes lazy) + appNonEvl :: a -> a + appNonEvl = id + + -- fallback, default value + -- appDflt :: a + appDfltBoundmeta :: a -> boundmeta -- the 'a' is only required because a fundep boundmeta -> a would be too restrictive + appDfltBoundmeta _ = panic "TermLike.appDfltBoundmeta not implemented" + + +{-# LINE 141 "src/ehc/Base/TermLike.chs" #-} +appToApp :: (AppLike a aboundmeta, AppLike b bboundmeta) => a -> Maybe b +appToApp x + = c appMbCon appCon x + <|> c appMbDbg appDbg x + where c mbUn mk = fmap mk . mbUn + +{-# LINE 153 "src/ehc/Base/TermLike.chs" #-} +class {- AppLike a boundmeta => -} BndLike a bndnm where + bndBndIn :: bndnm -> MetaLev -> a -> a -> a + +{-# LINE 162 "src/ehc/Base/TermLike.chs" #-} +class AppLike a boundmeta => RecLike a boundmeta + where + ---------- + -- RecLike + ---------- + + -- constructing + recRow :: a -> AssocL HsName a -> a + + -- default values + recRowEmp :: a + + -- and the defaults + recRowEmp = appCon hsnRowEmpty + + -- inspection/deconstruction + recMbRecRow :: a -> Maybe a + recUnRowExts :: a -> (a,AssocL HsName a) + + +{-# LINE 190 "src/ehc/Base/TermLike.chs" #-} +-- | Order on labels, given a comparison function +rowCanonOrderBy :: (o -> o -> Ordering) -> AssocL o a -> AssocL o a +rowCanonOrderBy cmp = sortByOn cmp fst + +-- | Order on labels +rowCanonOrder :: AssocL HsName a -> AssocL HsName a +rowCanonOrder = rowCanonOrderBy rowLabCmp +{-# INLINE rowCanonOrder #-} + +{-# LINE 205 "src/ehc/Base/TermLike.chs" #-} +-- | Make single application, with top +appTopApp1 :: AppLike a boundmeta {- ann -} => a -> a -> a +appTopApp1 a r = appTopApp [a,r] +{-# INLINE appTopApp1 #-} + +{-# LINE 212 "src/ehc/Base/TermLike.chs" #-} +-- | Make product, except for singleton +appRngProdOpt :: AppLike a boundmeta {- ann -} => Range -> [a] -> a +appRngProdOpt r [a] = a +appRngProdOpt r as = appRngProdApp r as + +{-# LINE 219 "src/ehc/Base/TermLike.chs" #-} +-- | Make parenthesized app, except for singleton +appRngParApp :: AppLike a boundmeta {- ann -} => Range -> [a] -> a +appRngParApp r [a] = a +appRngParApp r as = appRngPar r (appRngTopApp r as) + +{-# LINE 230 "src/ehc/Base/TermLike.chs" #-} +-- | Make constructor applied to arguments +appConApp :: (AppLike a boundmeta {- ann -}, Position n, HSNM n) => n -> [a] -> a +appConApp c as = appTopApp (appCon c : as) +{-# INLINE appConApp #-} + +-- | See 'appCon1App', just for 1 arg +appCon1App :: (AppLike a boundmeta {- ann -}, Position n, HSNM n) => n -> a -> a +appCon1App c a = appConApp c [a] +{-# INLINE appCon1App #-} + +{-# LINE 246 "src/ehc/Base/TermLike.chs" #-} +-- | Make (type) rep for single arrow (i.e. abstraction) +app1Arr :: AppLike a boundmeta {- ann -} => a -> a -> a +app1Arr x y = app1MetaArr (Nothing,appDfltBoundmeta x) x y +{-# INLINE app1Arr #-} + +-- | Multiple app1Arr +appArr :: AppLike a boundmeta {- ann -} => [a] -> a -> a +appArr = flip (foldr app1Arr) +{-# INLINE appArr #-} + +{-# LINE 262 "src/ehc/Base/TermLike.chs" #-} +-- | Given a single level unwrap, deepnested unwrap top like stuff, also giving reconstruction +appMb2Un :: (a -> Maybe (a,a->a)) -> a -> (a,a->a) +appMb2Un un a + = case un a of + Just (a',mk1) -> (a'', mk1 . mk) + where (a'',mk) = appMb2Un un a' + _ -> (a,id) + +{-# LINE 272 "src/ehc/Base/TermLike.chs" #-} +-- | Unwrap binding like stuff (i.e. quantifiers), also giving reconstruction +appUnBind :: AppLike a boundmeta {- ann -} => a -> (a,a->a) +appUnBind = appMb2Un appMbBind1 +{-# INLINE appUnBind #-} + +-- | Unwrap ann like stuff, also giving reconstruction +appUnAnn :: AppLike a boundmeta {- ann -} => a -> (a,a->a) +appUnAnn = appMb2Un appMbAnn1 +{-# INLINE appUnAnn #-} + +-- | Unwrap ann+canonic like stuff, also giving reconstruction +appUnAnnCanon :: AppLike a boundmeta {- ann -} => a -> (a,a->a) +appUnAnnCanon = appMb2Un (\a -> appMbAnn1 a <|> appMbCanon1 a) + +-- | Unwrap top like stuff, also giving reconstruction +appUnTop :: AppLike a boundmeta {- ann -} => a -> (a,a->a) +appUnTop = appMb2Un appMbTop1 +{-# INLINE appUnTop #-} + +{-# LINE 293 "src/ehc/Base/TermLike.chs" #-} +-- | Unpack app into function and args +appUnApp :: AppLike a boundmeta {- ann -} => a -> (a,[a]) +appUnApp x + = un [] (fst $ appUnTop x) + where un as x = case appMbApp1 x' of + Just (f,a) -> un (a:as) f + _ -> (x',as) + where x' = -- fst $ appMb2Un (\a -> appMbAnn1 a <|> appMbBind1 a) x + fst $ appUnBind $ fst $ appUnAnn x + +{-# LINE 305 "src/ehc/Base/TermLike.chs" #-} +-- | Unpack app into function and args, args only +appUnAppArgs :: AppLike a boundmeta {- ann -} => a -> [a] +appUnAppArgs = snd . appUnApp +{-# INLINE appUnAppArgs #-} + +{-# LINE 312 "src/ehc/Base/TermLike.chs" #-} +-- | Wrap app unpacking into Maybe +appMbApp :: AppLike a boundmeta {- ann -} => a -> Maybe (a,[a]) +appMbApp x + = case appUnApp x of + u@(_,(_:_)) -> Just u + _ -> Nothing + +-- | Wrap app into constructor name applied to args +appMbConApp :: AppLike a boundmeta {- ann -} => a -> Maybe (HsName,[a]) +appMbConApp x + = do let (f,as) = appUnApp x + c <- appMbCon $ fst $ appUnAnn f + return (c,as) + + +{-# LINE 329 "src/ehc/Base/TermLike.chs" #-} +appMb1MetaArr :: AppLike a boundmeta {- ann -} => a -> Maybe ((HsName,boundmeta),a,a) +appMb1MetaArr = fmap fst . appMb1ArrMk +{-# INLINE appMb1MetaArr #-} + +appMb1Arr :: AppLike a boundmeta {- ann -} => a -> Maybe (a,a) +appMb1Arr = fmap (\(_,x,y) -> (x,y)) . appMb1MetaArr +{-# INLINE appMb1Arr #-} + +-- | Wrap arr unpacking into Maybe +appMbArr :: AppLike a boundmeta {- ann -} => a -> Maybe ([a],a) +appMbArr x + = case appUnArr x of + a@((_:_),_) -> Just a + _ -> Nothing + +-- | Arr unpacking, together with reconstruction function for toplevel unwrapping +appUnMetaArrMk :: AppLike a boundmeta {- ann -} => a -> (([((HsName,boundmeta),a)],a),a->a) +appUnMetaArrMk x + = case appMb1ArrMk x of + Just ((m,a,r),mk) -> (((m,a):as,r'),mk) + where ((as,r'),_) = appUnMetaArrMk r + _ -> (([],x),id) + +-- | Arr unpacking, together with reconstruction function for toplevel unwrapping +appUnArrMk :: AppLike a boundmeta {- ann -} => a -> (([a],a),a->a) +appUnArrMk x + = ((map snd as,r),mk) + where ((as,r),mk) = appUnMetaArrMk x +{- + = case appMb1ArrMk x of + Just ((_,a,r),mk) -> ((a:as,r'),mk) + where ((as,r'),_) = appUnArrMk r + _ -> (([],x),id) +-} + +-- | Arr unpacking into args + res +appUnMetaArr :: AppLike a boundmeta {- ann -} => a -> ([((HsName,boundmeta),a)],a) +appUnMetaArr = fst . appUnMetaArrMk +{-# INLINE appUnMetaArr #-} + +-- | Arr unpacking into args + res +appUnArr :: AppLike a boundmeta {- ann -} => a -> ([a],a) +appUnArr = fst . appUnArrMk +{-# INLINE appUnArr #-} + +-- | Arr unpacking into arg + res, when failing to unpack arg holds a default +appUn1Arr :: AppLike a boundmeta {- ann -} => a -> (a,a) +appUn1Arr x = maybe (appDbg "appUn1Arr.arg",x) id $ appMb1Arr x +{-# INLINE appUn1Arr #-} + +{-# LINE 381 "src/ehc/Base/TermLike.chs" #-} +-- | Arr unpacking, args only +appUnArrArgs :: AppLike a boundmeta {- ann -} => a -> [a] +appUnArrArgs = fst . appUnArr +{-# INLINE appUnArrArgs #-} + +-- | Arr unpacking, res only +appUnArrRes :: AppLike a boundmeta {- ann -} => a -> a +appUnArrRes = snd . appUnArr +{-# INLINE appUnArrRes #-} + +-- | Arr unpacking, arg only +appUnArrArg :: AppLike a boundmeta {- ann -} => a -> a +appUnArrArg = fst . appUn1Arr +{-# INLINE appUnArrArg #-} + +{-# LINE 402 "src/ehc/Base/TermLike.chs" #-} +-- | inverse type, i.e. a->b gives b->a, a->b->c gives c->(a,b) +appArrInverse :: AppLike a boundmeta {- ann -} => a -> a +appArrInverse x + = case appUnArrMk x of + (( [a] ,r),mk) -> mk $ [r] `appArr` a + ((as@(_:_),r),mk) -> mk $ [r] `appArr` appProdApp as + _ -> x + +{-# LINE 416 "src/ehc/Base/TermLike.chs" #-} +-- | If a row based record, return the row +recUnRecRow :: RecLike a boundmeta => a -> a +recUnRecRow = maybe (panic "recUnRecRow") id . recMbRecRow +{-# INLINE recUnRecRow #-} + +{-# LINE 427 "src/ehc/Base/TermLike.chs" #-} +-- | Construct record from labels + terms +recRec :: RecLike a boundmeta => AssocL HsName a -> a +recRec al = hsnRec `appConApp` [recRowEmp `recRow` al] +{-# INLINE recRec #-} + +-- | Construct record from labels + terms +recSum :: RecLike a boundmeta => AssocL HsName a -> a +recSum al = hsnSum `appConApp` [recRowEmp `recRow` al] +{-# INLINE recSum #-} + +-- | Construct record from record to be extended + labels + terms +recRecExt :: RecLike a boundmeta => a -> AssocL HsName a -> a +recRecExt recd al + = hsnRec `appConApp` [row `recRow` (exts ++ al)] + where (row,exts) = recUnRowExts (recUnRecRow recd) + +-- | Empty record +recRecEmp :: RecLike a boundmeta => a +recRecEmp = recRec [] +{-# INLINE recRecEmp #-} + +-- | Empty sum +recSumEmp :: RecLike a boundmeta => a +recSumEmp = recSum [] +{-# INLINE recSumEmp #-} diff --git a/src/UHC/Light/Compiler/Base/TreeTrie.hs b/src/UHC/Light/Compiler/Base/TreeTrie.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/TreeTrie.hs @@ -0,0 +1,398 @@ +module UHC.Light.Compiler.Base.TreeTrie +( TreeTrie1Key (..), TreeTrieMp1Key (..), TreeTrieMpKey, TreeTrieKey +, ppTreeTrieKey +, ttkSingleton, ttkAdd', ttkAdd, ttkChildren, ttkFixate +, ttkParentChildren +, TreeTrieKeyable (..) +, TreeTrieLookup (..) +, TreeTrie, emptyTreeTrie, empty +, toListByKey, toList +, fromListByKeyWith, fromList +, lookupPartialByKey, lookupPartialByKey', lookupByKey, lookup +, lookupResultToList +, isEmpty, null +, elems +, singleton, singletonKeyable +, unionWith, union, unionsWith, unions +, insertByKeyWith, insertByKey +, deleteByKey, delete +, deleteListByKey ) +where +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import Prelude hiding (lookup,null) +import qualified UHC.Util.FastSeq as Seq +import qualified Data.List as List +import UHC.Util.Utils +import UHC.Util.Pretty hiding (empty) +import qualified UHC.Util.Pretty as PP +import UHC.Light.Compiler.Base.Debug +import Data.Typeable (Typeable,Typeable1) +import Data.Generics (Data) +import Control.Monad +import UHC.Util.Serialize + + + +{-# LINE 60 "src/ehc/Base/TreeTrie.chs" #-} +-- | Both key and trie can allow partial matching, indicated by TreeTrie1Key +data TreeTrie1Key k + = TT1K_One !k + | TT1K_Any -- used to wildcard match a single node in a tree + deriving (Eq, Ord) + +-- | A key in a layer of TreeTrieMpKey +data TreeTrieMp1Key k + = TTM1K [TreeTrie1Key k] + | TTM1K_Any -- used to wildcard match multiple children, internal only + deriving (Eq, Ord) + +-- | The key into a map used internally by the trie +type TreeTrieMpKey k + = [TreeTrieMp1Key k] + +-- | The key used externally to index into a trie +type TreeTrieKey k + = [TreeTrieMpKey k] + +{-# LINE 88 "src/ehc/Base/TreeTrie.chs" #-} +deriving instance Typeable1 TreeTrie1Key +deriving instance Typeable1 TreeTrieMp1Key +deriving instance Data x => Data (TreeTrie1Key x) +deriving instance Data x => Data (TreeTrieMp1Key x) + +{-# LINE 95 "src/ehc/Base/TreeTrie.chs" #-} +instance Show k => Show (TreeTrie1Key k) where + show TT1K_Any = "*" + show (TT1K_One k) = "1:" ++ show k + +instance Show k => Show (TreeTrieMp1Key k) where + show (TTM1K_Any ) = "**" -- ++ show i + show (TTM1K k) = show k + +instance PP k => PP (TreeTrie1Key k) where + pp TT1K_Any = pp "*" + pp (TT1K_One k) = "1:" >|< k + +instance PP k => PP (TreeTrieMp1Key k) where + pp = ppTreeTrieMp1Key + +{-# LINE 112 "src/ehc/Base/TreeTrie.chs" #-} +ppTreeTrieMp1Key :: PP k => TreeTrieMp1Key k -> PP_Doc +ppTreeTrieMp1Key (TTM1K l) = ppBracketsCommas l +ppTreeTrieMp1Key (TTM1K_Any ) = pp "**" -- >|< i + +ppTreeTrieMpKey :: PP k => TreeTrieMpKey k -> PP_Doc +ppTreeTrieMpKey = ppListSep "<" ">" "," . map ppTreeTrieMp1Key + +ppTreeTrieKey :: PP k => TreeTrieKey k -> PP_Doc +ppTreeTrieKey = ppBracketsCommas . map ppTreeTrieMpKey + +{-# LINE 133 "src/ehc/Base/TreeTrie.chs" #-} +-- | Make singleton, which should at end be stripped from bottom layer of empty TTM1K [] +ttkSingleton :: TreeTrie1Key k -> TreeTrieKey k +ttkSingleton k = [TTM1K [k]] : ttkEmpty + +-- | empty key +ttkEmpty :: TreeTrieKey k +ttkEmpty = [[TTM1K []]] + +-- | Construct intermediate structure for children for a new Key +-- length ks >= 2 +ttkChildren :: [TreeTrieKey k] -> [TreeTrieMpKey k] +ttkChildren ks + = [TTM1K $ concat [k | TTM1K k <- concat hs]] -- first level children are put together in singleton list of list with all children + : merge (split tls) -- and the rest is just concatenated + where (hs,tls) = split ks + split = unzip . map hdAndTl + merge (hs,[]) = [concat hs] + merge (hs,tls) = concat hs : merge (split $ filter (not . List.null) tls) + +-- | Add a new layer with single node on top, combining the rest. +ttkAdd' :: TreeTrie1Key k -> [TreeTrieMpKey k] -> TreeTrieKey k +ttkAdd' k ks = [TTM1K [k]] : ks + +-- | Add a new layer with single node on top, combining the rest. +-- length ks >= 2 +ttkAdd :: TreeTrie1Key k -> [TreeTrieKey k] -> TreeTrieKey k +ttkAdd k ks = ttkAdd' k (ttkChildren ks) + +-- | Fixate by removing lowest layer empty children +ttkFixate :: TreeTrieKey k -> TreeTrieKey k +ttkFixate (kk:kks) | all (\(TTM1K k) -> List.null k) kk = [] + | otherwise = kk : ttkFixate kks +ttkFixate _ = [] + +{-# LINE 173 "src/ehc/Base/TreeTrie.chs" #-} +-- | Split key into parent and children components, inverse of ttkAdd' +ttkParentChildren :: TreeTrieKey k -> ( TreeTrie1Key k, [TreeTrieMpKey k] ) +ttkParentChildren k + = case k of + ([TTM1K [h]] : t) -> (h,t) + +{-# LINE 185 "src/ehc/Base/TreeTrie.chs" #-} +-- | Match 1st arg with wildcards to second, returning the to be propagated key to next layer in tree +matchTreeTrieMpKeyTo :: Eq k => TreeTrieMpKey k -> TreeTrieMpKey k -> Maybe (TreeTrieMpKey k -> TreeTrieMpKey k) +matchTreeTrieMpKeyTo l r + | all isJust llrr = Just (\k -> concat $ zipWith ($) (concatMap (fromJust) llrr) k) + | otherwise = Nothing + where llrr = zipWith m l r + m (TTM1K l) (TTM1K r) | length l == length r && all isJust lr + = Just (concatMap fromJust lr) + | otherwise = Nothing + where lr = zipWith m1 l r + m (TTM1K_Any ) (TTM1K []) = Just [] + m (TTM1K_Any ) (TTM1K r ) = Just [const $ replicate (length r) TTM1K_Any] + m1 TT1K_Any _ = Just [const [TTM1K_Any]] + m1 (TT1K_One l) (TT1K_One r) | l == r = Just [\x -> [x]] + m1 _ _ = Nothing + +{-# LINE 207 "src/ehc/Base/TreeTrie.chs" #-} +-- | Keyable values, i.e. capable of yielding a TreeTrieKey for retrieval from a trie +class TreeTrieKeyable x k where + toTreeTrieKey :: x -> TreeTrieKey k + +{-# LINE 217 "src/ehc/Base/TreeTrie.chs" #-} +data TreeTrieLookup + = TTL_Exact -- lookup with exact match + | TTL_WildInTrie -- lookup with wildcard matching in trie + | TTL_WildInKey -- lookup with wildcard matching in key + deriving (Eq) + +{-# LINE 229 "src/ehc/Base/TreeTrie.chs" #-} +-- | Child structure +type TreeTrieChildren k v + = Map.Map (TreeTrieMpKey k) (TreeTrie k v) + +-- | The trie structure, branching out on (1) kind, (2) nr of children, (3) actual key +data TreeTrie k v + = TreeTrie + { ttrieMbVal :: Maybe v -- value + , ttrieSubs :: TreeTrieChildren k v -- children + } + deriving (Typeable, Data) + +emptyTreeTrie, empty :: TreeTrie k v +emptyTreeTrie = TreeTrie Nothing Map.empty + +empty = emptyTreeTrie + +{-# LINE 261 "src/ehc/Base/TreeTrie.chs" #-} +instance (Show k, Show v) => Show (TreeTrie k v) where + showsPrec _ t = showList $ toListByKey t + +instance (PP k, PP v) => PP (TreeTrie k v) where + pp t = ppBracketsCommasBlock $ map (\(a,b) -> ppTreeTrieKey a >#< ":" >#< b) $ toListByKey t + +{-# LINE 275 "src/ehc/Base/TreeTrie.chs" #-} +toFastSeqSubs :: TreeTrieChildren k v -> Seq.FastSeq (TreeTrieKey k,v) +toFastSeqSubs ttries + = Seq.unions + [ Seq.map (\(ks,v) -> (k:ks,v)) $ toFastSeq True t + | (k,t) <- Map.toList ttries + ] + +toFastSeq :: Bool -> TreeTrie k v -> Seq.FastSeq (TreeTrieKey k,v) +toFastSeq inclEmpty ttrie + = (case ttrieMbVal ttrie of + Just v | inclEmpty -> Seq.singleton ([],v) + _ -> Seq.empty + ) + Seq.:++: toFastSeqSubs (ttrieSubs ttrie) + +toListByKey, toList :: TreeTrie k v -> [(TreeTrieKey k,v)] +toListByKey = Seq.toList . toFastSeq True + +toList = toListByKey + +{-# LINE 297 "src/ehc/Base/TreeTrie.chs" #-} +fromListByKeyWith :: Ord k => (v -> v -> v) -> [(TreeTrieKey k,v)] -> TreeTrie k v +fromListByKeyWith cmb = unionsWith cmb . map (uncurry singleton) + +fromListByKey :: Ord k => [(TreeTrieKey k,v)] -> TreeTrie k v +fromListByKey = unions . map (uncurry singleton) + +fromListWith :: Ord k => (v -> v -> v) -> [(TreeTrieKey k,v)] -> TreeTrie k v +fromListWith cmb = fromListByKeyWith cmb + +fromList :: Ord k => [(TreeTrieKey k,v)] -> TreeTrie k v +fromList = fromListByKey + +{-# LINE 317 "src/ehc/Base/TreeTrie.chs" #-} +lookupPartialByKey' :: forall k v v' . (PP k,Ord k) => (TreeTrieKey k -> v -> v') -> TreeTrieLookup -> TreeTrieKey k -> TreeTrie k v -> ([v'],Maybe v') +lookupPartialByKey' mkRes ttrieLookup keys ttrie + = l id mkRes keys ttrie + where l :: (TreeTrieMpKey k -> TreeTrieMpKey k) -> (TreeTrieKey k -> v -> v') -> TreeTrieKey k -> TreeTrie k v -> ([v'],Maybe v') + l = case ttrieLookup of + -- Exact match + TTL_Exact -> \updTKey mkRes keys ttrie -> + case keys of + [] -> dflt mkRes ttrie + (k : ks) + -> case Map.lookup k $ ttrieSubs ttrie of + Just ttrie' + -> ([], m) + where (_,m) = l id (res mkRes k) ks ttrie' + _ -> ([], Nothing) + + -- Match with possible wildcard in Trie + TTL_WildInTrie -> \updTKey mkRes keys ttrie -> + -- tr "TTL_WildInTrie" (ppTreeTrieKey keys >#< (ppTreeTrieMpKey $ updTKey $ replicate (5) (TTM1K []))) $ + case keys of + [] -> dflt mkRes ttrie + (k : ks) + -> (catMaybes mbs ++ concat subs, Nothing) + where (subs,mbs) + = unzip + [ case ks of + [] -> l id (res mkRes k) [] t + (ksk:ksks) | Map.null (ttrieSubs t) -> match (res mkRes k) (fromJust mbm) ks + | otherwise -> l (fromJust mbm) (res mkRes k) ks t + where match mkRes m (km:kms) + = case matchTreeTrieMpKeyTo kt' km of + Just m -> match (res mkRes k) m kms + _ -> ([], Nothing) + where kt' = m $ repeat (TTM1K []) + match mkRes _ [] + = l id (res mkRes k) [] t + | (kt,t) <- Map.toList $ ttrieSubs ttrie + , let kt' = updTKey kt + mbm = -- (\v -> tr "XX" (ppTreeTrieMpKey kt >#< (ppTreeTrieMpKey $ updTKey $ replicate (5) (TTM1K [])) >#< ppTreeTrieMpKey kt' >#< ppTreeTrieMpKey k >#< maybe (pp "--") (\f -> ppTreeTrieMpKey $ f $ repeat (TTM1K [])) v) v) $ + matchTreeTrieMpKeyTo kt' k + , isJust mbm + ] + + -- Match with possible wildcard in Key + TTL_WildInKey -> \updTKey mkRes keys ttrie -> + case keys of + [] -> dflt mkRes ttrie + (k : ks) + -> (catMaybes mbs ++ concat subs, Nothing) + where (subs,mbs) + = unzip + [ case ks of + (ksk:ksks) -> l id (res mkRes kt) (fromJust m ksk : ksks) t + [] | Map.null (ttrieSubs t) -> l id (res mkRes kt) [] t + | otherwise -> l id (res mkRes kt) [fromJust m $ repeat (TTM1K [])] t + | (kt,t) <- Map.toList $ ttrieSubs ttrie + , let m = -- (\v -> tr "YY" (ppTreeTrieMpKey k >#< ppTreeTrieMpKey kt >#< maybe (pp "--") (\f -> ppTreeTrieMpKey $ f $ repeat (TTM1K [])) v) v) $ + matchTreeTrieMpKeyTo k kt + , isJust m + ] + + -- Utils + where dflt mkRes ttrie = ([],fmap (mkRes []) $ ttrieMbVal ttrie) + res mkRes k = \ks v -> mkRes (k : ks) v + +lookupPartialByKey :: (PP k,Ord k) => TreeTrieLookup -> TreeTrieKey k -> TreeTrie k v -> ([v],Maybe v) +lookupPartialByKey = lookupPartialByKey' (\_ v -> v) + +lookupByKey, lookup :: (PP k,Ord k) => TreeTrieKey k -> TreeTrie k v -> Maybe v +lookupByKey keys ttrie = snd $ lookupPartialByKey TTL_WildInTrie keys ttrie + +lookup = lookupByKey + +{-# LINE 392 "src/ehc/Base/TreeTrie.chs" #-} +lookupResultToList :: ([v],Maybe v) -> [v] +lookupResultToList (vs,mv) = maybeToList mv ++ vs + +{-# LINE 401 "src/ehc/Base/TreeTrie.chs" #-} +isEmpty :: TreeTrie k v -> Bool +isEmpty ttrie + = isNothing (ttrieMbVal ttrie) + && Map.null (ttrieSubs ttrie) + +null :: TreeTrie k v -> Bool +null = isEmpty + +{-# LINE 411 "src/ehc/Base/TreeTrie.chs" #-} +elems :: TreeTrie k v -> [v] +elems = map snd . toListByKey + +{-# LINE 420 "src/ehc/Base/TreeTrie.chs" #-} +singleton :: Ord k => TreeTrieKey k -> v -> TreeTrie k v +singleton keys val + = s keys + where s [] = TreeTrie (Just val) Map.empty + s (k : ks) = TreeTrie Nothing (Map.singleton k $ singleton ks val) + +singletonKeyable :: (Ord k,TreeTrieKeyable v k) => v -> TreeTrie k v +singletonKeyable val = singleton (toTreeTrieKey val) val + +{-# LINE 435 "src/ehc/Base/TreeTrie.chs" #-} +unionWith :: Ord k => (v -> v -> v) -> TreeTrie k v -> TreeTrie k v -> TreeTrie k v +unionWith cmb t1 t2 + = TreeTrie + { ttrieMbVal = mkMb cmb (ttrieMbVal t1) (ttrieMbVal t2) + , ttrieSubs = Map.unionWith (unionWith cmb) (ttrieSubs t1) (ttrieSubs t2) + } + where mkMb _ j Nothing = j + mkMb _ Nothing j = j + mkMb cmb (Just x1) (Just x2) = Just $ cmb x1 x2 + +union :: Ord k => TreeTrie k v -> TreeTrie k v -> TreeTrie k v +union = unionWith const + +unionsWith :: Ord k => (v -> v -> v) -> [TreeTrie k v] -> TreeTrie k v +unionsWith cmb [] = emptyTreeTrie +unionsWith cmb ts = foldr1 (unionWith cmb) ts + +unions :: Ord k => [TreeTrie k v] -> TreeTrie k v +unions = unionsWith const + +{-# LINE 457 "src/ehc/Base/TreeTrie.chs" #-} +insertByKeyWith :: Ord k => (v -> v -> v) -> TreeTrieKey k -> v -> TreeTrie k v -> TreeTrie k v +insertByKeyWith cmb keys val ttrie = unionsWith cmb [singleton keys val,ttrie] + +insertByKey :: Ord k => TreeTrieKey k -> v -> TreeTrie k v -> TreeTrie k v +insertByKey = insertByKeyWith const + +insert :: Ord k => TreeTrieKey k -> v -> TreeTrie k v -> TreeTrie k v +insert = insertByKey + +insertKeyable :: (Ord k,TreeTrieKeyable v k) => v -> TreeTrie k v -> TreeTrie k v +insertKeyable val = insertByKey (toTreeTrieKey val) val + +{-# LINE 475 "src/ehc/Base/TreeTrie.chs" #-} +deleteByKey, delete :: Ord k => TreeTrieKey k -> TreeTrie k v -> TreeTrie k v +deleteByKey keys ttrie + = d keys ttrie + where d [] t + = t {ttrieMbVal = Nothing} + d (k : ks) t + = case fmap (d ks) $ Map.lookup k $ ttrieSubs t of + Just c | isEmpty c -> t { ttrieSubs = k `Map.delete` ttrieSubs t } + | otherwise -> t { ttrieSubs = Map.insert k c $ ttrieSubs t } + _ -> t + +delete = deleteByKey + +{-# LINE 490 "src/ehc/Base/TreeTrie.chs" #-} +deleteListByKey :: Ord k => [TreeTrieKey k] -> TreeTrie k v -> TreeTrie k v +deleteListByKey keys ttrie = foldl (\t k -> deleteByKey k t) ttrie keys + +{-# LINE 499 "src/ehc/Base/TreeTrie.chs" #-} +instance Serialize k => Serialize (TreeTrie1Key k) where + sput (TT1K_Any ) = sputWord8 0 + sput (TT1K_One a ) = sputWord8 1 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> return TT1K_Any + 1 -> liftM TT1K_One sget + +instance Serialize k => Serialize (TreeTrieMp1Key k) where + sput (TTM1K_Any ) = sputWord8 0 -- >> sput a + sput (TTM1K a ) = sputWord8 1 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> return TTM1K_Any -- sget + 1 -> liftM TTM1K sget + +instance (Ord k, Serialize k, Serialize v) => Serialize (TreeTrie k v) where + sput (TreeTrie a b) = sput a >> sput b + sget = liftM2 TreeTrie sget sget + + diff --git a/src/UHC/Light/Compiler/Base/UID.hs b/src/UHC/Light/Compiler/Base/UID.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Base/UID.hs @@ -0,0 +1,184 @@ +module UHC.Light.Compiler.Base.UID +( mkNewLevUID, mkNewLevUID2, mkNewLevUID3, mkNewLevUID4, mkNewLevUID5, mkNewLevUID6, mkNewLevUID7, mkNewLevUID8, uidNext, mkNewUID, mkNewUIDL, uidNull, uidChild, mkInfNewUIDL +, FreshUidT, FreshUid, runFreshUidT, runFreshUid, evalFreshUid +, MonadFreshUID (..) +, UID (..) +, mkUID +, uidFromInt +, uidStart, uidUnused +, nextUnique +, UIDS +, mkNewLevUIDL, mkInfNewLevUIDL +, showUIDParseable, ppUIDParseable +, uidSimplifications ) +where +import UHC.Util.Pretty +import qualified Data.Set as Set +import Data.List +import Control.Monad.State +import Control.Monad.Identity +import Control.Monad +import UHC.Util.Binary as B +import UHC.Util.Serialize +import Data.Hashable + + + + + +{-# LINE 37 "src/ehc/Base/UID.chs" #-} +type FreshUidT m = StateT UID m +type FreshUid = FreshUidT Identity + +{- +freshUID :: MonadState UID m => m UID +freshUID = state $ \x -> (x, uidNext x) +-} + +runFreshUidT :: Monad m => FreshUidT m a -> UID -> m (a,UID) +runFreshUidT f u = runStateT f u +{-# INLINE runFreshUidT #-} + +runFreshUid :: FreshUid a -> UID -> (a,UID) +runFreshUid f u = runIdentity $ runFreshUidT f u +{-# INLINE runFreshUid #-} + +evalFreshUid :: FreshUid a -> UID -> a +evalFreshUid f u = fst $ runIdentity $ runFreshUidT f u +{-# INLINE evalFreshUid #-} + +{-# LINE 59 "src/ehc/Base/UID.chs" #-} +class Monad m => MonadFreshUID m where + -- | Fresh single UID + freshUID :: m UID + freshUID = freshInfUID + + -- | Fresh infinite range of UID + freshInfUID :: m UID + freshInfUID = freshUID + +-- TBD: flip results of mkNewLevUID (etc) to be in agreement with behavior of state +instance Monad m => MonadFreshUID (FreshUidT m) where + freshUID = state $ \x -> (x, uidNext x) + {-# INLINE freshUID #-} + + freshInfUID = state $ \x -> (uidChild x, uidNext x) + {-# INLINE freshInfUID #-} + +{-# LINE 83 "src/ehc/Base/UID.chs" #-} +data UID = UID { uidHash :: !Int, uidInts :: ![Int] } + deriving (Eq,Ord) + +{-# LINE 92 "src/ehc/Base/UID.chs" #-} +mkUID :: [Int] -> UID +mkUID is = UID (hash is) is + +{-# LINE 101 "src/ehc/Base/UID.chs" #-} +type UIDL = [UID] + +{-# LINE 105 "src/ehc/Base/UID.chs" #-} +type UIDS = Set.Set UID + +{-# LINE 109 "src/ehc/Base/UID.chs" #-} +instance Show UID where + show uid = concat . intersperse "_" . map show . reverse $ uidInts uid + +{-# LINE 114 "src/ehc/Base/UID.chs" #-} +instance Hashable UID where + hashWithSalt salt (UID h _) = salt `hashWithSalt` h + +{-# LINE 119 "src/ehc/Base/UID.chs" #-} +uidNext :: UID -> UID +uidNext (UID _ (n:ns)) = mkUID (n+1:ns) + +uidChild :: UID -> UID +uidChild (UID _ ns) = mkUID (0:ns) + +{-# LINE 135 "src/ehc/Base/UID.chs" #-} +mkNewLevUID :: UID -> (UID,UID) +mkNewLevUID u = (uidNext u, uidChild u) + +{-# LINE 140 "src/ehc/Base/UID.chs" #-} +uidFromInt :: Int -> UID +uidFromInt i = mkUID [i] + +{-# LINE 145 "src/ehc/Base/UID.chs" #-} +uidStart :: UID +uidStart = uidFromInt 0 + +uidUnused :: UID +uidUnused = uidFromInt (-1) + +{-# LINE 153 "src/ehc/Base/UID.chs" #-} +mkNewLevUID2 u = let { (u',u1) = mkNewLevUID u; (u'',u2) = mkNewLevUID u'} in (u'',u1,u2) +mkNewLevUID3 u = let { (u',u1,u2) = mkNewLevUID2 u; (u'',u3) = mkNewLevUID u'} in (u'',u1,u2,u3) +mkNewLevUID4 u = let { (u',u1,u2) = mkNewLevUID2 u; (u'',u3,u4) = mkNewLevUID2 u'} in (u'',u1,u2,u3,u4) +mkNewLevUID5 u = let { (u',u1,u2) = mkNewLevUID2 u; (u'',u3,u4,u5) = mkNewLevUID3 u'} in (u'',u1,u2,u3,u4,u5) +mkNewLevUID6 u = let { (u',u1,u2,u3) = mkNewLevUID3 u; (u'',u4,u5,u6) = mkNewLevUID3 u'} in (u'',u1,u2,u3,u4,u5,u6) +mkNewLevUID7 u = let { (u',u1,u2,u3,u4) = mkNewLevUID4 u; (u'',u5,u6,u7) = mkNewLevUID3 u'} in (u'',u1,u2,u3,u4,u5,u6,u7) +mkNewLevUID8 u = let { (u',u1,u2,u3,u4) = mkNewLevUID4 u; (u'',u5,u6,u7,u8) = mkNewLevUID4 u'} in (u'',u1,u2,u3,u4,u5,u6,u7,u8) + +uidNull :: UID +uidNull = mkUID [] + +mkNewUID :: UID -> (UID,UID) +mkNewUID uid = (uidNext uid,uid) + +mkInfNewUIDL' :: (UID -> (UID,UID)) -> UID -> [UID] +mkInfNewUIDL' mk uid + = let l = drop 1 $ iterate (\(nxt,uid) -> mk nxt) $ mkNewUID uid + in map snd l + +mkNewUIDL' :: (UID -> (UID,UID)) -> Int -> UID -> [UID] -- assume sz > 0 +mkNewUIDL' mk sz uid + = take sz (mkInfNewUIDL' mk uid) + +mkNewUIDL :: Int -> UID -> [UID] -- assume sz > 0 +mkNewUIDL = mkNewUIDL' mkNewUID + +mkInfNewUIDL :: UID -> [UID] +mkInfNewUIDL = mkInfNewUIDL' mkNewUID + +instance PP UID where + pp = text . show + +{-# LINE 187 "src/ehc/Base/UID.chs" #-} +-- | Inverse of pUID +showUIDParseable :: UID -> String +-- showUIDParseable uid = "%[" ++ (concat $ intersperse "/" $ map show $ uidInts uid) ++ "]" +showUIDParseable uid = "`{" ++ (concat $ intersperse "," $ map show $ uidInts uid) ++ "}" + +-- | Inverse of pUID +ppUIDParseable :: UID -> PP_Doc +ppUIDParseable = pp . showUIDParseable + +{-# LINE 198 "src/ehc/Base/UID.chs" #-} +mkInfNewLevUIDL :: UID -> [UID] +mkInfNewLevUIDL = mkInfNewUIDL' mkNewLevUID + +mkNewLevUIDL :: Int -> UID -> [UID] +mkNewLevUIDL = mkNewUIDL' mkNewLevUID + +{-# LINE 210 "src/ehc/Base/UID.chs" #-} +-- | Simplifications obtained by omitting all but 1 of the Int's, then re-adding one by one, omitting the original +uidSimplifications :: UID -> [UID] +uidSimplifications = map (mkUID . reverse) . drop 1 . init . inits . reverse . uidInts + +{-# LINE 220 "src/ehc/Base/UID.chs" #-} +nextUnique = mkNewLevUID + +{-# LINE 228 "src/ehc/Base/UID.chs" #-} +deriving instance Typeable UID +deriving instance Data UID + +{-# LINE 246 "src/ehc/Base/UID.chs" #-} +instance Binary UID where + put (UID a b) = B.put a >> B.put b + get = liftM2 UID B.get B.get + +instance Serialize UID where + sput = sputShared + sget = sgetShared + sputNested = sputPlain + sgetNested = sgetPlain + diff --git a/src/UHC/Light/Compiler/CHR.hs b/src/UHC/Light/Compiler/CHR.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR.hs @@ -0,0 +1,96 @@ +module UHC.Light.Compiler.CHR +( module UHC.Light.Compiler.CHR.Key +, CHR (..) +, CHREmptySubstitution (..) +, CHRMatchable (..) +, CHRCheckable (..) +, (<==>), (==>), (|>) ) +where +import qualified UHC.Light.Compiler.Base.TreeTrie as TreeTrie +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.VarMp +import Data.Monoid +import qualified Data.Set as Set +import UHC.Util.Pretty +import UHC.Light.Compiler.CHR.Key +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 33 "src/ehc/CHR.chs" #-} +-- | A CHR (rule) consist of head (simplification + propagation, boundary indicated by an Int), guard, and a body. All may be empty, but not all at the same time. +data CHR cnstr guard subst + = CHR + { chrHead :: ![cnstr] + , chrSimpSz :: !Int -- length of the part of the head which is the simplification part + , chrGuard :: ![guard] -- subst -> Maybe subst + , chrBody :: ![cnstr] + } + deriving (Typeable, Data) + +emptyCHRGuard :: [a] +emptyCHRGuard = [] + +{-# LINE 50 "src/ehc/CHR.chs" #-} +instance Show (CHR c g s) where + show _ = "CHR" + +{-# LINE 55 "src/ehc/CHR.chs" #-} +instance (PP c,PP g) => PP (CHR c g s) where + pp chr + = case chr of + (CHR h@(_:_) sz g b) | sz == 0 -> ppChr ([ppL h, pp "==>"] ++ ppGB g b) + (CHR h@(_:_) sz g b) | sz == length h -> ppChr ([ppL h, pp "<==>"] ++ ppGB g b) + (CHR h@(_:_) sz g b) -> ppChr ([ppL (take sz h), pp "|", ppL (drop sz h), pp "<==>"] ++ ppGB g b) + (CHR [] _ g b) -> ppChr (ppGB g b) + where ppGB g@(_:_) b@(_:_) = [ppL g, "|" >#< ppL b] + ppGB g@(_:_) [] = [ppL g >#< "|"] + ppGB [] b@(_:_) = [ppL b] + ppGB [] [] = [] + ppL [x] = pp x + ppL xs = ppBracketsCommasBlock xs -- ppParensCommasBlock xs + ppChr l = vlist l -- ppCurlysBlock + +{-# LINE 77 "src/ehc/CHR.chs" #-} +instance TTKeyable cnstr => TTKeyable (CHR cnstr guard subst) where + toTTKey' o chr = toTTKey' o $ head $ chrHead chr + +{-# LINE 86 "src/ehc/CHR.chs" #-} +instance (VarExtractable c v,VarExtractable g v) => VarExtractable (CHR c g s) v where + varFreeSet (CHR {chrHead=h, chrGuard=g, chrBody=b}) + = Set.unions $ concat [map varFreeSet h, map varFreeSet g, map varFreeSet b] + +instance (VarUpdatable c s,VarUpdatable g s) => VarUpdatable (CHR c g s) s where + varUpd s r@(CHR {chrHead=h, chrGuard=g, chrBody=b}) + = r {chrHead = map (varUpd s) h, chrGuard = map (varUpd s) g, chrBody = map (varUpd s) b} + +{-# LINE 102 "src/ehc/CHR.chs" #-} +class CHREmptySubstitution subst where + chrEmptySubst :: subst + +{-# LINE 113 "src/ehc/CHR.chs" #-} +class (TTKeyable x) => CHRMatchable env x subst where --- | x -> subst env where + chrMatchTo :: env -> subst -> x -> x -> Maybe subst + +{-# LINE 124 "src/ehc/CHR.chs" #-} +class CHRCheckable env x subst where + chrCheck :: env -> subst -> x -> Maybe subst + +{-# LINE 133 "src/ehc/CHR.chs" #-} +infix 1 <==>, ==> +infixr 0 |> + +(<==>), (==>) :: [c] -> [c] -> CHR c g s +hs <==> bs = CHR hs (length hs) emptyCHRGuard bs +hs ==> bs = CHR hs 0 emptyCHRGuard bs + +(|>) :: CHR c g s -> [g] -> CHR c g s +chr |> g = chr {chrGuard = chrGuard chr ++ g} + +{-# LINE 157 "src/ehc/CHR.chs" #-} +instance (Serialize c,Serialize g,Serialize s) => Serialize (CHR c g s) where + sput (CHR a b c d) = sput a >> sput b >> sput c >> sput d + sget = liftM4 CHR sget sget sget sget diff --git a/src/UHC/Light/Compiler/CHR/Constraint.hs b/src/UHC/Light/Compiler/CHR/Constraint.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR/Constraint.hs @@ -0,0 +1,196 @@ +module UHC.Light.Compiler.CHR.Constraint +( Constraint (..) +, mkReduction +, cnstrReducablePart +, UnresolvedTrace (..) +, cnstrMpSingletonL, cnstrMpFromList +, ConstraintToInfoTraceMp +, cnstrTraceMpSingleton, cnstrTraceMpLiftTrace, cnstrTraceMpElimTrace, cnstrTraceMpFromList +, ConstraintToInfoMap +, emptyCnstrMp +, cnstrMpUnion, cnstrMpUnions +, cnstrRequiresSolve ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Key +import UHC.Light.Compiler.Base.TreeTrie +import UHC.Light.Compiler.Substitutable +import UHC.Util.Pretty as PP +import UHC.Util.Utils +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.VarMp +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Typeable (Typeable,Typeable2) +import Data.Generics (Data) +import UHC.Light.Compiler.Opts.Base + + + + +{-# LINE 33 "src/ehc/CHR/Constraint.chs" #-} +-- | A Constraint is abstracted over the exact predicate, but differentiates on the role: to prove, can be assumed, and side effect of reduction +data Constraint p info + = Prove { cnstrPred :: !p } -- proof obligation + | Assume { cnstrPred :: !p } -- assumed constraint + | Reduction -- 'side effect', residual info used by (e.g.) codegeneration + { cnstrPred :: !p -- the pred to which reduction was done + , cnstrInfo :: !info -- additional reduction specific info w.r.t. codegeneration + , cnstrFromPreds :: ![p] -- the preds from which reduction was done + , cnstrVarMp :: VarMp -- additional bindings for type (etc.) variables, i.e. improving substitution + } + deriving (Eq, Ord, Show) + +{-# LINE 49 "src/ehc/CHR/Constraint.chs" #-} +mkReduction :: p -> info -> [p] -> Constraint p info +mkReduction p i ps + = Reduction p i ps + varlookupEmpty + +{-# LINE 58 "src/ehc/CHR/Constraint.chs" #-} +deriving instance Typeable2 Constraint +deriving instance (Data x, Data y) => Data (Constraint x y) + +{-# LINE 63 "src/ehc/CHR/Constraint.chs" #-} +-- | Dissection of Constraint, including reconstruction function +cnstrReducablePart :: Constraint p info -> Maybe (String,p,p->Constraint p info) +cnstrReducablePart (Prove p) = Just ("Prf",p,Prove) +cnstrReducablePart (Assume p) = Just ("Ass",p,Assume) +cnstrReducablePart _ = Nothing + +{-# LINE 76 "src/ehc/CHR/Constraint.chs" #-} +instance (CHRMatchable env p s) => CHRMatchable env (Constraint p info) s where + chrMatchTo env s c1 c2 + = do { (_,p1,_) <- cnstrReducablePart c1 + ; (_,p2,_) <- cnstrReducablePart c2 + ; chrMatchTo env s p1 p2 + } + +{-# LINE 85 "src/ehc/CHR/Constraint.chs" #-} +instance TTKeyable p => TTKeyable (Constraint p info) where + toTTKey' o c -- = maybe [] (\(s,p,_) -> ttkAdd (TT1K_One $ Key_Str s) [toTTKey' o p]) $ cnstrReducablePart c + = case cnstrReducablePart c of + Just (s,p,_) -> ttkAdd' (TT1K_One $ Key_Str s) cs + where (_,cs) = toTTKeyParentChildren' o p + _ -> panic "TTKeyable (Constraint p info).toTTKey'" -- ttkEmpty + +{-# LINE 94 "src/ehc/CHR/Constraint.chs" #-} +instance (VarExtractable p v,VarExtractable info v) => VarExtractable (Constraint p info) v where + varFreeSet c + = case cnstrReducablePart c of + Just (_,p,_) -> varFreeSet p + _ -> Set.empty + +instance (VarUpdatable p s,VarUpdatable info s) => VarUpdatable (Constraint p info) s where + varUpd s (Prove p ) = Prove (varUpd s p) + varUpd s (Assume p ) = Assume (varUpd s p) + varUpd s r@(Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps}) + = r {cnstrPred=varUpd s p, cnstrInfo=varUpd s i, cnstrFromPreds=map (varUpd s) ps} + +{-# LINE 112 "src/ehc/CHR/Constraint.chs" #-} +-- | The trace of an unresolved predicate +data UnresolvedTrace p info + = UnresolvedTrace_None -- no trace required when all is resolved + | UnresolvedTrace_Red -- ok reduction, with failure deeper down + { utraceRedFrom :: p + , utraceInfoTo2From :: info + , utraceRedTo :: [UnresolvedTrace p info] + } + | UnresolvedTrace_Fail -- failed reduction + { utraceRedFrom :: p + -- , utraceInfoTo2From :: info + , utraceRedTo :: [UnresolvedTrace p info] + } + | UnresolvedTrace_Overlap -- choice could not be made + { utraceRedFrom :: p + , utraceRedChoices :: [(info,[UnresolvedTrace p info])] + } + deriving Show + +instance Eq p => Eq (UnresolvedTrace p info) where + t1 == t2 = True -- utraceRedFrom t1 == utraceRedFrom t2 + +instance (PP p, PP info) => PP (UnresolvedTrace p info) where + pp x = case x of + UnresolvedTrace_None -> PP.empty + UnresolvedTrace_Red p i us -> p >|< ":" >#< i >-< indent 2 (vlist $ map pp us) + UnresolvedTrace_Fail p us -> p >|< ": FAIL" >-< indent 2 (vlist $ map pp us) + UnresolvedTrace_Overlap p uss -> p >|< ": OVERLAP" >-< indent 2 (vlist $ map (\(i,u) -> i >-< indent 2 (vlist $ map pp u)) uss) + +{-# LINE 147 "src/ehc/CHR/Constraint.chs" #-} +-- | Map from constraint to something +type ConstraintMp' p info x = Map.Map (Constraint p info) [x] + +{-# LINE 152 "src/ehc/CHR/Constraint.chs" #-} +cnstrMpSingletonL :: Constraint p i -> [x] -> ConstraintMp' p i x +cnstrMpSingletonL c xs = Map.singleton c xs + +cnstrMpSingleton :: Constraint p i -> x -> ConstraintMp' p i x +cnstrMpSingleton c x = cnstrMpSingletonL c [x] + +cnstrMpFromList :: (Ord p, Ord i) => [(Constraint p i,x)] -> ConstraintMp' p i x +cnstrMpFromList l = Map.fromListWith (++) [ (c,[x]) | (c,x) <- l ] + +cnstrMpMap :: (Ord p, Ord i) => (x -> y) -> ConstraintMp' p i x -> ConstraintMp' p i y +cnstrMpMap f = Map.map (map f) + +{-# LINE 166 "src/ehc/CHR/Constraint.chs" #-} +-- | Map from constraint to info + trace +type ConstraintToInfoTraceMp p info = ConstraintMp' p info (info,[UnresolvedTrace p info]) + +{-# LINE 171 "src/ehc/CHR/Constraint.chs" #-} +cnstrTraceMpFromList :: (Ord p, Ord i) => [(Constraint p i,(i,[UnresolvedTrace p i]))] -> ConstraintToInfoTraceMp p i +cnstrTraceMpFromList = cnstrMpFromList + +cnstrTraceMpSingleton :: Constraint p i -> i -> [UnresolvedTrace p i] -> ConstraintToInfoTraceMp p i +cnstrTraceMpSingleton c i ts = cnstrMpSingleton c (i,ts) + +cnstrTraceMpElimTrace :: (Ord p, Ord i) => ConstraintToInfoTraceMp p i -> ConstraintToInfoMap p i +cnstrTraceMpElimTrace = cnstrMpMap fst + +cnstrTraceMpLiftTrace :: (Ord p, Ord i) => ConstraintToInfoMap p i -> ConstraintToInfoTraceMp p i +cnstrTraceMpLiftTrace = cnstrMpMap (\x -> (x,[])) + +{-# LINE 185 "src/ehc/CHR/Constraint.chs" #-} +-- | Map from constraint to info +type ConstraintToInfoMap p info = ConstraintMp' p info info + +{-# LINE 190 "src/ehc/CHR/Constraint.chs" #-} +emptyCnstrMp :: ConstraintMp' p info x +emptyCnstrMp = Map.empty + +{-# LINE 200 "src/ehc/CHR/Constraint.chs" #-} +cnstrMpUnion :: (Ord p, Ord i) => ConstraintMp' p i x -> ConstraintMp' p i x -> ConstraintMp' p i x +cnstrMpUnion = Map.unionWith (++) + +cnstrMpUnions :: (Ord p, Ord i) => [ConstraintMp' p i x] -> ConstraintMp' p i x +cnstrMpUnions = Map.unionsWith (++) + +{-# LINE 212 "src/ehc/CHR/Constraint.chs" #-} +-- | Predicate for whether solving is required +cnstrRequiresSolve :: Constraint p info -> Bool +cnstrRequiresSolve (Reduction {}) = False +cnstrRequiresSolve _ = True + +{-# LINE 223 "src/ehc/CHR/Constraint.chs" #-} +instance (PP p, PP info) => PP (Constraint p info) where + pp (Prove p ) = "Prove" >#< p + pp (Assume p ) = "Assume" >#< p + pp (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps}) + = "Red" >#< p >#< "<" >#< i >#< "<" >#< ppBracketsCommas ps + +{-# LINE 235 "src/ehc/CHR/Constraint.chs" #-} +instance (Serialize p, Serialize i) => Serialize (Constraint p i) where + sput (Prove a ) = sputWord8 0 >> sput a + sput (Assume a ) = sputWord8 1 >> sput a + sput (Reduction a b c d) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d + sget = do t <- sgetWord8 + case t of + 0 -> liftM Prove sget + 1 -> liftM Assume sget + 2 -> liftM4 Reduction sget sget sget sget + diff --git a/src/UHC/Light/Compiler/CHR/Key.hs b/src/UHC/Light/Compiler/CHR/Key.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR/Key.hs @@ -0,0 +1,89 @@ +module UHC.Light.Compiler.CHR.Key +( Key (..) +, TTKeyableOpts (..), defaultTTKeyableOpts +, TTKeyable (..) +, toTTKey ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TreeTrie +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import Data.Typeable (Typeable) +import Data.Generics (Data) +import UHC.Util.Serialize +import Control.Monad + + + + +{-# LINE 35 "src/ehc/CHR/Key.chs" #-} +data Key + = Key_HNm !HsName -- type constant, its name + | Key_UID !UID -- type variable, its id, used with TKK_Partial + | Key_Str !String -- arbitrary string + | Key_TyQu !TyQu -- quantified type, used with TKK_Partial + | Key_Ty !Ty -- catchall for the rest, used with TKK_Partial + deriving ( Eq, Ord + , Typeable, Data + ) + +{-# LINE 59 "src/ehc/CHR/Key.chs" #-} +instance Show Key where + show (Key_HNm n) = "H:" ++ show n + show (Key_UID n) = "U:" ++ show n + show (Key_Str n) = "S:" ++ n + show (Key_TyQu n) = "Q:" ++ show n + show (Key_Ty n) = "T:" ++ show n + +{-# LINE 73 "src/ehc/CHR/Key.chs" #-} +instance PP Key where + pp (Key_HNm n) = "H:" >|< n + pp (Key_UID n) = "U:" >|< n + pp (Key_Str n) = "S:" >|< n + pp (Key_TyQu n) = "Q:" >|< show n + pp (Key_Ty n) = "T:" >|< n + +{-# LINE 140 "src/ehc/CHR/Key.chs" #-} +data TTKeyableOpts + = TTKeyableOpts + { ttkoptsVarsAsWild :: Bool -- treat vars as wildcards + } + +defaultTTKeyableOpts = TTKeyableOpts True + +{-# LINE 149 "src/ehc/CHR/Key.chs" #-} +-- | TreeTrie key construction +class TTKeyable x where + toTTKey' :: TTKeyableOpts -> x -> TreeTrieKey Key -- option parameterized constuction + toTTKeyParentChildren' :: TTKeyableOpts -> x -> (TreeTrie1Key Key, [TreeTrieMpKey Key]) -- building block: parent of children + children + + -- default impl + toTTKey' o = uncurry ttkAdd' . toTTKeyParentChildren' o + toTTKeyParentChildren' o = ttkParentChildren . toTTKey' o + +{-# LINE 160 "src/ehc/CHR/Key.chs" #-} +toTTKey :: TTKeyable x => x -> TreeTrieKey Key +toTTKey = toTTKey' defaultTTKeyableOpts + +{-# LINE 165 "src/ehc/CHR/Key.chs" #-} +instance TTKeyable x => TreeTrieKeyable x Key where + toTreeTrieKey = toTTKey + +{-# LINE 174 "src/ehc/CHR/Key.chs" #-} +instance Serialize Key where + sput (Key_HNm a) = sputWord8 0 >> sput a + sput (Key_UID a) = sputWord8 1 >> sput a + sput (Key_Str a) = sputWord8 2 >> sput a + sput (Key_TyQu a) = sputWord8 3 >> sput a + sput (Key_Ty a) = sputWord8 4 >> sput a + sget = do + t <- sgetWord8 + case t of + 0 -> liftM Key_HNm sget + 1 -> liftM Key_UID sget + 2 -> liftM Key_Str sget + 3 -> liftM Key_TyQu sget + 4 -> liftM Key_Ty sget + diff --git a/src/UHC/Light/Compiler/CHR/Solve.hs b/src/UHC/Light/Compiler/CHR/Solve.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR/Solve.hs @@ -0,0 +1,579 @@ +module UHC.Light.Compiler.CHR.Solve +( CHRStore, emptyCHRStore +, chrStoreFromElems, chrStoreUnion, chrStoreUnions, chrStoreSingletonElem +, chrStoreToList, chrStoreElems +, ppCHRStore, ppCHRStore' +, SolveStep (..), SolveTrace +, ppSolveTrace +, SolveState, emptySolveState +, solveStateResetDone +, chrSolveStateDoneConstraints, chrSolveStateTrace +, chrSolve, chrSolve' +, chrSolve'' ) +where +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Key +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.VarLookup +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TreeTrie as TreeTrie +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List as List +import Data.Maybe +import UHC.Util.Pretty as Pretty +import UHC.Util.Utils +import Data.Typeable (Typeable,Typeable1) +import Data.Generics (Data) +import UHC.Util.Serialize +import Control.Monad + + + + +{-# LINE 93 "src/ehc/CHR/Solve.chs" #-} +type CHRTrie k v = TreeTrie.TreeTrie k v +type CHRTrieKey = TreeTrie.TreeTrieKey Key +type CHRLookupHow = TreeTrieLookup + +chrLookupHowExact = TTL_Exact +chrLookupHowWildAtTrie = TTL_WildInTrie +chrLookupHowWildAtKey = TTL_WildInKey + +emptyCHRTrie = TreeTrie.empty + +ppCHRTrieKey :: CHRTrieKey -> PP_Doc +ppCHRTrieKey = ppTreeTrieKey + +chrTrieFromListByKeyWith :: (v -> v -> v) -> [(CHRTrieKey,v)] -> CHRTrie Key v +chrTrieFromListByKeyWith = TreeTrie.fromListByKeyWith + +chrTrieToListByKey :: CHRTrie Key v -> [(CHRTrieKey,v)] +chrTrieToListByKey = TreeTrie.toListByKey + +chrTrieUnionWith :: (v -> v -> v) -> CHRTrie Key v -> CHRTrie Key v -> CHRTrie Key v +chrTrieUnionWith = TreeTrie.unionWith + +chrTrieUnion :: CHRTrie Key v -> CHRTrie Key v -> CHRTrie Key v +chrTrieUnion = TreeTrie.union + +chrTrieElems :: CHRTrie Key v -> [v] +chrTrieElems = TreeTrie.elems + +chrTrieDeleteListByKey :: [CHRTrieKey] -> CHRTrie Key v -> CHRTrie Key v +chrTrieDeleteListByKey = TreeTrie.deleteListByKey + +chrTrieFromListPartialExactWith :: (v -> v -> v) -> [(CHRTrieKey,v)] -> CHRTrie Key v +chrTrieFromListPartialExactWith = TreeTrie.fromListByKeyWith + +chrTrieLookup' :: (CHRTrieKey -> v -> v') -> CHRLookupHow -> CHRTrieKey -> CHRTrie Key v -> ([v'],Maybe v') +chrTrieLookup' = TreeTrie.lookupPartialByKey' + +chrTrieLookup :: CHRLookupHow -> CHRTrieKey -> CHRTrie Key v -> ([v],Maybe v) +chrTrieLookup = TreeTrie.lookupPartialByKey + +chrToKey :: TTKeyable x => x -> CHRTrieKey +chrToKey = ttkFixate . toTTKey + +chrToWorkKey :: TTKeyable x => x -> CHRTrieKey +chrToWorkKey = ttkFixate . toTTKey' (defaultTTKeyableOpts {ttkoptsVarsAsWild = False}) + +{-# LINE 145 "src/ehc/CHR/Solve.chs" #-} +type CHRKey = CHRTrieKey +type UsedByKey = (CHRKey,Int) + +{-# LINE 150 "src/ehc/CHR/Solve.chs" #-} +-- | A CHR as stored in a CHRStore, requiring additional info for efficiency +data StoredCHR p i g s + = StoredCHR + { storedChr :: !(CHR (Constraint p i) g s) -- the CHR + , storedKeyedInx :: !Int -- index of constraint for which is keyed into store + , storedKeys :: ![Maybe CHRKey] -- keys of all constraints; at storedKeyedInx: Nothing + , storedIdent :: !UsedByKey -- the identification of a CHR, used for propagation rules (see remark at begin) + } + deriving (Typeable, Data) + +-- | The size of the simplification part of a CHR +storedSimpSz :: StoredCHR p i g s -> Int +storedSimpSz = chrSimpSz . storedChr + +-- | A CHR store is a trie structure +newtype CHRStore pred info guard subst + = CHRStore + { chrstoreTrie :: CHRTrie Key [StoredCHR pred info guard subst] + } + deriving (Typeable, Data) + +mkCHRStore trie = CHRStore trie + +emptyCHRStore :: CHRStore pred info guard subst +emptyCHRStore = mkCHRStore emptyCHRTrie + +{-# LINE 182 "src/ehc/CHR/Solve.chs" #-} +-- | Combine lists of stored CHRs by concat, adapting their identification nr to be unique +cmbStoredCHRs :: [StoredCHR p i g s] -> [StoredCHR p i g s] -> [StoredCHR p i g s] +cmbStoredCHRs s1 s2 + = map (\s@(StoredCHR {storedIdent=(k,nr)}) -> s {storedIdent = (k,nr+l)}) s1 ++ s2 + where l = length s2 + +{-# LINE 190 "src/ehc/CHR/Solve.chs" #-} +instance Show (StoredCHR p i g s) where + show _ = "StoredCHR" + +ppStoredCHR :: (PP p, PP i, PP g) => StoredCHR p i g s -> PP_Doc +ppStoredCHR c@(StoredCHR {storedIdent=(idKey,idSeqNr)}) + = storedChr c + >-< indent 2 + (ppParensCommas + [ pp $ storedKeyedInx c + , pp $ storedSimpSz c + , "keys" >#< (ppBracketsCommas $ map (maybe (pp "?") ppCHRTrieKey) $ storedKeys c) + , "ident" >#< ppParensCommas [ppCHRTrieKey idKey,pp idSeqNr] + ]) + +instance (PP p, PP i, PP g) => PP (StoredCHR p i g s) where + pp = ppStoredCHR + +{-# LINE 209 "src/ehc/CHR/Solve.chs" #-} +-- | Convert from list to store +chrStoreFromElems :: (TTKeyable p) => [CHR (Constraint p i) g s] -> CHRStore p i g s +chrStoreFromElems chrs + = mkCHRStore + $ chrTrieFromListByKeyWith cmbStoredCHRs + [ (k,[StoredCHR chr i ks' (concat ks,0)]) + | chr <- chrs + , let cs = chrHead chr + simpSz = chrSimpSz chr + ks = map chrToKey cs + , (c,k,i) <- zip3 cs ks [0..] + , let (ks1,(_:ks2)) = splitAt i ks + ks' = map Just ks1 ++ [Nothing] ++ map Just ks2 + ] + +chrStoreSingletonElem :: (TTKeyable p) => CHR (Constraint p i) g s -> CHRStore p i g s +chrStoreSingletonElem x = chrStoreFromElems [x] + +chrStoreUnion :: CHRStore p i g s -> CHRStore p i g s -> CHRStore p i g s +chrStoreUnion cs1 cs2 = mkCHRStore $ chrTrieUnionWith cmbStoredCHRs (chrstoreTrie cs1) (chrstoreTrie cs2) + +chrStoreUnions :: [CHRStore p i g s] -> CHRStore p i g s +chrStoreUnions [] = emptyCHRStore +chrStoreUnions [s] = s +chrStoreUnions ss = foldr1 chrStoreUnion ss + +{-# LINE 237 "src/ehc/CHR/Solve.chs" #-} +chrStoreToList :: CHRStore p i g s -> [(CHRKey,[CHR (Constraint p i) g s])] +chrStoreToList cs + = [ (k,chrs) + | (k,e) <- chrTrieToListByKey $ chrstoreTrie cs + , let chrs = [chr | (StoredCHR {storedChr = chr, storedKeyedInx = 0}) <- e] + , not $ Prelude.null chrs + ] + +chrStoreElems :: CHRStore p i g s -> [CHR (Constraint p i) g s] +chrStoreElems = concatMap snd . chrStoreToList + +{-# LINE 250 "src/ehc/CHR/Solve.chs" #-} +ppCHRStore :: (PP p,PP g,PP i) => CHRStore p i g s -> PP_Doc +ppCHRStore = ppCurlysCommasBlock . map (\(k,v) -> ppCHRTrieKey k >-< indent 2 (":" >#< ppBracketsCommasBlock v)) . chrStoreToList + +ppCHRStore' :: (PP p,PP g,PP i) => CHRStore p i g s -> PP_Doc +ppCHRStore' = ppCurlysCommasBlock . map (\(k,v) -> ppCHRTrieKey k >-< indent 2 (":" >#< ppBracketsCommasBlock v)) . chrTrieToListByKey . chrstoreTrie + +{-# LINE 267 "src/ehc/CHR/Solve.chs" #-} +type WorkTime = Int + +initWorkTime :: WorkTime +initWorkTime = 0 + +{-# LINE 278 "src/ehc/CHR/Solve.chs" #-} +type WorkKey = CHRKey +type WorkUsedInMap = Map.Map (Set.Set CHRKey) (Set.Set UsedByKey) +type WorkTrie p i = CHRTrie Key (Work p i) + +-- | A chunk of work to do when solving, a constraint + sequence nr +data Work p i + = Work + { workKey :: WorkKey + , workCnstr :: !(Constraint p i) -- the constraint to be reduced + , workTime :: WorkTime -- the history count at which the work was added + -- , workUsedIn :: Set.Set CHRKey -- marked with the propagation rules already applied to it + } + +-- | The work to be done (wlQueue), also represented as a trie (wlTrie) because efficient check on already worked on is needed. +-- A done set (wlDoneSet) remembers which CHRs (itself a list of constraints) have been solved. +-- To prevent duplicate propagation a mapping from CHRs to a map (wlUsedIn) to the CHRs it is used in is maintained. +data WorkList p i + = WorkList + { wlTrie :: !(WorkTrie p i) + , wlDoneSet :: !(Set.Set WorkKey) -- accumulative store of all keys added, set semantics, thereby avoiding double entry + , wlQueue :: !(AssocL WorkKey (Work p i)) + , wlScanned :: !(AssocL WorkKey (Work p i)) -- tried but could not solve, so retry when other succeeds + , wlUsedIn :: !WorkUsedInMap -- which work items are used in which propagation constraints + } + +emptyWorkList = WorkList emptyCHRTrie Set.empty [] {- Set.empty -} [] Map.empty + +{-# LINE 307 "src/ehc/CHR/Solve.chs" #-} +wlUsedInUnion :: WorkUsedInMap -> WorkUsedInMap -> WorkUsedInMap +wlUsedInUnion = Map.unionWith Set.union + +{-# LINE 312 "src/ehc/CHR/Solve.chs" #-} +instance Show (Work p i) where + show _ = "SolveWork" + +instance (PP p,PP i) => PP (Work p i) where + pp w = pp $ workCnstr w + +ppUsedByKey :: UsedByKey -> PP_Doc +ppUsedByKey (k,i) = ppCHRTrieKey k >|< "/" >|< i + +{-# LINE 323 "src/ehc/CHR/Solve.chs" #-} +mkWorkList :: (TTKeyable p) => WorkTime -> [Constraint p i] -> WorkList p i +mkWorkList wtm = flip (wlInsert wtm) emptyWorkList + +wlToList :: {- (PP p, PP i) => -} WorkList p i -> [Constraint p i] +wlToList wl = map workCnstr $ chrTrieElems $ wlTrie wl + +wlCnstrToIns :: (TTKeyable p) => WorkList p i -> [Constraint p i] -> AssocL WorkKey (Constraint p i) +wlCnstrToIns wl@(WorkList {wlDoneSet = ds}) inscs + = [(chrToWorkKey c,c) | c <- inscs, let k = chrToKey c, not (k `Set.member` ds)] + +wlDeleteByKeyAndInsert' :: WorkTime -> [WorkKey] -> AssocL WorkKey (Constraint p i) -> WorkList p i -> WorkList p i +wlDeleteByKeyAndInsert' wtm delkeys inskeycs wl@(WorkList {wlQueue = wlq, wlTrie = wlt, wlDoneSet = ds}) + = wl { wlQueue = Map.toList inswork ++ [ w | w@(k,_) <- wlq, not (k `elem` delkeys) ] + , wlTrie = instrie `chrTrieUnion` chrTrieDeleteListByKey delkeys wlt + , wlDoneSet = Map.keysSet inswork `Set.union` ds + } + where inswork = Map.fromList [ (k,Work k c wtm) | (k,c) <- inskeycs ] + instrie = chrTrieFromListPartialExactWith const $ Map.toList inswork + +wlDeleteByKeyAndInsert :: (TTKeyable p) => WorkTime -> [WorkKey] -> [Constraint p i] -> WorkList p i -> WorkList p i +wlDeleteByKeyAndInsert wtm delkeys inscs wl + = wlDeleteByKeyAndInsert' wtm delkeys (wlCnstrToIns wl inscs) wl + +wlInsert :: (TTKeyable p) => WorkTime -> [Constraint p i] -> WorkList p i -> WorkList p i +wlInsert wtm = wlDeleteByKeyAndInsert wtm [] + +{-# LINE 355 "src/ehc/CHR/Solve.chs" #-} +data SolveStep p i g s + = SolveStep + { stepChr :: CHR (Constraint p i) g s + , stepSubst :: s + , stepNewTodo :: [Constraint p i] + , stepNewDone :: [Constraint p i] + } + | SolveStats + { stepStats :: Map.Map String PP_Doc + } + | SolveDbg + { stepPP :: PP_Doc + } + +type SolveTrace p i g s = [SolveStep p i g s] + +{-# LINE 373 "src/ehc/CHR/Solve.chs" #-} +instance Show (SolveStep p i g s) where + show _ = "SolveStep" + +instance (PP p, PP i, PP g) => PP (SolveStep p i g s) where + pp (SolveStep step _ todo done) = "STEP" >#< (step >-< "new todo:" >#< ppBracketsCommas todo >-< "new done:" >#< ppBracketsCommas done) + pp (SolveStats stats ) = "STATS" >#< (ppAssocLV (Map.toList stats)) + pp (SolveDbg p ) = "DBG" >#< p + +{-# LINE 383 "src/ehc/CHR/Solve.chs" #-} +ppSolveTrace :: (PP s, PP p, PP i, PP g) => SolveTrace p i g s -> PP_Doc +ppSolveTrace tr = ppBracketsCommasBlock [ pp st | st <- tr ] + +{-# LINE 392 "src/ehc/CHR/Solve.chs" #-} +type SolveCount a b = Map.Map a (Map.Map b Int) + +scntUnion :: (Ord a,Ord b) => SolveCount a b -> SolveCount a b -> SolveCount a b +scntUnion = Map.unionWith (Map.unionWith (+)) + +scntInc :: (Ord a,Ord b) => a -> b -> SolveCount a b -> SolveCount a b +scntInc a b c1 + = Map.singleton a (Map.singleton b 1) `scntUnion` c1 + +{-# LINE 407 "src/ehc/CHR/Solve.chs" #-} +-- type SolveMatchCache p i g s = Map.Map CHRKey [((StoredCHR p i g s,([WorkKey],[Work p i])),s)] +type SolveMatchCache p i g s = Map.Map WorkKey [((StoredCHR p i g s,([WorkKey],[Work p i])),s)] + +{-# LINE 416 "src/ehc/CHR/Solve.chs" #-} +type LastQueryW = Map.Map WorkKey WorkTime +type LastQuery = Map.Map CHRKey LastQueryW + +emptyLastQuery :: LastQuery +emptyLastQuery = Map.empty + +{-# LINE 424 "src/ehc/CHR/Solve.chs" #-} +lqSingleton :: CHRKey -> Set.Set WorkKey -> WorkTime -> LastQuery +lqSingleton ck wks wtm = Map.singleton ck $ Map.fromList [ (w,wtm) | w <- Set.toList wks ] + +lqUnion :: LastQuery -> LastQuery -> LastQuery +lqUnion = Map.unionWith Map.union + +lqLookupC :: CHRKey -> LastQuery -> LastQueryW +lqLookupC = Map.findWithDefault Map.empty + +lqLookupW :: WorkKey -> LastQueryW -> WorkTime +lqLookupW = Map.findWithDefault initWorkTime + +{-# LINE 452 "src/ehc/CHR/Solve.chs" #-} +data SolveState p i g s + = SolveState + { stWorkList :: !(WorkList p i) + , stDoneCnstrSet :: !(Set.Set (Constraint p i)) + , stTrace :: SolveTrace p i g s + , stCountCnstr :: SolveCount WorkKey String + , stMatchCache :: !(SolveMatchCache p i g s) + , stHistoryCount :: WorkTime + , stLastQuery :: LastQuery + } + +stDoneCnstrs :: SolveState p i g s -> [Constraint p i] +stDoneCnstrs = Set.toList . stDoneCnstrSet + +emptySolveState :: SolveState p i g s +emptySolveState = SolveState emptyWorkList Set.empty [] Map.empty Map.empty initWorkTime emptyLastQuery + +{-# LINE 471 "src/ehc/CHR/Solve.chs" #-} +solveStateResetDone :: SolveState p i g s -> SolveState p i g s +solveStateResetDone s = s {stDoneCnstrSet = Set.empty} + +{-# LINE 476 "src/ehc/CHR/Solve.chs" #-} +chrSolveStateDoneConstraints :: SolveState p i g s -> [Constraint p i] +chrSolveStateDoneConstraints = stDoneCnstrs + +chrSolveStateTrace :: SolveState p i g s -> SolveTrace p i g s +chrSolveStateTrace = stTrace + +{-# LINE 488 "src/ehc/CHR/Solve.chs" #-} +chrSolve + :: ( Ord i, Ord p + , CHRMatchable env p s, CHRCheckable env g s + -- , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , VarLookupCmb s s + , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , CHREmptySubstitution s + , Ord (Constraint p i) + ) + => env + -> CHRStore p i g s + -> [Constraint p i] + -> [Constraint p i] +chrSolve env chrStore cnstrs + = work ++ done + where (work,done,_) = chrSolve' env chrStore cnstrs + +chrSolve' + :: ( Ord i, Ord p + , CHRMatchable env p s, CHRCheckable env g s + -- , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , VarLookupCmb s s + , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , CHREmptySubstitution s + , Ord (Constraint p i) + ) + => env + -> CHRStore p i g s + -> [Constraint p i] + -> ([Constraint p i],[Constraint p i],SolveTrace p i g s) +chrSolve' env chrStore cnstrs + = (wlToList (stWorkList finalState), stDoneCnstrs finalState, stTrace finalState) + where finalState = chrSolve'' env chrStore cnstrs emptySolveState + +{-# LINE 532 "src/ehc/CHR/Solve.chs" #-} +chrSolve'' + :: forall env p i g s . + ( Ord i, Ord p + , CHRMatchable env p s, CHRCheckable env g s + -- , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , VarLookupCmb s s + , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , CHREmptySubstitution s + , Ord (Constraint p i) + ) + => env + -> CHRStore p i g s + -> [Constraint p i] + -> SolveState p i g s + -> SolveState p i g s +chrSolve'' env chrStore cnstrs prevState + = postState {stMatchCache = Map.empty} + where postState + = st + where st = iter $ initState prevState + iter st@(SolveState {stWorkList = wl@(WorkList {wlQueue = (workHd@(workHdKey,_) : workTl)})}) + = case matches of + (_:_) + -> expandMatch stmatch matches + where -- expandMatch :: SolveState p i g s -> [((StoredCHR p i g s, ([WorkKey], [Work p i])), s)] -> SolveState p i g s + expandMatch st@(SolveState {stWorkList = wl, stHistoryCount = histCount}) + ( ( ( schr@(StoredCHR {storedIdent = chrId, storedChr = chr@(CHR {chrBody = b, chrSimpSz = simpSz})}) + , (keys,works) + ) + , subst + ) : tlMatch + ) + = expandMatch st' tlMatchY + where (tlMatchY,tlMatchN) = partition (\(r@(_,(ks,_)),_) -> not (any (`elem` keysSimp) ks || slvIsUsedByPropPart (wlUsedIn wl') r)) tlMatch + (keysSimp,keysProp) = splitAt simpSz keys + usedIn = Map.singleton (Set.fromList keysProp) (Set.singleton chrId) + (bTodo,bDone) = splitDone $ map (varUpd subst) b + bTodo' = wlCnstrToIns wl bTodo + wl' = wlDeleteByKeyAndInsert' histCount keysSimp bTodo' + $ wl { wlUsedIn = usedIn `wlUsedInUnion` wlUsedIn wl + , wlScanned = [] + , wlQueue = wlQueue wl ++ wlScanned wl + } + st' = st { stWorkList = wl' + , stDoneCnstrSet = Set.unions [Set.fromList bDone, Set.fromList $ map workCnstr $ take simpSz works, stDoneCnstrSet st] + , stMatchCache = if List.null bTodo' then stMatchCache st else Map.empty + , stHistoryCount = histCount + 1 + } + expandMatch st _ + = iter st + + _ -> iter st' + where wl' = wl { wlScanned = workHd : wlScanned wl, wlQueue = workTl } + st' = stmatch { stWorkList = wl', stTrace = SolveDbg (ppdbg) : {- -} stTrace stmatch } + where (matches,lastQuery,ppdbg,stats) = workMatches st + stmatch = + (st { stCountCnstr = scntInc workHdKey "workMatched" $ stCountCnstr st + , stMatchCache = Map.insert workHdKey [] (stMatchCache st) + , stLastQuery = lastQuery + }) + iter st + = st + mkStats stats new = stats `Map.union` Map.fromList (assocLMapKey showPP new) + addStats _ _ st = st + workMatches st@(SolveState {stWorkList = WorkList {wlQueue = (workHd@(workHdKey,Work {workTime = workHdTm}) : _), wlTrie = wlTrie, wlUsedIn = wlUsedIn}, stHistoryCount = histCount, stLastQuery = lastQuery}) + | isJust mbInCache = ( fromJust mbInCache + , lastQuery + , Pretty.empty, mkStats Map.empty [("cache sz",pp (Map.size (stMatchCache st)))] + ) + | otherwise = ( r5 + , foldr lqUnion lastQuery [ lqSingleton ck wks histCount | (_,(_,(ck,wks))) <- r23 ] + , Pretty.empty + , Map.empty + ) + where -- cache result, if present use that, otherwise the below computation + mbInCache = Map.lookup workHdKey (stMatchCache st) + + -- results, stepwise computed for later reference in debugging output + -- basic search result + r2 :: [StoredCHR p i g s] -- CHRs matching workHdKey + r2 = concat -- flatten + $ TreeTrie.lookupResultToList -- convert to list + $ chrTrieLookup chrLookupHowWildAtTrie workHdKey -- lookup the store, allowing too many results + $ chrstoreTrie chrStore + + -- lookup further info in wlTrie, in particular to find out what has been done already + r23 :: [( StoredCHR p i g s -- the CHR + , ( [( [(CHRKey, Work p i)] -- for each CHR the list of constraints, all possible work matches + , [(CHRKey, Work p i)] + )] + , (CHRKey, Set.Set CHRKey) + ) )] + r23 = map (\c -> (c, slvCandidate workHdKey lastQuery wlTrie c)) r2 + + -- possible matches + r3, r4 + :: [( StoredCHR p i g s -- the matched CHR + , ( [CHRKey] -- possible matching constraints (matching with the CHR constraints), as Keys, as Works + , [Work p i] + ) )] + r3 = concatMap (\(c,cands) -> zip (repeat c) (map unzip $ slvCombine cands)) $ r23 + + -- same, but now restricted to not used earlier as indicated by the worklist + r4 = filter (not . slvIsUsedByPropPart wlUsedIn) r3 + + -- finally, the 'real' match of the 'real' constraint, yielding (by tupling) substitutions instantiating the found trie matches + r5 :: [( ( StoredCHR p i g s + , ( [CHRKey] + , [Work p i] + ) ) + , s + )] + r5 = mapMaybe (\r@(chr,kw@(_,works)) -> fmap (\s -> (r,s)) $ slvMatch env chr (map workCnstr works)) r4 + initState st = st { stWorkList = wlInsert (stHistoryCount st) wlnew $ stWorkList st, stDoneCnstrSet = Set.unions [Set.fromList done, stDoneCnstrSet st] } + where (wlnew,done) = splitDone cnstrs + splitDone = partition cnstrRequiresSolve + +{-# LINE 726 "src/ehc/CHR/Solve.chs" #-} +-- | Extract candidates matching a CHRKey. +-- Return a list of CHR matches, +-- each match expressed as the list of constraints (in the form of Work + Key) found in the workList wlTrie, thus giving all combis with constraints as part of a CHR, +-- partititioned on before or after last query time (to avoid work duplication later) +slvCandidate + :: CHRKey + -> LastQuery + -> WorkTrie p i + -> StoredCHR p i g s + -> ( [( [(CHRKey, Work p i)] + , [(CHRKey, Work p i)] + )] + , (CHRKey, Set.Set CHRKey) + ) +slvCandidate workHdKey lastQuery wlTrie (StoredCHR {storedIdent = (ck,_), storedKeys = ks, storedChr = chr}) + = ( map (maybe (lkup chrLookupHowExact workHdKey) (lkup chrLookupHowWildAtKey)) ks + , ( ck + , Set.fromList $ map (maybe workHdKey id) ks + ) ) + where lkup how k = partition (\(_,w) -> workTime w < lastQueryTm) $ map (\w -> (workKey w,w)) $ TreeTrie.lookupResultToList $ chrTrieLookup how k wlTrie + where lastQueryTm = lqLookupW k $ lqLookupC ck lastQuery + +{-# LINE 757 "src/ehc/CHR/Solve.chs" #-} +slvCombine :: Eq k => ([([Assoc k v], [Assoc k v])], t) -> [AssocL k v] +slvCombine ([],_) = [] +slvCombine ((lh:lt),_) + = concatMap combineToDistinguishedElts l2 + where l2 = g2 [] lh lt + where g2 ll l [] = [mk ll l []] + g2 ll l lr@(lrh:lrt) = mk ll l lr : g2 (ll ++ [l]) lrh lrt + mk ll (bef,aft) lr = map fst ll ++ [aft] ++ map cmb lr + where cmb (a,b) = a++b + +{-# LINE 769 "src/ehc/CHR/Solve.chs" #-} +-- | Check whether the CHR propagation part of a match already has been used (i.e. propagated) earlier, +-- this to avoid duplicate propagation. +slvIsUsedByPropPart + :: Ord k + => Map.Map (Set.Set k) (Set.Set UsedByKey) + -> (StoredCHR p i g s, ([k], t)) + -> Bool +slvIsUsedByPropPart wlUsedIn (chr,(keys,_)) + = fnd $ drop (storedSimpSz chr) keys + where fnd k = maybe False (storedIdent chr `Set.member`) $ Map.lookup (Set.fromList k) wlUsedIn + +{-# LINE 782 "src/ehc/CHR/Solve.chs" #-} +-- | Match the stored CHR with a set of possible constraints, giving a substitution on success +slvMatch + :: ( CHREmptySubstitution s + , CHRMatchable env p s + , CHRCheckable env g s + , VarLookupCmb s s + ) + => env -> StoredCHR p i g s -> [Constraint p i] -> Maybe s +slvMatch env chr cnstrs + = foldl cmb (Just chrEmptySubst) $ matches chr cnstrs ++ checks chr + where matches (StoredCHR {storedChr = CHR {chrHead = hc}}) cnstrs + = zipWith mt hc cnstrs + where mt cFr cTo subst = chrMatchTo env subst cFr cTo + checks (StoredCHR {storedChr = CHR {chrGuard = gd}}) + = map chk gd + where chk g subst = chrCheck env subst g + cmb (Just s) next = fmap (|+> s) $ next s + cmb _ _ = Nothing + +{-# LINE 807 "src/ehc/CHR/Solve.chs" #-} +instance (Serialize p, Serialize i, Serialize g, Serialize s) => Serialize (CHRStore p i g s) where + sput (CHRStore a) = sput a + sget = liftM CHRStore sget + +instance (Serialize p, Serialize i, Serialize g, Serialize s) => Serialize (StoredCHR p i g s) where + sput (StoredCHR a b c d) = sput a >> sput b >> sput c >> sput d + sget = liftM4 StoredCHR sget sget sget sget + diff --git a/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs b/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs @@ -0,0 +1,139 @@ +module UHC.Light.Compiler.CodeGen.BasicAnnot +( BasicSize (..) +, basicSizeOf +, basicSizeIsSigned +, BasicTy (..) +, BasicAnnot (..) +, basicSizeDouble, basicSizeFloat ) +where +import qualified Data.Map as Map +import Data.Bits +import Data.List +import UHC.Util.Pretty +import UHC.Util.Utils +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.CodeGen.Bits +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 25 "src/ehc/CodeGen/BasicAnnot.chs" #-} +data BasicSize + = -- Word variants, bitsize explicit + BasicSize_Word8 + | BasicSize_Word16 + | BasicSize_Word32 + | BasicSize_Word64 + -- Int variants, bitsize explicit + | BasicSize_Int8 + | BasicSize_Int16 + | BasicSize_Int32 + | BasicSize_Int64 + -- Float variants, bitsize explicit + | BasicSize_Float + | BasicSize_Double + deriving (Eq,Ord,Enum) + +{-# LINE 45 "src/ehc/CodeGen/BasicAnnot.chs" #-} +deriving instance Typeable BasicSize +deriving instance Data BasicSize + +{-# LINE 53 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance Show BasicSize where + show BasicSize_Word8 = "w1" + show BasicSize_Word16 = "w2" + show BasicSize_Word32 = "w4" + show BasicSize_Word64 = "w8" + show BasicSize_Int8 = "i1" + show BasicSize_Int16 = "i2" + show BasicSize_Int32 = "i4" + show BasicSize_Int64 = "i8" + show BasicSize_Float = "f4" + show BasicSize_Double = "f8" + +{-# LINE 69 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance PP BasicSize where + pp = pp . show + +{-# LINE 75 "src/ehc/CodeGen/BasicAnnot.chs" #-} +basicSizeOfMp :: Map.Map Int BasicSize +basicSizeOfMp + = Map.fromList + [ (1, BasicSize_Word8 ) + , (2, BasicSize_Word16) + , (4, BasicSize_Word32) + , (8, BasicSize_Word64) + ] + +basicSizeOf :: Int -> BasicSize +basicSizeOf i = panicJust "BasicAnnot.basicSizeOf" $ Map.lookup i basicSizeOfMp + +{-# LINE 111 "src/ehc/CodeGen/BasicAnnot.chs" #-} +basicSizeIsSigned :: BasicSize -> Bool +basicSizeIsSigned BasicSize_Int8 = True +basicSizeIsSigned BasicSize_Int16 = True +basicSizeIsSigned BasicSize_Int32 = True +basicSizeIsSigned BasicSize_Int64 = True +basicSizeIsSigned _ = False + +{-# LINE 120 "src/ehc/CodeGen/BasicAnnot.chs" #-} +basicSizeDouble, basicSizeFloat :: BasicSize +basicSizeFloat = BasicSize_Float +basicSizeDouble = BasicSize_Double + +{-# LINE 291 "src/ehc/CodeGen/BasicAnnot.chs" #-} +-- the defs in basicTyGBTy must be at the beginning, as Enum uses the relative ordering +data BasicTy + = BasicTy_Word -- base case: pointer, word, int, ... + | BasicTy_SWord -- base case: signed word + | BasicTy_SHWord -- base case: signed half word + | BasicTy_Float -- C: float + | BasicTy_Double -- C: double + | BasicTy_SignedHalfWord -- as BasicTy_Word, but for FFI half the size of a word, and signed. Special case for sign extend. + deriving (Eq,Ord,Enum) + +{-# LINE 305 "src/ehc/CodeGen/BasicAnnot.chs" #-} +deriving instance Typeable BasicTy +deriving instance Data BasicTy + +{-# LINE 313 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance Show BasicTy where + show BasicTy_Word = "word" + show BasicTy_SWord = "sword" + show BasicTy_SHWord = "shword" + show BasicTy_Float = "float" + show BasicTy_Double = "double" + show BasicTy_SignedHalfWord = "int" + +{-# LINE 325 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance PP BasicTy where + pp = pp . show + +{-# LINE 352 "src/ehc/CodeGen/BasicAnnot.chs" #-} +data BasicAnnot + = BasicAnnot_None + deriving (Show,Eq) + +{-# LINE 411 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance PP BasicAnnot where + pp _ = pp "ANNOT" + +{-# LINE 424 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance Serialize BasicTy where + sput = sputEnum8 + sget = sgetEnum8 + +instance Serialize BasicSize where + sput = sputEnum8 + sget = sgetEnum8 + +{-# LINE 434 "src/ehc/CodeGen/BasicAnnot.chs" #-} +instance Serialize BasicAnnot where + sput (BasicAnnot_None ) = sputWord8 0 + sget = do + t <- sgetWord8 + case t of + 0 -> return BasicAnnot_None + diff --git a/src/UHC/Light/Compiler/CodeGen/Bits.hs b/src/UHC/Light/Compiler/CodeGen/Bits.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/Bits.hs @@ -0,0 +1,178 @@ +module UHC.Light.Compiler.CodeGen.Bits +( Seq.empty +, entierLogUpShrBy, entierLogUpBy +, entierUpShrBy, entierUpBy +, pow2 +, pow2_7, pow2_7neg, pow2_7sub1, pow2_8, pow2_8neg, pow2_8sub1 +, pow2_15, pow2_15neg, pow2_15sub1, pow2_16, pow2_16neg, pow2_16sub1 +, pow2_31, pow2_31neg, pow2_31sub1, pow2_32, pow2_32neg, pow2_32sub1 +, pow2_63, pow2_63neg, pow2_63sub1, pow2_64, pow2_64neg, pow2_64sub1 +, mask2_8, mask2_16, mask2_32, mask2_64 +, posFits8 +, ensurePositive +, signedFitsInBits +, ChooseBitSize, chooseOnBitsize +, Byte, Bytes +, bytesSize +, Byteable (..) +, (##), bytesUnions +, u1, u2, u4, u8 +, bytesToString +, stringToBytes ) +where +import Data.Word +import Data.Int +import Data.Bits +import Data.Char +import qualified UHC.Util.FastSeq as Seq + +{-# LINE 18 "src/ehc/CodeGen/Bits.chs" #-} +entierLogUpShrBy :: (Num x, Bits x) => Int -> x -> x +entierLogUpShrBy by x = ((x - 1) `shiftR` by) + 1 + +entierLogUpBy :: (Num x, Bits x) => Int -> x -> x +entierLogUpBy by x = entierLogUpShrBy by x `shiftL` by + +{-# LINE 26 "src/ehc/CodeGen/Bits.chs" #-} +entierUpShrBy :: Integral x => x -> x -> x +entierUpShrBy by x = ((x - 1) `div` by) + 1 + +entierUpBy :: Integral x => x -> x -> x +entierUpBy by x = entierUpShrBy by x * by + +{-# LINE 42 "src/ehc/CodeGen/Bits.chs" #-} +pow2 :: (Num x, Bits x) => Int -> x +pow2 x = 1 `shiftL` x + +pow2' :: Int -> (Integer,Integer,Integer) +pow2' x + = (p,-p,p-1) + where p = pow2 x + +{-# LINE 52 "src/ehc/CodeGen/Bits.chs" #-} +(pow2_7 ,pow2_7neg ,pow2_7sub1 ) = pow2' 7 +(pow2_8 ,pow2_8neg ,pow2_8sub1 ) = pow2' 8 + +{-# LINE 57 "src/ehc/CodeGen/Bits.chs" #-} +(pow2_15,pow2_15neg,pow2_15sub1) = pow2' 15 +(pow2_16,pow2_16neg,pow2_16sub1) = pow2' 16 + +{-# LINE 62 "src/ehc/CodeGen/Bits.chs" #-} +(pow2_31,pow2_31neg,pow2_31sub1) = pow2' 31 +(pow2_32,pow2_32neg,pow2_32sub1) = pow2' 32 + +{-# LINE 67 "src/ehc/CodeGen/Bits.chs" #-} +(pow2_63,pow2_63neg,pow2_63sub1) = pow2' 63 +(pow2_64,pow2_64neg,pow2_64sub1) = pow2' 64 + +{-# LINE 72 "src/ehc/CodeGen/Bits.chs" #-} +mask2 :: (Num x, Bits x) => Int -> x +mask2 x = pow2 x - 1 + +{-# LINE 77 "src/ehc/CodeGen/Bits.chs" #-} +shift2 :: [Int] +shift2 = [8,16,32,64] + +{-# LINE 82 "src/ehc/CodeGen/Bits.chs" #-} +[mask2_8,mask2_16,mask2_32,mask2_64] = map mask2 shift2 + +{-# LINE 86 "src/ehc/CodeGen/Bits.chs" #-} +posFits8 :: Integral c => c -> Bool +posFits8 x = toInteger x < pow2_8 + +{-# LINE 95 "src/ehc/CodeGen/Bits.chs" #-} +ensurePositive :: Int -> Integer -> Integer +ensurePositive nrBits x | x < 0 = x + pow2 nrBits + | otherwise = x + +{-# LINE 105 "src/ehc/CodeGen/Bits.chs" #-} +signedFitsInBits :: Int -> Integer -> Bool +signedFitsInBits nrBits x = x >= neg && x < sub1 + where (_,neg,sub1) = pow2' (nrBits-1) + +{-# LINE 115 "src/ehc/CodeGen/Bits.chs" #-} +type ChooseBitSize r = Integer -> r + +chooseOnBitsize + :: Integral c + => ( ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + , ChooseBitSize r + ) -> c -> r +chooseOnBitsize (neg8,neg16,neg32,neg64,pos8,pos16,pos32,pos64) c + = case toInteger c of + i | i < 0 -> s (i .&. m) + where (s,m) = case i of + i | i >= pow2_7neg -> (neg8 ,mask2_8 ) + | i >= pow2_15neg -> (neg16,mask2_16) + | i >= pow2_31neg -> (neg32,mask2_32) + | otherwise -> (neg64,mask2_64) + i | i >= 0 -> s (i .&. mask2_64) + where s = case i of + i | i < pow2_7sub1 -> pos8 + | i < pow2_15sub1 -> pos16 + | i < pow2_31sub1 -> pos32 + | otherwise -> pos64 + +{-# LINE 149 "src/ehc/CodeGen/Bits.chs" #-} +type Byte = Char +type Bytes = Seq.Seq Byte + +{-# LINE 158 "src/ehc/CodeGen/Bits.chs" #-} +bytesSize :: Bytes -> Int +bytesSize = Seq.size + +{-# LINE 167 "src/ehc/CodeGen/Bits.chs" #-} +class Byteable x where + bytes :: x -> Bytes + +instance Byteable Byte where + bytes = Seq.singleton + +instance Byteable Bytes where + bytes = id + +instance Byteable x => Byteable [x] where + bytes = bytesUnions . map bytes + +{-# LINE 185 "src/ehc/CodeGen/Bits.chs" #-} +infixr 3 ## + +(##) :: (Byteable x, Byteable y) => x -> y -> Bytes +x ## y = bytes x `Seq.union` bytes y + +bytesUnions :: [Bytes] -> Bytes +bytesUnions = Seq.unions + +{-# LINE 199 "src/ehc/CodeGen/Bits.chs" #-} +-- ux 0 x = Seq.singleton $ chr $ fromIntegral x .&. mask2_8 + +{-# LINE 203 "src/ehc/CodeGen/Bits.chs" #-} +u1 :: Integral x => x -> Bytes +u1 x = Seq.singleton $ chr $ fromIntegral x .&. 0xFF + +u2 :: (Integral x, Bits x) => x -> Bytes +u2 x = u1 x1 ## u1 x2 + where (x1,x2) = (x .&. 0xFFFF) `divMod` 0x100 + +u4 :: (Integral x, Bits x) => x -> Bytes +u4 x = u2 x1 ## u2 x2 + where (x1,x2) = (x .&. 0xFFFFFFFF) `divMod` 0x10000 + +u8 :: (Integral x, Bits x) => x -> Bytes +u8 x = u4 x1 ## u4 x2 + where (x1,x2) = x `divMod` 0x100000000 + +{-# LINE 224 "src/ehc/CodeGen/Bits.chs" #-} +bytesToString :: Bytes -> String +bytesToString = Seq.toList + +{-# LINE 229 "src/ehc/CodeGen/Bits.chs" #-} +stringToBytes :: String -> Bytes +stringToBytes = Seq.unions . map (u1 . ord) + diff --git a/src/UHC/Light/Compiler/CodeGen/BuiltinPrims.hs b/src/UHC/Light/Compiler/CodeGen/BuiltinPrims.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/BuiltinPrims.hs @@ -0,0 +1,39 @@ +module UHC.Light.Compiler.CodeGen.BuiltinPrims +( PrimitiveNeedsEval (..), lookupPrimNeedsEval ) +where +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.CodeGen.BasicAnnot +import UHC.Light.Compiler.Base.HsName.Builtin +import qualified Data.Map as Map +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Pretty +import UHC.Util.Utils + + +{-# LINE 28 "src/ehc/CodeGen/BuiltinPrims.chs" #-} +data PrimitiveNeedsEval + = Prim + { primArgNeedEval :: ![Bool] -- default: True + , primResNeedEval :: ! Bool -- default: False + } + +lookupPrimNeedsEval :: {- Backend -> -} String -> Maybe PrimitiveNeedsEval +lookupPrimNeedsEval {- backend -} name = Map.lookup name primsNeedsEval {- >>= Map.lookup backend -} + +{-# LINE 43 "src/ehc/CodeGen/BuiltinPrims.chs" #-} +primsNeedsEval :: Map.Map String ({- Map.Map Backend -} PrimitiveNeedsEval) +primsNeedsEval + = Map.fromList + [ + ( "primCatchException" , Prim [False,False] False ) + , ( "primThrowException" , Prim [False] False ) + , ( "primNewArray" , Prim [True,False] False ) + , ( "primIndexArray" , Prim [True,True] True ) + , ( "primWriteArray" , Prim [True,True,False] False ) + -- , ( "primReadMutVar" , Prim [True,True] True ) + , ( "primNewMutVar" , Prim [False,True] False ) + , ( "primWriteMutVar" , Prim [True,False,True] False ) + ] + diff --git a/src/UHC/Light/Compiler/CodeGen/BuiltinSizeInfo.hs b/src/UHC/Light/Compiler/CodeGen/BuiltinSizeInfo.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/BuiltinSizeInfo.hs @@ -0,0 +1,41 @@ +module UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +( BuiltinInfo (..) +, BuiltinInfoMp +, builtinRecNm +, builtinKnownRecTyNmL ) +where +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.CodeGen.BasicAnnot +import qualified Data.Map as Map + +{-# LINE 37 "src/ehc/CodeGen/BuiltinSizeInfo.chs" #-} +data BuiltinInfo + = BuiltinInfo + { biIsSigned :: Bool + } + +emptyBuiltinInfo :: BuiltinInfo +emptyBuiltinInfo + = BuiltinInfo + { biIsSigned = False + } + +{-# LINE 65 "src/ehc/CodeGen/BuiltinSizeInfo.chs" #-} +type BuiltinInfoMp = Map.Map HsName BuiltinInfo + +{-# LINE 346 "src/ehc/CodeGen/BuiltinSizeInfo.chs" #-} +builtinRecNm :: Int -> HsName +builtinRecNm = hsnProd + +{-# LINE 351 "src/ehc/CodeGen/BuiltinSizeInfo.chs" #-} +builtinKnownRecTyNmL :: [HsName] +builtinKnownRecTyNmL + = map builtinRecNm (0:[2..10]) + +{-# LINE 361 "src/ehc/CodeGen/BuiltinSizeInfo.chs" #-} +builtinNm :: EHCOpts -> (EHBuiltinNames -> HsName) -> HsName +builtinNm = ehcOptBuiltin + diff --git a/src/UHC/Light/Compiler/CodeGen/CVar.hs b/src/UHC/Light/Compiler/CodeGen/CVar.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/CVar.hs @@ -0,0 +1,275 @@ +module UHC.Light.Compiler.CodeGen.CVar +( CVarInfo' (..) +, cvarShowKind +, CVarMp' (..), cvarMpLookup +, cvarLoc, cvarArg +, cvarIsLocOrArg, cvarIsGlobExt +, cvarGlob +, CVarNmModuleCfg (..), emptyCVarNmModuleCfg +, cvarToDef, cvarToRef +, cvarToDefHsName +, hsnJavaLikeVar ) +where +import qualified Data.Map as Map +import Data.Bits +import Data.List +import Data.Char +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +import UHC.Util.Pretty +import UHC.Util.Utils +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.CodeGen.BasicAnnot +import UHC.Light.Compiler.Foreign.Extract + +{-# LINE 32 "src/ehc/CodeGen/CVar.chs" #-} +data CVarInfo' tag ty varref datafldref tupfldref + = CVar_This -- this object + { cvarType :: ty + } + | CVar_Local -- a local (on the stack) + { cvarType :: ty + , cvarOffset :: !varref + } + | CVar_Arg -- an argument (on the stack), usually the same as Local + { cvarType :: ty + , cvarOffset :: !varref + } + | CVar_DataFld -- a field of a datatype alternative + { cvarType :: ty + , cvarData :: !(CVarInfo' tag ty varref datafldref tupfldref) + , cvarTag :: !tag + , cvarFld :: !datafldref + } + | CVar_DataTag -- the tag of a datatype alternative + { cvarType :: ty + , cvarData :: !(CVarInfo' tag ty varref datafldref tupfldref) + } + | CVar_TupFld -- a field of a tuple + { cvarType :: ty + , cvarTuple :: !(CVarInfo' tag ty varref datafldref tupfldref) + , cvarInx :: !(Either tupfldref HsName) + } + | CVar_GlobalExtern -- a global, external + { cvarType :: ty + , cvarModNm :: !HsName + , cvarFldNm :: !HsName + } + | CVar_GlobalIntern -- a global, internal to current module + { cvarType :: ty + , cvarMbModNm :: !(Maybe HsName) + , cvarFldNm :: !HsName + } + | CVar_None + | CVar_Error + { cvarNm :: HsName + } + deriving (Eq,Ord) + +{-# LINE 77 "src/ehc/CodeGen/CVar.chs" #-} +cvarShowKind :: CVarInfo' tag ty varref datafldref tupfldref -> String +cvarShowKind cvi = case cvi of + CVar_This {} -> "Th" + CVar_Local {} -> "Lc" + CVar_Arg {} -> "Ar" + CVar_DataFld {} -> "DtFl" + CVar_DataTag {} -> "DtTg" + CVar_TupFld {} -> "TpFl" + CVar_GlobalExtern {} -> "GlEx" + CVar_GlobalIntern {} -> "GlIn" + CVar_None -> "No" + CVar_Error {} -> "Er" + +{-# LINE 92 "src/ehc/CodeGen/CVar.chs" #-} +type CVarMp' tag ty varref datafldref tupfldref = Map.Map HsName (CVarInfo' tag ty varref datafldref tupfldref) + +cvarMpLookup :: HsName -> CVarMp' tag ty varref datafldref tupfldref -> Maybe (CVarInfo' tag ty varref datafldref tupfldref) +cvarMpLookup = Map.lookup +{-# INLINE cvarMpLookup #-} + +{-# LINE 100 "src/ehc/CodeGen/CVar.chs" #-} +instance (Show datafldref, Show tupfldref, Show varref) => Show (CVarInfo' tag ty varref datafldref tupfldref) where + show (CVar_This { }) = "this" + show (CVar_Local { cvarOffset=n }) = show n + show (CVar_Arg { cvarOffset=n }) = show n + show (CVar_DataFld {cvarData=d , cvarFld=n }) = show d ++ "." ++ show n + show (CVar_DataTag {cvarData=d }) = show d ++ ".tag" + show (CVar_TupFld {cvarTuple=d , cvarInx=n }) = show d ++ "." ++ either show show n + show (CVar_GlobalExtern {cvarModNm=m , cvarFldNm=n }) = show m ++ "." ++ show n + show (CVar_GlobalIntern {cvarMbModNm=mbm , cvarFldNm=n }) = maybe "" (\m -> show m ++ ".") mbm ++ show n + show (CVar_Error { cvarNm=n }) = "#ERRREF#" ++ show n + show _ = "?CVar?" + +instance (Show datafldref, Show tupfldref, Show varref) => PP (CVarInfo' tag ty varref datafldref tupfldref) where + pp = pp . show + +{-# LINE 117 "src/ehc/CodeGen/CVar.chs" #-} +-- | basic construction: local reference +cvarLoc :: ty -> varref -> CVarInfo' tag ty varref datafldref tupfldref +cvarLoc = CVar_Local + +-- | basic construction: argument reference +cvarArg :: ty -> varref -> CVarInfo' tag ty varref datafldref tupfldref +cvarArg = CVar_Arg + +{-# LINE 127 "src/ehc/CodeGen/CVar.chs" #-} +-- | Is a CVar_Local or Arg? +cvarIsLocOrArg (CVar_Local {}) = True +cvarIsLocOrArg (CVar_Arg {}) = True +cvarIsLocOrArg _ = False + +-- | Is a CVar_GlobalExtern? +cvarIsGlobExt (CVar_GlobalExtern {}) = True +cvarIsGlobExt _ = False + +{-# LINE 138 "src/ehc/CodeGen/CVar.chs" #-} +-- | global reference +cvarGlob :: CVarNmModuleCfg -> ty -> HsName -> HsName -> CVarInfo' tag ty varref datafldref tupfldref +cvarGlob cfg ty mbModNm varNm + = CVar_GlobalExtern ty clNm' varNm + where clNm' = maybe (cvnmcfgModInTop cfg) (\m -> hsnSetQual m $ hsnQualified m) $ hsnQualifier mbModNm + +{-# LINE 150 "src/ehc/CodeGen/CVar.chs" #-} +-- | Per module name configuration used by name generation to take into account differences between local, global, etc +data CVarNmModuleCfg = CVarNmModuleCfg + { cvnmcfgPkg :: HsName + , cvnmcfgTopInPkg :: HsName + , cvnmcfgModInTop :: HsName + } + +emptyCVarNmModuleCfg = CVarNmModuleCfg hsnUnknown hsnUnknown hsnUnknown + +{-# LINE 161 "src/ehc/CodeGen/CVar.chs" #-} +-- | Generate ref, used to convert when used for referring to names +cvarToRef + :: ( HsName -> e -- erroneous reference, + , ty -> e -- make for 'this', + , ty -> varref -> e -- local, + , ty -> varref -> e -- arg, + , ty -> HsName -> HsName -> e -- global external, additionally getting a safe name variant + , ty -> Maybe HsName -> HsName -> e -- global internal, additionally getting a safe name variant + , ty -> e -> taginfo -> datafldref -> e -- data field, + , ty -> e -> e -- data constr tag, + , e -> e -> e -- tuple field + , tupfldref -> e -- offset + , CVarNmModuleCfg -> tag -> taginfo + , CVarNmModuleCfg -> Bool -> HsName -> HsName + ) + -> CVarNmModuleCfg + -> CVarMp' tag ty varref datafldref tupfldref + -> CVarInfo' tag ty varref datafldref tupfldref + -> e + +-- | Generate def, used to convert when used for introducing names +cvarToDef + :: ( HsName -> e -- erroneous reference, + , ty -> varref -> e -- local, + , ty -> varref -> e -- arg, + , ty -> HsName -> HsName -> e -- global external, additionally getting a safe name variant + , ty -> Maybe HsName -> HsName -> e -- global internal, additionally getting a safe name variant + , ty -> e -> taginfo -> datafldref -> e -- data field, + , ty -> e -> e -- data constr tag, + , e -> e -> e -- tuple field + , tupfldref -> e -- offset + , CVarNmModuleCfg -> tag -> taginfo + , CVarNmModuleCfg -> Bool -> HsName -> HsName + ) + -> CVarNmModuleCfg + -> CVarMp' tag ty varref datafldref tupfldref + -> CVarInfo' tag ty varref datafldref tupfldref + -> e + +(cvarToDef, cvarToRef) + = ( \(mkErrorRef,mkLocal,mkArg,mkGlobalExt,mkGlobalInt,mkDataFld,mkDataTag,mkTupFld,mkOffset,mkTag,mkSafeName) + cfg cvarMp vi -> let ref vi + = case vi of + CVar_This t -> panic "CVar.cvarToDef.CVar_This" + CVar_Local t o -> mkLocal t o + CVar_Arg t o -> mkArg t o + CVar_GlobalExtern t m f -> mkGlEx mkGlobalExt cfg mkSafeName t m f + CVar_GlobalIntern t m f -> mkGlIn mkGlobalInt cfg mkSafeName t m f + CVar_DataFld t cvid cl f -> mkDtFl ref cfg mkDataFld mkTag t cvid cl f + CVar_DataTag t cvid -> mkDtTg ref mkDataTag t cvid + CVar_TupFld t cvit f -> mkTpFl ref cvarMp mkTupFld mkOffset t cvit f + CVar_None -> panic "CVar.cvarToDef.CVar_None" + CVar_Error n -> mkErrorRef n + in ref vi + , \(mkErrorRef,mkThis,mkLocal,mkArg,mkGlobalExt,mkGlobalInt,mkDataFld,mkDataTag,mkTupFld,mkOffset,mkTag,mkSafeName) + cfg cvarMp vi -> let ref vi + = case vi of + CVar_This t -> mkThis t + CVar_Local t o -> mkLocal t o + CVar_Arg t o -> mkArg t o + CVar_GlobalExtern t m f -> mkGlEx mkGlobalExt cfg mkSafeName t m f + CVar_GlobalIntern t m f -> mkGlIn mkGlobalInt cfg mkSafeName t m f + CVar_DataFld t cvid cl f -> mkDtFl ref cfg mkDataFld mkTag t cvid cl f + CVar_DataTag t cvid -> mkDtTg ref mkDataTag t cvid + CVar_TupFld t cvit f -> mkTpFl ref cvarMp mkTupFld mkOffset t cvit f + CVar_None -> panic "CVar.cvarToRef.CVar_None" + CVar_Error n -> mkErrorRef n + in ref vi + ) + where mkGlIn mkGlobal cfg mkSafeName t m f = mkGlobal t m (mkSafeName cfg True f) + mkGlEx = mkGlIn + mkDtFl ref cfg mkDataFld mkTag t cvid cl f = mkDataFld t (ref cvid) (mkTag cfg cl) f + mkDtTg ref mkDataTag t cvid = mkDataTag t (ref cvid) + mkTpFl ref cvarMp mkTupFld mkOffset t cvit f = mkTupFld (ref cvit) o + where o = case f of + Left o -> mkOffset o + Right n -> ref $ panicJust "CVar.cvarTo{RD}ef.CVar_TupFld" $ cvarMpLookup n cvarMp + +{-# LINE 241 "src/ehc/CodeGen/CVar.chs" #-} +cvarToDefHsName + :: ( String -> HsName + , varref -> HsName + , datafldref -> HsName + , tupfldref -> HsName + , CVarNmModuleCfg -> tag -> taginfo + , CVarNmModuleCfg -> Bool -> HsName -> HsName + ) + -> CVarNmModuleCfg + -> CVarMp' tag ty varref datafldref tupfldref + -> CVarInfo' tag ty varref datafldref tupfldref + -> HsName +cvarToDefHsName + (mkError,mkLocal,mkDataFld,mkTupFld,mkTag,mkSafeName) + = cvarToDef + ( \r -> mkError $ "cvarToDefHsName.mkErrorRef: " ++ show r + , mkLocArg + , mkLocArg + , \_ _ r -> r + , \_ _ r -> r + , \_ _ _ r -> mkDataFld r + , \_ _ -> mkError "cannot cvarToDefHsName.mkDataTag" + , \_ _ -> mkError "cannot cvarToDefHsName.mkTupFld" + , mkTupFld + , mkTag + , mkSafeName + ) + where mkLocArg = \_ r -> mkLocal r + +{-# LINE 291 "src/ehc/CodeGen/CVar.chs" #-} +-- safe name of a variable +hsnJavaLikeVar + :: ( Bool -> HsName -> HsName -- adapt for particular platform, before mangling here + , HsName -> HsName -- post prefix + , String -> String -- adapt module qualifiers + ) + -> CVarNmModuleCfg + -> Bool -- is a global name? + -> HsName + -> HsName +hsnJavaLikeVar (preadapt, postprefix, updqual) cfg isglob v + = postprefix $ hsnSafeJavaLike $ handleUpper $ qual $ preadapt isglob v + where handleUpper v + = case hsnBaseUnpack v of + Just (s@(c:vs), mk) | isUpper c -> mk (s ++ "_") + _ -> v + qual v + = case hsnBaseUnpack' v of + Just (q, s, mk) -> mk (map updqual q) s + _ -> v + diff --git a/src/UHC/Light/Compiler/CodeGen/Const.hs b/src/UHC/Light/Compiler/CodeGen/Const.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/Const.hs @@ -0,0 +1,126 @@ +module UHC.Light.Compiler.CodeGen.Const +( module UHC.Light.Compiler.CodeGen.BasicAnnot +, CFld, ConstRef (..) +, cfldGlobInx +, Const (..) +, isFFIConst +, ConstSt (..), emptyConstSt +, add +, addStr, addNm, addFFIFun, addFFICallEncWrapper ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.RefGenerator +import UHC.Util.Utils +import UHC.Util.Pretty as Pretty +import Data.Bits +import Data.Maybe +import qualified UHC.Util.FastSeq as Seq +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import Control.Monad.State +import UHC.Light.Compiler.CodeGen.BasicAnnot + +{-# LINE 28 "src/ehc/CodeGen/Const.chs" #-} +-- | Ref as Fld for Const, made up of 2 indices, global for all constants, and per category +data ConstRef = ConstRef + { constrefGlobal :: !Int + , constrefInCateg :: !Int + } + +instance Show ConstRef where + show r = "CRef_" ++ show (constrefGlobal r) ++ "_" ++ show (constrefInCateg r) + +type CFld = Fld' ConstRef + +instance RefOfFld CFld Int where + refOfFld = constrefGlobal . fromJust . _fldInx + +instance RefOfFld CFld HsName where + refOfFld = fromJust . _fldNm + +{-# LINE 47 "src/ehc/CodeGen/Const.chs" #-} +-- | Global index of CFld +cfldGlobInx :: CFld -> Int +cfldGlobInx = refOfFld +{-# INLINE cfldGlobInx #-} + +{-# LINE 54 "src/ehc/CodeGen/Const.chs" #-} +-- | Representation of constant info to be stored globally, if a further codegen phase chooses to. +-- Later reference than is via a CFld. +data Const + = Const_FFIFunction + { constFFIFunNm :: !String + } + | Const_FFICallEncWrapper + { constFFIArgSizes :: ![BasicSize] + } + | Const_String + { constString :: !String + } + | Const_Nm + { constNm :: !HsName + } + deriving(Eq,Ord,Show) + +{-# LINE 73 "src/ehc/CodeGen/Const.chs" #-} +-- | Is FFI related Const? +isFFIConst :: Const -> Bool +isFFIConst (Const_FFIFunction {}) = True +isFFIConst (Const_FFICallEncWrapper {}) = True +isFFIConst _ = False + +{-# LINE 81 "src/ehc/CodeGen/Const.chs" #-} +-- | String representation of const category, to be used for counting and name gen +categ :: Const -> String +categ (Const_FFIFunction {}) = "funffi" +categ (Const_FFICallEncWrapper {}) = "encffi" +categ (Const_String {}) = "str" +categ (Const_Nm {}) = "nm" + +{-# LINE 95 "src/ehc/CodeGen/Const.chs" #-} +data ConstSt = ConstSt + { conststMp :: !(Map.Map Const CFld) + , conststGlobalCnt :: !Int + , conststInCategCntMp :: !(Map.Map String Int) + } + +emptyConstSt = ConstSt Map.empty 0 Map.empty + +{-# LINE 109 "src/ehc/CodeGen/Const.chs" #-} +-- | Add a Const, reusing if already exists, monadically +addM :: Const -> State ConstSt CFld +addM c = do + st <- get + case Map.lookup c (conststMp st) of + Just r -> return r + _ -> do put $ st + { conststMp = Map.insert c ref (conststMp st) + , conststGlobalCnt = ginx+1 + , conststInCategCntMp = Map.insert cat (cinx+1) (conststInCategCntMp st) + } + return ref + where ginx = conststGlobalCnt st + cat = categ c + cinx = Map.findWithDefault 0 cat $ conststInCategCntMp st + ref = Fld (Just $ mkHNm $ cat ++ show cinx) (Just $ ConstRef ginx cinx) + +-- | Add a Const, reusing if already exists +add :: Const -> ConstSt -> (CFld,ConstSt) +add c = runState $ addM c + + +{-# LINE 133 "src/ehc/CodeGen/Const.chs" #-} +addStr :: String -> ConstSt -> (CFld,ConstSt) +addStr s = add (Const_String s) + +addNm :: HsName -> ConstSt -> (CFld,ConstSt) +addNm nm = add (Const_Nm nm) + +addFFIFun :: String -> ConstSt -> (CFld,ConstSt) +addFFIFun nm = add (Const_FFIFunction nm) + +addFFICallEncWrapper :: [BasicSize] -> ConstSt -> (CFld,ConstSt) +addFFICallEncWrapper szs = add (Const_FFICallEncWrapper szs) + diff --git a/src/UHC/Light/Compiler/CodeGen/ImportUsedModules.hs b/src/UHC/Light/Compiler/CodeGen/ImportUsedModules.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/ImportUsedModules.hs @@ -0,0 +1,17 @@ +module UHC.Light.Compiler.CodeGen.ImportUsedModules +( ImportUsedModules (..), emptyImportUsedModules ) +where +import UHC.Light.Compiler.Base.Common +import qualified Data.Set as Set + +{-# LINE 18 "src/ehc/CodeGen/ImportUsedModules.chs" #-} +data ImportUsedModules + = ImportUsedModules + { iumHSDeclModules :: !HsNameS -- ^ imported modules as declared in src .hs + , iumHIDeclModules :: !HsNameS -- ^ imported modules as declared, either in .hs or .hi + , iumHIUsedModules :: !HsNameS -- ^ imported modules as actually used + , iumIntrodModules :: !HsNameS -- ^ module names for which a introduction/def is made + } + +emptyImportUsedModules = ImportUsedModules Set.empty Set.empty Set.empty Set.empty + diff --git a/src/UHC/Light/Compiler/CodeGen/RefGenerator.hs b/src/UHC/Light/Compiler/CodeGen/RefGenerator.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/RefGenerator.hs @@ -0,0 +1,46 @@ +module UHC.Light.Compiler.CodeGen.RefGenerator +( RefGenerator (..) +, refGen, refGenM ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import Control.Monad +import Control.Monad.State + +{-# LINE 19 "src/ehc/CodeGen/RefGenerator.chs" #-} +type RefGenMonad m ref = StateT Int m ref + +class RefGenerator ref where + -- | Generate for 1 name + refGen1M :: Monad m => Int -> HsName -> RefGenMonad m ref + refGen1 :: Int -> Int -> HsName -> (ref, Int) + + -- defaults + refGen1M dir nm = do + seed <- get + let (r,seed') = refGen1 seed dir nm + put seed' + return r + + refGen1 seed dir nm = runState (refGen1M dir nm) seed + +instance RefGenerator HsName where + refGen1M _ = return + +instance RefGenerator Int where + refGen1 seed dir nm = (seed, seed+dir) + +instance RefGenerator Fld where + refGen1 seed dir nm = (Fld (Just nm) (Just seed), seed+dir) + +{-# LINE 46 "src/ehc/CodeGen/RefGenerator.chs" #-} +-- | Generate for names, starting at a seed in a direction +refGenM :: (Monad m, RefGenerator ref) => Int -> [HsName] -> RefGenMonad m (AssocL HsName ref) +refGenM dir nmL + = forM nmL $ \nm -> do + r <- refGen1M dir nm + return (nm,r) + +refGen :: RefGenerator ref => Int -> Int -> [HsName] -> AssocL HsName ref +refGen seed dir nmL = evalState (refGenM dir nmL) seed + diff --git a/src/UHC/Light/Compiler/CodeGen/Tag.hs b/src/UHC/Light/Compiler/CodeGen/Tag.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/Tag.hs @@ -0,0 +1,183 @@ +module UHC.Light.Compiler.CodeGen.Tag +( CTag (..), ctagIsRec, ctagTag, ctagChar, ctagInt, emptyCTag +, mkOnlyConInfoCTag, patchTyInfoCTag +, ctag, ppCTag, ppCTagInt +, tagBoolTrue, tagBoolFalse +, tagListCons, tagListNil +, TagDataInfo (..) +, mkTyIsConTagInfo, mkConTagInfo, emptyTagDataInfo +, tagInfoInt, tagInfoChar +, TagLike (..), tagDataInfo +, CTagsMp, emptyCTagsMp +, mkClassCTag ) +where +import Data.Maybe +import Control.Monad +import UHC.Util.Pretty +import UHC.Util.AssocL +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 33 "src/ehc/CodeGen/Tag.chs" #-} +data CTag + = CTagRec + | CTag + { ctagTyNm :: !HsName + , ctagNm :: !HsName + , ctagTag' :: !Int + , ctagArity :: !Int + , ctagMaxArity :: !Int + } + deriving (Show,Eq,Ord) + +ctagIsRec :: CTag -> Bool +ctagIsRec CTagRec = True +ctagIsRec t = False + +ctagTag :: CTag -> Int +ctagTag CTagRec = 0 +ctagTag t = ctagTag' t + +ctagInt = CTag hsnInt hsnInt 0 1 1 +{-# INLINE ctagInt #-} +ctagChar = CTag hsnChar hsnChar 0 1 1 +{-# INLINE ctagChar #-} + +emptyCTag = CTag hsnUnknown hsnUnknown 0 0 0 +{-# INLINE emptyCTag #-} + +{-# LINE 62 "src/ehc/CodeGen/Tag.chs" #-} +-- | Construct a minimal datatype tag which still must be completed wrt more global datatype info +mkOnlyConInfoCTag :: HsName -> Int -> Int -> CTag +mkOnlyConInfoCTag conNm tg arity = emptyCTag {ctagNm = conNm, ctagTag' = tg, ctagArity = arity} + +-- | Patch a datatype tag with datatype global info +patchTyInfoCTag :: HsName -> Int -> CTag -> CTag +patchTyInfoCTag tyNm maxArity t = t {ctagTyNm = tyNm, ctagMaxArity = maxArity} + +{-# LINE 72 "src/ehc/CodeGen/Tag.chs" #-} +-- only used when `not ehcCfgClassViaRec' +mkClassCTag :: HsName -> Int -> CTag +mkClassCTag n sz = CTag n n 0 sz sz + +{-# LINE 78 "src/ehc/CodeGen/Tag.chs" #-} +ctag :: a -> (HsName -> HsName -> Int -> Int -> Int -> a) -> CTag -> a +ctag n t tg = case tg of {CTag tn cn i a ma -> t tn cn i a ma; _ -> n} +{-# INLINE ctag #-} + +ppCTag :: CTag -> PP_Doc +ppCTag = ctag (pp "Rec") (\tn cn t a ma -> pp t >|< "/" >|< pp cn >|< "/" >|< pp a >|< "/" >|< pp ma) + +ppCTagInt :: CTag -> PP_Doc +ppCTagInt = ctag (pp "-1") (\_ _ t _ _ -> pp t) + +instance PP CTag where + pp = ppCTag + +{-# LINE 97 "src/ehc/CodeGen/Tag.chs" #-} +tagBoolTrue, tagBoolFalse :: Int +tagBoolTrue = 1 -- this makes it hardcoded, ideally dependent on datatype def itself !! +tagBoolFalse = 0 -- this makes it hardcoded, ideally dependent on datatype def itself !! + +{-# LINE 103 "src/ehc/CodeGen/Tag.chs" #-} +tagListCons, tagListNil :: Int +tagListCons = 0 -- this makes it hardcoded, ideally dependent on datatype def itself !! +tagListNil = 1 -- this makes it hardcoded, ideally dependent on datatype def itself !! + +{-# LINE 113 "src/ehc/CodeGen/Tag.chs" #-} +-- | datatype info about tag: type name & constr name, required throughout various codegen stages +data TagDataInfo = TagDataInfo + { tagDataInfoTypeNm :: !HsName + , tagDataInfoConstrNm :: !HsName + } + deriving (Show) + +instance Eq TagDataInfo where + i1 == i2 = tagDataInfoConstrNm i1 == tagDataInfoConstrNm i2 + +instance Ord TagDataInfo where + i1 `compare` i2 = tagDataInfoConstrNm i1 `compare` tagDataInfoConstrNm i2 + +{-# LINE 128 "src/ehc/CodeGen/Tag.chs" #-} +mkTyConTagInfo :: HsName -> HsName -> TagDataInfo +mkTyConTagInfo = TagDataInfo +{-# INLINE mkTyConTagInfo #-} + +-- | Construct info when Ty and Con name are equal +mkTyIsConTagInfo :: HsName -> TagDataInfo +mkTyIsConTagInfo n = mkTyConTagInfo n n +{-# INLINE mkTyIsConTagInfo #-} + +mkConTagInfo :: HsName -> TagDataInfo +mkConTagInfo cn = mkTyConTagInfo hsnUnknown cn +{-# INLINE mkConTagInfo #-} + +emptyTagDataInfo = mkTyConTagInfo hsnUnknown hsnUnknown + +{-# LINE 145 "src/ehc/CodeGen/Tag.chs" #-} +tagInfoInt = mkTyIsConTagInfo hsnInt +tagInfoChar = mkTyIsConTagInfo hsnChar + +{-# LINE 150 "src/ehc/CodeGen/Tag.chs" #-} +class TagLike t where + tagIsData :: t -> Bool + tagIsTup :: t -> Bool + + -- | extract data related info, only allowed when tagIsData + tagMbDataInfo :: t -> Maybe TagDataInfo + tagDataTypeNm :: t -> HsName + tagDataConstrNm :: t -> HsName + tagDataTag :: t -> Int + + -- defaults: either tagDataInfo or tagDataTypeNm and tagDataConstrNm and tagIsData + tagMbDataInfo t = if tagIsData t then Just (emptyTagDataInfo {tagDataInfoTypeNm = tagDataTypeNm t, tagDataInfoConstrNm = tagDataConstrNm t}) else Nothing + tagDataTypeNm = tagDataInfoTypeNm . tagDataInfo + tagDataConstrNm = tagDataInfoConstrNm . tagDataInfo + tagIsData = isJust . tagMbDataInfo + + -- defaults + tagIsTup = not . tagIsData + +-- | Assuming a datatype, return info +tagDataInfo :: TagLike t => t -> TagDataInfo +tagDataInfo = fromJust . tagMbDataInfo +{-# INLINE tagDataInfo #-} + +instance TagLike CTag where + tagMbDataInfo = ctag Nothing (\tn cn _ _ _ -> Just (emptyTagDataInfo {tagDataInfoTypeNm = tn, tagDataInfoConstrNm = cn})) + tagDataTag = ctagTag' + -- not necessary: + tagIsTup = ctagIsRec + tagDataTypeNm = ctagTyNm + tagDataConstrNm = ctagNm + +{-# LINE 184 "src/ehc/CodeGen/Tag.chs" #-} +instance PP TagDataInfo where + pp i = tagDataInfoTypeNm i >|< "#" >|< tagDataInfoConstrNm i + +{-# LINE 193 "src/ehc/CodeGen/Tag.chs" #-} +type CTagsMp = AssocL HsName (AssocL HsName CTag) + +emptyCTagsMp :: CTagsMp +emptyCTagsMp = [] + +{-# LINE 204 "src/ehc/CodeGen/Tag.chs" #-} +deriving instance Typeable CTag +deriving instance Data CTag + + +{-# LINE 214 "src/ehc/CodeGen/Tag.chs" #-} +instance Serialize CTag where + sput = sputShared + sget = sgetShared + sputNested (CTagRec ) = sputWord8 0 + sputNested (CTag a b c d e) = sputWord8 1 >> sput a >> sput b >> sput c >> sput d >> sput e + sgetNested + = do t <- sgetWord8 + case t of + 0 -> return CTagRec + 1 -> liftM5 CTag sget sget sget sget sget diff --git a/src/UHC/Light/Compiler/CodeGen/TrfUtils.hs b/src/UHC/Light/Compiler/CodeGen/TrfUtils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/TrfUtils.hs @@ -0,0 +1,144 @@ +module UHC.Light.Compiler.CodeGen.TrfUtils +( TrfState (..), mkEmptyTrfState +, runTrf +, liftTrfModPlain +, liftCheckMod +, liftTrfModWithState +, liftTrfModWithStateExtra +, liftTrfWithExtraInfo +, modifyGets ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import Control.Monad.State.Strict +import Control.Monad.Reader +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.Common + +{-# LINE 24 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Environmental info for transformations. TBD 20140409: sort out what is really necessary +data TrfReader + = TrfReader + { trfrdMustDump :: EHCOpts -> Bool -- ^ must dump? + , trfrdCanDoOptScope :: [OptimizationScope] -> Bool -- ^ trf must be done for this optimization scope? + , trfrdOpts :: EHCOpts -- ^ global options + , trfrdModNm :: HsName -- ^ module name + } + +-- | State info for transformations +data TrfState + mod -- module structure + extra -- extra state info, extension + = TrfState + { trfstMod :: !mod -- ^ most recent transformed module + , trfstModStages :: [(String,Maybe mod,ErrL)] -- ^ intermediate stages with errors, if dumping also with module + , trfstUniq :: !UID -- ^ unique counter, threaded in/out + , trfstExtra :: extra -- ^ optional extension of state info + } + +mkEmptyTrfState :: mod -> extra -> TrfState mod extra +mkEmptyTrfState m e = TrfState m [] uidStart e + +-- | The monad for transformations +type TrfM mod extra = ReaderT TrfReader (State (TrfState mod extra)) + +{-# LINE 52 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Freshness +instance MonadFreshUID (TrfM mod extra) where + freshInfUID = modifyGets $ \s@(TrfState{trfstUniq=u}) -> + let (n,h) = mkNewLevUID u + in (h,s {trfstUniq = n}) + +{-# LINE 64 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Run transformations. +-- The 'optimScope' tells at which compilation phase (per module, whole program) the transformations are done, default only per module +runTrf + :: EHCOpts + -> HsName + -> (EHCOpts -> Bool) -- ^ need to dump? + -> ([OptimizationScope] -> Bool) -- ^ can run for optimization scope? + -> TrfState mod extra + -> (TrfM mod extra ()) + -> TrfState mod extra +runTrf opts modNm mustDump canDoWRTOptScope trfst trf + = execState (runReaderT trf (TrfReader mustDump canDoWRTOptScope opts modNm)) trfst + +{-# LINE 83 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Lift a module transformation function to the state monad +liftTrfModPlain + :: (MonadState (TrfState mod extra) m, MonadReader TrfReader m) => + [OptimizationScope] -- ^ only when in this optimization scope, ie limiting the run + -> String -- ^ name of trf + -> (mod -> mod) -- ^ trf + -> m () +liftTrfModPlain os nm t + = liftTrfWithExtraInfo os nm (flip const) (\_ c -> (Just $ t c,(),[])) + +{-# LINE 95 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Only check +liftCheckMod + :: (MonadState (TrfState mod extra) m, MonadReader TrfReader m) => + [OptimizationScope] -- ^ only when in this optimization scope + -> String -- ^ name of trf + -> (TrfState mod extra -> mod -> ErrL) -- ^ check + -> m () +liftCheckMod os nm t + = liftTrfWithExtraInfo os nm (flip const) (\s c -> let e = t s c in (Nothing,(),e)) + +{-# LINE 107 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Lift a module transformation function taking also state to the state monad +liftTrfModWithState + :: (MonadState (TrfState mod extra) m, MonadReader TrfReader m) => + [OptimizationScope] -- ^ only when in this optimization scope + -> String -- ^ name of trf + -> (TrfState mod extra -> mod -> mod) -- ^ trf + -> m () +liftTrfModWithState os nm t + = liftTrfWithExtraInfo os nm (flip const) (\s c -> (Just $ t s c,(),[])) + +{-# LINE 119 "src/ehc/CodeGen/TrfUtils.chs" #-} +liftTrfModWithStateExtra + :: (MonadState (TrfState mod extra) m, MonadReader TrfReader m) => + [OptimizationScope] -- ^ only when in this optimization scope + -> String -- ^ name of trf + -> (t -> TrfState mod extra -> TrfState mod extra) -- ^ state update with extra info + -> (TrfState mod extra -> mod -> (mod,t)) -- ^ trf + -> m () +liftTrfModWithStateExtra os nm update2 t + = liftTrfWithExtraInfo os nm update2 (\s c -> let (c',e) = t s c in (Just c',e,[])) + +{-# LINE 131 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Lift a module transformation function dealing with some arbitrary extra info to the state monad, factoring out yes/no dumping and error gathering +liftTrfWithExtraInfo + :: (MonadState (TrfState mod extra) m, MonadReader TrfReader m) => + [OptimizationScope] -- ^ only when in this optimization scope + -> String -- ^ name of trf + -> (t -> TrfState mod extra -> TrfState mod extra) -- ^ state update with extra info + -> (TrfState mod extra -> mod -> (Maybe mod, t, ErrL)) -- ^ trf, dealing with extra info as well + -> m () +liftTrfWithExtraInfo os nm update2 t = do + canDoWRTOptScope <- asks trfrdCanDoOptScope + opts <- asks trfrdOpts + if canDoWRTOptScope os + then do + mustDump <- asks trfrdMustDump + modify $ \s@(TrfState{trfstMod=c, trfstModStages=stages}) -> + let (c',extra,errl) = t s c + in update2 extra + $ s { trfstMod = maybe c id c' + , trfstModStages = stages ++ [(nm,if mustDump opts then c' else Nothing,errl)] + } + else return () + +{-# LINE 159 "src/ehc/CodeGen/TrfUtils.chs" #-} +-- | Combi of modify and get: modify and also return newly set value. TBD 20140409: get rid of this...? +modifyGets :: MonadState s m => (s -> (a,s)) -> m a +modifyGets update + = do { s <- get + ; let (x,s') = update s + ; put s' + ; return x + } + diff --git a/src/UHC/Light/Compiler/CodeGen/ValAccess.hs b/src/UHC/Light/Compiler/CodeGen/ValAccess.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CodeGen/ValAccess.hs @@ -0,0 +1,50 @@ +module UHC.Light.Compiler.CodeGen.ValAccess +( module UHC.Light.Compiler.CodeGen.BasicAnnot +, patNmL2DepL +, AltFetch (..) +, HsName2RefMp, HsName2RefMpMp +, HsName2FldMpMp, HsName2FldMp +, offMpKeysSorted, offMpMpKeysSet ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.RefGenerator +import UHC.Util.Utils +import UHC.Util.Pretty as Pretty +import Data.Bits +import Data.Maybe +import qualified UHC.Util.FastSeq as Seq +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import Control.Monad.State +import UHC.Light.Compiler.CodeGen.BasicAnnot + +{-# LINE 126 "src/ehc/CodeGen/ValAccess.chs" #-} +-- | Generate references starting at offset 0 with additional direction tweaking +patNmL2DepL :: RefGenerator r => (Int -> Int) -> ([HsName] -> [HsName]) -> [HsName] -> AssocL HsName r +patNmL2DepL fd fl nmL = refGen 0 (fd 1) (fl nmL) + +{-# LINE 136 "src/ehc/CodeGen/ValAccess.chs" #-} +type HsName2RefMp meref = Map.Map HsName meref +type HsName2RefMpMp mref meref = Map.Map HsName (mref, HsName2RefMp meref) + +{-# LINE 141 "src/ehc/CodeGen/ValAccess.chs" #-} +type HsName2FldMp = HsName2RefMp Fld +type HsName2FldMpMp = HsName2RefMpMp Fld Fld + +{-# LINE 146 "src/ehc/CodeGen/ValAccess.chs" #-} +-- | Module names, sorted on import order, which is included as 0-based offset (used as index in import entry table) +offMpKeysSorted :: (Ord mref, RefOfFld Fld mref) => HsName2FldMpMp -> AssocL HsName mref +offMpKeysSorted m = sortOn snd [ (n, refOfFld o) | (n,(o,_)) <- Map.toList m ] + +offMpMpKeysSet :: HsName2RefMpMp mref meref -> HsNameS +offMpMpKeysSet m = Set.unions [ Map.keysSet m' | (_,m') <- Map.elems m ] + +{-# LINE 159 "src/ehc/CodeGen/ValAccess.chs" #-} +data AltFetch lref + = AltFetch_Many [HsName] -- multiple introduced names + | AltFetch_One HsName lref -- single introduced name, field ref in node (excluding header) + | AltFetch_Zero + deriving Eq + diff --git a/src/UHC/Light/Compiler/Config.hs b/src/UHC/Light/Compiler/Config.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Config.hs @@ -0,0 +1,273 @@ +module UHC.Light.Compiler.Config +( module UHC.Light.Compiler.ConfigInstall +, Version (..) +, version +, verInfo +, module UHC.Light.Compiler.ConfigDefines +, installRootM +, installRoot +, installVariant +, mkInstallFilePrefixM +, mkInstallFilePrefix +, mkInstallBindirPrefixM +, mkInstallBindirPrefix +, mkInstalledRtsM +, mkInstalledRts +, shellCmdGcc +, libnamesGcc +, libnamesRts +, ehcGccOptsStatic, ehcGccOptsStatic' +, libnamesGccEhcExtraExternalLibs +, mbSuffixExec, linkerSymbolPrefix +, suffixDotlessBinaryCore, suffixDotlessInputOutputBinaryCore, suffixDotlessOutputTextualCore, suffixDotlessInputOutputTextualCore +, suffixDotlessInputOutputCoreRun +, mkInstallPkgdirSystemM +, mkInstallPkgdirSystem +, mkInstallPkgdirUser +, shellCmdOverride +, shellCmdCpp +, shellCmdAr +, shellCmdRanlib +, shellCmdLibtoolStatic +, shellCmdLibtoolStaticOpts +, mkShellCmdLibtool ) +where +import UHC.Light.Compiler.ConfigInstall +import Data.Maybe +import Data.List +import UHC.Util.Utils +import UHC.Util.FPath +import qualified Data.Map as Map +import UHC.Light.Compiler.Opts.CommandLine +import UHC.Light.Compiler.ConfigDefines +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.EHC.Environment +import qualified UHC.Light.Compiler.ConfigCabal as Cfg + + + +{-# LINE 37 "src/ehc/Config.chs" #-} +data Version + = Version + { verSvnRevision :: !String + , verMajor :: !String + , verMinor :: !String + , verMinorMinor :: !String + , verMinorMinorMinor :: !String + , verQuality :: !String + , verShort :: !String + , verMedium :: !String + , verFull :: !String + , verAsNumber :: !String + , verProg :: !String + } + +{-# LINE 58 "src/ehc/Config.chs" #-} +version :: Version +version + = Version + { verSvnRevision = ehcSvnRevision + , verMajor = "1" + , verMinor = "1" + , verMinorMinor = "7" + , verMinorMinorMinor = "0" + , verQuality = "alpha" + , verShort = "1.1" + , verMedium = "1.1.7" + , verFull = "1.1.7.0" + , verAsNumber = "1170" + , verProg = "ehc" + } + +{-# LINE 80 "src/ehc/Config.chs" #-} +verInfo :: Version -> String +verInfo v = + verProg v ++ "-" ++ verFull v ++ ", revision " ++ verSvnRevision v + +{-# LINE 93 "src/ehc/Config.chs" #-} +-- | Get the installation root, in order of cabal specified (when installed as such), cmd line, builtin +installRootM :: EHCOpts -> IO String +installRootM opts = do + d <- Cfg.getDataDir + if null d + then maybe (return envroot) return (ehcOptCfgInstallRoot opts) + else return d + where envroot = ehcenvInstallRoot $ ehcOptEnvironment opts + +{-# LINE 112 "src/ehc/Config.chs" #-} +installRoot :: EHCOpts -> String +installRoot opts + = maybe envroot id (ehcOptCfgInstallRoot opts) + where envroot = ehcenvInstallRoot $ ehcOptEnvironment opts + +{-# LINE 123 "src/ehc/Config.chs" #-} +installVariant :: EHCOpts -> String +installVariant opts + = maybe envvariant id (ehcOptCfgInstallVariant opts) + where envvariant = ehcenvVariant $ ehcOptEnvironment opts + +{-# LINE 138 "src/ehc/Config.chs" #-} +mkInstallFilePrefixM :: EHCOpts -> WhatInstallFile -> String -> String -> IO String +mkInstallFilePrefixM opts whatfile variant pkg + = installRootM opts >>= \r -> return $ mkDirbasedInstallPrefix r whatfile variant (show $ ehcOptTarget opts) pkg + +{-# LINE 144 "src/ehc/Config.chs" #-} +mkInstallFilePrefix :: EHCOpts -> WhatInstallFile -> String -> String -> String +mkInstallFilePrefix opts whatfile variant pkg + = mkDirbasedInstallPrefix (installRoot opts) whatfile variant (show $ ehcOptTarget opts) pkg + +{-# LINE 150 "src/ehc/Config.chs" #-} +mkInstallBindirPrefixM :: EHCOpts -> String -> IO String +mkInstallBindirPrefixM opts variant + = installRootM opts >>= \r -> return $ mkDirbasedInstallPrefix r INST_BIN variant "" "" + +{-# LINE 156 "src/ehc/Config.chs" #-} +mkInstallBindirPrefix :: EHCOpts -> String -> String +mkInstallBindirPrefix opts variant + = mkDirbasedInstallPrefix (installRoot opts) INST_BIN variant "" "" + +{-# LINE 162 "src/ehc/Config.chs" #-} +mkInstallPkgdirSystemM :: EHCOpts -> IO String +mkInstallPkgdirSystemM opts + = fmap filePathUnPrefix $ mkInstallFilePrefixM opts INST_LIB_PKG2 (installVariant opts) "" + +{-# LINE 168 "src/ehc/Config.chs" #-} +mkInstallPkgdirSystem :: EHCOpts -> String +mkInstallPkgdirSystem opts + = filePathUnPrefix $ mkInstallFilePrefix opts INST_LIB_PKG2 (installVariant opts) "" + +{-# LINE 174 "src/ehc/Config.chs" #-} +mkInstallPkgdirUser :: EHCOpts -> String +mkInstallPkgdirUser opts + = filePathCoalesceSeparator $ filePathUnPrefix $ mkDirbasedInstallPrefix (ehcOptUserDir opts) INST_LIB_PKG2 "" (show $ ehcOptTarget opts) "" + +{-# LINE 180 "src/ehc/Config.chs" #-} +-- | construct path for RTS +mkInstalledRtsM :: EHCOpts -> (String -> String -> String) -> WhatInstallFile -> String -> String -> IO String +mkInstalledRtsM opts mkLib how variant rts + = mkInstallFilePrefixM opts how variant rts >>= \p -> return $ mkLib p rts + +{-# LINE 187 "src/ehc/Config.chs" #-} +-- | construct path for RTS +mkInstalledRts :: EHCOpts -> (String -> String -> String) -> WhatInstallFile -> String -> String -> String +mkInstalledRts opts mkLib how variant rts = mkLib (mkInstallFilePrefix opts how variant rts) rts + +{-# LINE 197 "src/ehc/Config.chs" #-} +shellCmdOverride'' :: (cmd -> Maybe FilePath) -> FilePath -> cmd -> FilePath +shellCmdOverride'' override base cmd = maybe base id $ override cmd + +shellCmdOverride' :: Ord cmd => Map.Map cmd FilePath -> FilePath -> cmd -> FilePath +shellCmdOverride' override = shellCmdOverride'' (flip Map.lookup override) + +shellCmdOverride :: EHCOpts -> FilePath -> PgmExec -> FilePath +shellCmdOverride opts = shellCmdOverride' (ehcOptPgmExecMp opts) + +{-# LINE 208 "src/ehc/Config.chs" #-} +shellCmdGcc :: String +shellCmdGcc = "/usr/bin/gcc" + +{-# LINE 233 "src/ehc/Config.chs" #-} +shellCmdCpp :: String +shellCmdCpp = "/usr/bin/cpp" + +{-# LINE 238 "src/ehc/Config.chs" #-} +shellCmdAr :: String +shellCmdAr = "/usr/bin/ar" + +{-# LINE 243 "src/ehc/Config.chs" #-} +shellCmdRanlib :: String +shellCmdRanlib = "/usr/bin/ranlib -c" + +{-# LINE 248 "src/ehc/Config.chs" #-} +shellCmdLibtoolStatic :: String +shellCmdLibtoolStatic = "/usr/bin/libtool" + +{-# LINE 253 "src/ehc/Config.chs" #-} +shellCmdLibtoolStaticOpts :: String +shellCmdLibtoolStaticOpts = "-static -o" + +{-# LINE 258 "src/ehc/Config.chs" #-} +mkShellCmdLibtool :: String -> [String] -> [[String]] +mkShellCmdLibtool archive files + = if True -- "/usr/bin/libtool" == "no" + then [ [shellCmdAr,"-r","-s",archive] ++ files + -- , [shellCmdRanlib,archive] + ] + else [ [shellCmdLibtoolStatic,shellCmdLibtoolStaticOpts,archive] ++ files + ] + +{-# LINE 273 "src/ehc/Config.chs" #-} +libnamesGcc :: EHCOpts -> [String] +libnamesGcc opts + = [ ] + ++ (if useBoehmGC opts + then [ "gc" ] + else [] + ) + ++ (if mpLib == MPLib_GMP + then [ "gmp" ] + else [] + ) + +{-# LINE 291 "src/ehc/Config.chs" #-} +libnamesRts :: [String] +libnamesRts + = [ prefixLib ++ "EH-RTS"] + +{-# LINE 297 "src/ehc/Config.chs" #-} +ehcGccOptsStatic' :: CmdLineOpts +ehcGccOptsStatic' = fst $ parseCmdLineOpts Cmd_C "" + +ehcGccOptsStatic :: [String] +ehcGccOptsStatic = map show ehcGccOptsStatic' + +{-# LINE 318 "src/ehc/Config.chs" #-} +libnamesGccEhcExtraExternalLibs :: [String] +libnamesGccEhcExtraExternalLibs + = words + ( "" + ++ " m" + ) + +{-# LINE 333 "src/ehc/Config.chs" #-} +prefixLib :: String +prefixLib = "" + +{-# LINE 338 "src/ehc/Config.chs" #-} +suffixExec :: String +suffixExec = "" + +mbSuffixExec :: Maybe String +mbSuffixExec + = case suffixExec of + ('.':s) -> Just s + "" -> Nothing + s -> Just s + +linkerSymbolPrefix :: String +linkerSymbolPrefix = "_" + + +{-# LINE 354 "src/ehc/Config.chs" #-} +-- | Suffix (dotless) for binary core files, to be read in as part of the compilation process +suffixDotlessBinaryCore :: String +suffixDotlessBinaryCore = "cr" + +-- | Suffix (dotless) for binary dumped/output core files +suffixDotlessInputOutputBinaryCore :: String +suffixDotlessInputOutputBinaryCore = "bcr" + +-- | Suffix (dotless) for textually dumped/output core files +suffixDotlessOutputTextualCore :: String +suffixDotlessOutputTextualCore = "tcr" + +-- | Suffix (dotless) for textually read core files +suffixDotlessInputOutputTextualCore :: String +suffixDotlessInputOutputTextualCore = suffixDotlessOutputTextualCore + + +{-# LINE 373 "src/ehc/Config.chs" #-} +-- | Suffix (dotless) for CoreRun files +suffixDotlessInputOutputCoreRun :: String +suffixDotlessInputOutputCoreRun = "rcr" + diff --git a/src/UHC/Light/Compiler/ConfigCabal.hs b/src/UHC/Light/Compiler/ConfigCabal.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/ConfigCabal.hs @@ -0,0 +1,4 @@ +module UHC.Light.Compiler.ConfigCabal + (module Paths_uhc_light) + where +import Paths_uhc_light diff --git a/src/UHC/Light/Compiler/ConfigDefines.hs b/src/UHC/Light/Compiler/ConfigDefines.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/ConfigDefines.hs @@ -0,0 +1,91 @@ +{-# OPTIONS_GHC -cpp #-} + +module UHC.Light.Compiler.ConfigDefines +( mkB +, GCVariant (..), gcVariant +, useBoehmGC +, sizeofWord, sizeofWordInBits, sizeofWordAsInteger, sizeofWordInLog +, nodeNeedsForwarding +, magicNumberHI +, mpLib, MPLib (..) +, sizeofFloat, sizeofDouble, sizeofCInt ) +where +import UHC.Light.Compiler.Opts.Base +import Data.Word +import Data.Char + + +{-# LINE 18 "src/ehc/ConfigDefines.chs" #-} +magicNumberHI :: [Word8] +magicNumberHI = map (fromInteger . toInteger . fromEnum) "UHI1" + +{-# LINE 27 "src/ehc/ConfigDefines.chs" #-} +mkB :: Int -> Bool +mkB x = if x /= 0 then True else False + +{-# LINE 39 "src/ehc/ConfigDefines.chs" #-} +#define USE_BOEHM_GC 0 + +data GCVariant + = GCVariant_Boehm | GCVariant_Uhc + deriving Eq + +gcVariant :: EHCOpts -> GCVariant +gcVariant opts | ehcOptEmitExecBytecode opts = GCVariant_Uhc + | mkB USE_BOEHM_GC = GCVariant_Boehm + | otherwise = GCVariant_Uhc + +{-# LINE 56 "src/ehc/ConfigDefines.chs" #-} +useBoehmGC :: EHCOpts -> Bool +useBoehmGC opts = gcVariant opts == GCVariant_Boehm + +{-# LINE 61 "src/ehc/ConfigDefines.chs" #-} +#define USE_LTM 1 +#define USE_GMP 0 + +data MPLib + = MPLib_LTM | MPLib_GMP + deriving (Show,Eq) + +mpLib :: MPLib +mpLib | mkB USE_GMP = MPLib_GMP + | otherwise = MPLib_LTM + +{-# LINE 78 "src/ehc/ConfigDefines.chs" #-} +#define SIZEOF_INTPTR_T 8 + +{-# LINE 82 "src/ehc/ConfigDefines.chs" #-} +sizeofWord :: Int +sizeofWord = SIZEOF_INTPTR_T + +sizeofWordInBits :: Int +sizeofWordInBits = sizeofWord * 8 + +sizeofWordInLog :: Int +sizeofWordInLog = if sizeofWord == 8 then 3 else 2 + +sizeofWordAsInteger :: Integer +sizeofWordAsInteger = toInteger sizeofWord + +{-# LINE 100 "src/ehc/ConfigDefines.chs" #-} +nodeNeedsForwarding :: EHCOpts -> Bool +nodeNeedsForwarding opts + = case gcVariant opts of + GCVariant_Boehm -> False -- header only + GCVariant_Uhc -> True -- header + 1 fld for forwarding + +{-# LINE 112 "src/ehc/ConfigDefines.chs" #-} +#define SIZEOF_FLOAT 4 +#define SIZEOF_DOUBLE 8 +#define SIZEOF_INT 4 + +{-# LINE 118 "src/ehc/ConfigDefines.chs" #-} +sizeofFloat :: Int +sizeofFloat = SIZEOF_FLOAT + +sizeofDouble :: Int +sizeofDouble = SIZEOF_DOUBLE + +sizeofCInt :: Int +sizeofCInt = SIZEOF_INT + diff --git a/src/UHC/Light/Compiler/ConfigInstall.hs b/src/UHC/Light/Compiler/ConfigInstall.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/ConfigInstall.hs @@ -0,0 +1,37 @@ +-- AUTO GENERATED MODULE - see files1.mk +module UHC.Light.Compiler.ConfigInstall where +import UHC.Light.Compiler.Opts.CommandLine +import Data.List + +ehcDefaultVariant = "103" + +gccOpts = fst $ parseCmdLineOpts Cmd_CPP "-std=gnu99 -Wno-array-bounds -fomit-frame-pointer" +-- gccOpts = showCmdLineOpts gccOpts' + +cppOpts = fst $ parseCmdLineOpts Cmd_CPP "-Wno-invalid-pp-token" +-- cppOpts = showCmdLineOpts cppOpts' + +ehcSvnRevision = "master@2837402ffa" + +ehcDefaultInplaceInstallDir = "/Volumes/Work/Programming/uhc/EHC/install" + +ehcPkgConfigfileName = "installed-pkg-config" + +data WhatInstallFile = USER_PKG | INST_BIN | INST_LIB | INST_LIB_SHARED | INST_INCLUDE | INST_INCLUDE_SHARED | INST_LIB_PKG2 {-- | INST_LIB_PKG | INST_LIB_PKG_INCLUDE -} + +mkCLibFilename dirprefix pkg = "" ++ dirprefix ++ "lib" ++ pkg ++ ".a" + +mkJarFilename dirprefix pkg = "" ++ dirprefix ++ "lib" ++ pkg ++ ".jar" + +mkInternalPkgFileBase pkg variant target tvariant = "" ++ pkg ++ "/" ++ variant ++ "/" ++ target ++ "/" ++ tvariant ++ "" + +mkPkgIncludeDir libdirprefix = "" ++ libdirprefix ++ "include" + +mkDirbasedInstallPrefix dir what variant target pkg = case what of + USER_PKG -> dir ++ "/" ++ target + INST_LIB -> "" ++ dir ++ "/" ++ variant ++ "/lib/" ++ target ++ "/" + INST_BIN -> "" ++ dir ++ "/" ++ variant ++ "/bin/" + INST_INCLUDE -> "" ++ dir ++ "/" ++ variant ++ "/include/" ++ target ++ "/" + INST_LIB_SHARED -> "" ++ dir ++ "/" ++ variant ++ "/shared/lib/" + INST_INCLUDE_SHARED -> "" ++ dir ++ "/" ++ variant ++ "/shared/include/" + INST_LIB_PKG2 -> "" ++ dir ++ "/" ++ variant ++ "/lib/pkg/" diff --git a/src/UHC/Light/Compiler/ConfigInternalVersions.hs b/src/UHC/Light/Compiler/ConfigInternalVersions.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/ConfigInternalVersions.hs @@ -0,0 +1,22 @@ +module UHC.Light.Compiler.ConfigInternalVersions +( InternalVersionHI, InternalVersionCore +, internalVersionHI, internalVersionCore ) +where + +{-# LINE 13 "src/ehc/ConfigInternalVersions.chs" #-} +-- | Encoding of internal version +type InternalVersion = Int + +type InternalVersionHI = InternalVersion +type InternalVersionCore = InternalVersion + +mkInternalVersion :: Int -> InternalVersion +mkInternalVersion = id + +{-# LINE 24 "src/ehc/ConfigInternalVersions.chs" #-} +-- | For binary/serialized HI .hi files and all data stored there +internalVersionHI = mkInternalVersion 1 + +-- | For binary/serialized Core .cr/.bcr etc files +internalVersionCore = mkInternalVersion 1 + diff --git a/src/UHC/Light/Compiler/Core.hs b/src/UHC/Light/Compiler/Core.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core.hs @@ -0,0 +1,815 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core.ag) +module UHC.Light.Compiler.Core(module UHC.Light.Compiler.AbstractCore +, module UHC.Light.Compiler.AnaDomain +, module UHC.Light.Compiler.Base.Target +, CodeAGItf (..), CModule (..), CExpr (..), CBind (..), CBound (..), CMetaVal (..), CMetaBind (..), CMetas, CBindL, CBoundL, CPatRest (..), CAlt (..), CAltL, CPat (..), CPatFld (..), CPatFldL +, CBindAnn (..), CBindAnnL, CExprAnn (..) +, CImport (..), CImportL +, CDeclMeta (..), CDeclMetaL, CDataCon (..), CDataConL +, RAlt, RPat, RPatConBind, RPatFld +, cmetasDefault +, cmetasVal +, cmetasMapVal +, CBindCateg (..) +, EvalCtx (..), evalCtxIsStrict +, cexprIsLam +, cbindNm +, mkCMod, emptyCModule +, cexprMbVar, cexprVar +, cexprTupFld +, cexprIsEvaluated +, CVarIntro (..), emptyCVarIntro +, CVarIntroMp, CVarIntroL, cviLookup +, cLevModule, cLevExtern +, CVarRepl (..) +, CVarReplMp +, CVarReplNm, emptyCVarReplNm +, CVarReplNmMp, CVarReplNmL +, cvrFromCvi +, fvLev, fvsLev +, SysfTy, SysfTyBind, SysfTyBound, SysfTySeq, SysfTySeq1 +, CTy, mkCTy, mkSTy, cty +, cbindLNub +, cTupLbl +, cTupTag +, cTupOff +, cmodSetImports +, cbindAspectMbExpr, cbindExprs +, cLevIntern +, cModMerge +, CDbBindLetInfo +, CDbBindRef, CDbModuleBindMp +, CModuleDatabase (..), emptyCModuleDatabase +, cmoddbLookup +, module UHC.Light.Compiler.Foreign) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.Base.Target (FFIWay (..),TargetFlavor (..)) +import Data.Maybe +import Data.Char +import Data.List +import UHC.Util.Utils +import Control.Applicative ((<|>)) +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug +import UHC.Light.Compiler.Module.Merge +import Data.Array +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Typeable (Typeable) +import Data.Generics (Data) +import UHC.Light.Compiler.Foreign + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-- | Explicit dummy instances instead of derived ones which not really are used except as context for PP +instance Show CExpr where + show _ = "CExpr" + +instance Show CBound where + show _ = "CBound" + + + + + + +type RAlt = RAlt' CExpr CTy CBind CPatRest +type RPat = RPat' CExpr CTy CBind CPatRest +type RPatConBind = RPatConBind' CExpr CTy CBind CPatRest +type RPatFld = RPatFld' CExpr CTy CBind CPatRest + + + +-- | Set imports +cmodSetImports :: [HsName] -> CModule -> CModule +cmodSetImports imp m = m {imports_CModule_Mod = map CImport_Import imp} + + + +cTupLbl :: CExpr -> HsName +cTupLbl e + = case e of + CExpr_TupIns _ _ l _ _ -> l + CExpr_TupUpd _ _ l _ _ -> l + CExpr_TupDel _ _ l _ -> l + + + +cTupTag :: CExpr -> CTag +cTupTag e + = case e of + CExpr_TupIns _ t _ _ _ -> t + CExpr_TupUpd _ t _ _ _ -> t + CExpr_TupDel _ t _ _ -> t + + + +cTupOff :: CExpr -> CExpr +cTupOff e + = case e of + CExpr_TupIns _ _ _ o _ -> o + CExpr_TupUpd _ _ _ o _ -> o + CExpr_TupDel _ _ _ o -> o + + + +cmetasDefault :: CMetas +cmetasDefault = (CMetaBind_Plain,CMetaVal_Val) + + + +cmetasVal :: CMetas -> CMetaVal +cmetasVal (_,v) = v + + + +cmetasMapVal :: (CMetaVal -> CMetaVal) -> CMetas -> CMetas +cmetasMapVal f (b,v) = (b,f v) + + + +data CBindCateg + = CBindCateg_Rec -- mutually recursive + | CBindCateg_Strict -- strictly evaluated + | CBindCateg_Plain -- plain + | CBindCateg_FFI -- imported function + | CBindCateg_FFE -- exported function (not implemented yet) + deriving (Show,Eq,Enum) + + + +deriving instance Typeable CBindCateg +deriving instance Data CBindCateg + + + +data EvalCtx + = EvalCtx_None -- nothing known, no strictness required, no thunking + | EvalCtx_Thunk -- lazy/thunked representation required + | EvalCtx_PApp0 -- partial app of lam with 0 params + | EvalCtx_Eval -- strictness (thus eval) required + | EvalCtx_EvalUnbox -- strictness (thus eval) + unboxing required + deriving Eq + +evalCtxIsStrict:: EvalCtx -> Bool +evalCtxIsStrict EvalCtx_Eval = True +evalCtxIsStrict EvalCtx_EvalUnbox = True +evalCtxIsStrict _ = False + + + +cexprIsLam :: CExpr -> Bool +cexprIsLam (CExpr_Lam _ _) = True +cexprIsLam _ = False + + + +cbindNm :: CBind -> HsName +cbindNm (CBind_Bind n _) = n +-- cbindNm (CBind_FFI _ _ _ n _ ) = n + + + +-- | extract expr for aspect, relevant for later use/analysis/... +cbindAspectMbExpr :: CBound -> Maybe CExpr +cbindAspectMbExpr (CBound_Bind _ e) = Just e +cbindAspectMbExpr (CBound_Val _ _ _ e) = Just e +cbindAspectMbExpr _ = Nothing + +-- | extract exprs of a binding which are relevant for use/analysis/... +cbindExprs :: CBind -> [CExpr] +cbindExprs (CBind_Bind _ a) = catMaybes $ map cbindAspectMbExpr a + + + +cbindLNub :: CBindL -> CBindL +cbindLNub = nubBy (\b1 b2 -> cbindNm b1 == cbindNm b2) + + + +mkCMod :: CExpr -> CModule +mkCMod e = CModule_Mod (hsnFromString "") [] [] e -- [] + +emptyCModule :: CModule +emptyCModule = mkCMod (CExpr_Int 0) + + + +cexprMbVar :: CExpr -> Maybe HsName +cexprMbVar (CExpr_Var r) = Just (acbrefNm r) +cexprMbVar _ = Nothing + +cexprVar :: CExpr -> HsName +cexprVar = maybe hsnUnknown id . cexprMbVar + + + +cexprTupFld :: CExpr -> CExpr +cexprTupFld (CExpr_TupIns _ _ _ _ e) = e +cexprTupFld _ = panic "Core.cexprTupFld" -- acoreVar hsnUnknown + + + +cexprIsEvaluated :: CExpr -> Bool +cexprIsEvaluated (CExpr_Int _) = True +cexprIsEvaluated (CExpr_Char _) = True +cexprIsEvaluated _ = False + + + +data CVarIntro + = CVarIntro + { cviLev :: Int -- lexical level + , cviMeta :: CMetaVal -- meta info + } + +emptyCVarIntro :: CVarIntro +emptyCVarIntro + = CVarIntro cLevExtern CMetaVal_Val + + + +type CVarIntroMp = Map.Map HsName CVarIntro +type CVarIntroL = AssocL HsName CVarIntro + +cviLookup :: HsName -> CVarIntroMp -> CVarIntro +cviLookup n m = Map.findWithDefault emptyCVarIntro n m + + + +cLevModule, cLevExtern :: Int +cLevModule = 0 +cLevExtern = 0 + + + +cLevIntern :: Int +cLevIntern = 1 + + + +data CVarRepl r + = CVarRepl + { cvrRepl :: r -- replacement + , cvrMeta :: CMetaVal -- meta info + } + + + +type CVarReplMp r = Map.Map HsName (CVarRepl r) +type CVarReplAsc r = AssocL HsName (CVarRepl r) + + + +type CVarReplNm = CVarRepl HsName + +emptyCVarReplNm :: CVarReplNm +emptyCVarReplNm = CVarRepl hsnUnknown CMetaVal_Val + + + +type CVarReplNmMp = CVarReplMp HsName +type CVarReplNmL = CVarReplAsc HsName + + + +cvrFromCvi :: CVarIntro -> CVarReplNm +cvrFromCvi i + = emptyCVarReplNm + { cvrMeta = cviMeta i + } + + + +fvLev :: HsName -> CVarIntroMp -> Int +fvLev n m = cviLev $ cviLookup n m + +fvsLev :: CVarIntroMp -> Int -> FvS -> Int +fvsLev lm lDflt fvs = foldr (\n l -> fvLev n lm `max` l) lDflt $ Set.toList $ fvs + + + +-- | merge by concatenation +cModMerge :: [CModule] -> CModule +cModMerge mL + = foldr1 cmb mL + where get (CExpr_Let c b e) = CExpr_Let c b . get e + get _ = id + cmb (CModule_Mod m1 im1 mt1 e1) (CModule_Mod m2 im2 mt2 e2) + = CModule_Mod m2 (im1++im2) (mt1++mt2) (get e1 e2) + + + +-- | the binding info required for let bind +type CDbBindLetInfo' f = ModDbBindLetInfo'' f CBindCateg CBind +type CDbBindLetInfo = CDbBindLetInfo' [] + + + +-- | actual bindings stored in separate array to allow for sharing +type CDbBindArray = ModDbBindArray' CBindCateg CBind + +-- | reference into database of bindings, agnostic of name given to it +type CDbBindRef = (Int,Int) + +-- | binding map of global names to individual bindings +type CDbModuleBindMp = Map.Map HsName CDbBindRef + + + +-- | the full module represented in a map/database like format (20101004 AD: to be made into persistent db soon) +data CModuleDatabase + = CModuleDatabase + { cmoddbModNm :: !HsName -- module name + , cmoddbBindArr :: !CDbBindArray -- bindings + , cmoddbBindMp :: !CDbModuleBindMp -- map of name to bindings + , cmoddbMainExpr :: !CExpr -- the final expr of the module's let expr + , cmoddbImports :: !CImportL -- imports + , cmoddbMeta :: !CDeclMetaL -- meta info/decl + } + +emptyCModuleDatabase :: CModuleDatabase +emptyCModuleDatabase = CModuleDatabase hsnUnknown (array (1,0) []) Map.empty (CExpr_Int 0) [] [] + + + +cmoddbLookup :: HsName -> CModuleDatabase -> Maybe CDbBindRef +cmoddbLookup n db = Map.lookup n $ cmoddbBindMp db + + + +-- | If there is no SysF used, just the plain type (used during type check/infer) +type SysfTy = Ty -- base ty +type SysfTyBind = Ty -- binder +type SysfTyBound = Ty -- to be bound by binder +type SysfTySeq = SysfTy -- sequence +type SysfTySeq1 = SysfTy -- singleton + + + +-- | In case of SysF isomorphic to Either 'old ty' 'sysf ty', to be chosen at a higher level +type CTy = Ty + +-- | Make CTy, ignoring the second Ty arg, which is a dummy anyway +mkCTy :: EHCOpts -> Ty -> SysfTy -> CTy +mkCTy _ t _ = t + +-- | Make CTy from sysf ty +mkSTy :: SysfTy -> CTy +mkSTy = id +{-# INLINE mkSTy #-} + +-- | CTy fold, using the first 'f' +cty :: (Ty -> x) -> (SysfTy -> x) -> CTy -> x +cty f _ t = f t + + + + +instance AbstractCore CExpr CMetaVal CBind CBound ACoreAppLikeMetaBound CBindCateg CMetaBind CTy CPat CPatRest CPatFld CAlt where + -- expr + acore1AppBound f a = CExpr_App f a + -- acoreLam1Ty a _ e = CExpr_Lam (acoreBind1 a) e + acoreLam1Bind b e = CExpr_Lam b e + acoreTagTyTupBound tg _ es = acoreAppBound (CExpr_Tup tg) es + acoreBoundVal1CatLevMetasTy _ _ _ m _ e + = CBound_Bind m e + acoreBoundmeta a m l = (a,m,l) + acoreBound1MetaVal (a,m,l) e = CBound_Val a m l e + acoreBoundValTy1CatLev _ _ _ t + = CBound_Ty acbaspkeyDefaultTy t + acoreBind1Asp n as = CBind_Bind n as + acoreBind1CatLevMetasTy bcat n mlev mb t e + = acoreBind1Asp n [acoreBoundValTy1CatLev bcat n (mlev+1) t, acoreBoundVal1CatLevMetasTy bcat n mlev mb t e] + acoreLetBase = CExpr_Let + acoreCaseDflt e as d = CExpr_Case e as (maybe (acoreVar hsnUnknown) id d) + acoreVar n = CExpr_Var (acoreMkRef n) + acoreStringTy _ i = CExpr_String i + acoreCharTy _ i = CExpr_Char i + acoreIntTy _ i = CExpr_Int i + acoreIntTy2 _ i = CExpr_Int (fromInteger i) + acoreUidHole = CExpr_Hole + acoreHoleLet = CExpr_HoleLet + -- acoreDflt = + acoreExprErr = CExpr_Dbg + + + -- ty constants + acoreTyBool o = acoreTy2ty o $ appCon (ehcOptBuiltin o ehbnDataBool) + + -- ty + -- acoreTyInt2 = tyInt + acoreTy2ty _ = id + + -- pat + acorePatVarTy n _ = CPat_Var n + acorePatCon = CPat_Con + acorePatIntTy _ i = CPat_Int i + acorePatIntTy2 _ i = CPat_Int (fromInteger i) + acorePatCharTy _ i = CPat_Char i + acorePatBoolExpr = CPat_BoolExpr + + -- patfld + acorePatFldBind (lbl,off) b = CPatFld_Fld lbl off b [] + -- acorePatFldTy _ (lbl,off) n = CPatFld_Fld lbl off n [] + + -- patrest + acorePatRestEmpty = CPatRest_Empty + acorePatRestVar = CPatRest_Var + + -- alt + acoreAlt = CAlt_Alt + + -- defaults + acoreDfltBoundmeta = (acbaspkeyDefault,0,CLbl_None) + acoreMetavalDflt = CMetaVal_Val + acoreMetavalDfltDict = CMetaVal_Dict + acoreMetabindDflt = CMetaBind_Plain + acoreTyErr s = acoreTy2ty emptyEHCOpts $ Ty_Dbg s + acoreTyNone = acoreTyErr "Core.acoreTyNone" + acoreTyChar o = acoreTy2ty o $ tyChar + acoreTyInt o = acoreTy2ty o $ tyInt + acoreTyString o = acoreTy2ty o $ tyString o + + -- bindcateg + acoreBindcategRec = CBindCateg_Rec + acoreBindcategStrict = CBindCateg_Strict + acoreBindcategPlain = CBindCateg_Plain + + -- inspecting + acoreExprMbApp (CExpr_App f b) = Just (f,b) + acoreExprMbApp _ = Nothing + + + acoreExprMbLam (CExpr_Lam b e) = Just (b,e) + acoreExprMbLam _ = Nothing + + acoreExprMbLet (CExpr_Let c b e) = Just (c,b,e) + acoreExprMbLet _ = Nothing + + acoreExprMbVar (CExpr_Var r) = Just (acbrefNm r) + acoreExprMbVar _ = Nothing + + acoreExprMbInt (CExpr_Int i) = Just (acoreTyErr "Core.acoreExprMbInt",toInteger i) + acoreExprMbInt _ = Nothing + + acoreBindcategMbRec CBindCateg_Rec = Just CBindCateg_Rec + acoreBindcategMbRec _ = Nothing + + acoreBindcategMbStrict CBindCateg_Strict = Just CBindCateg_Strict + acoreBindcategMbStrict _ = Nothing + + acorePatMbCon (CPat_Con tg r fs) = Just (tg,r,fs) + acorePatMbCon _ = Nothing + + acorePatMbInt (CPat_Int i) = Just (acoreTyErr "Core.acorePatMbInt",toInteger i) + acorePatMbInt _ = Nothing + + acorePatMbChar (CPat_Char i) = Just (acoreTyErr "Core.acorePatMbChar",i) + acorePatMbChar _ = Nothing + + acoreUnAlt (CAlt_Alt p e) = (p,e) + acoreUnPatFld (CPatFld_Fld l o b _) = ((l,o),b) + acoreUnBind (CBind_Bind n as) = (n,as) + + acoreBoundMbVal (CBound_Val a m l e) = Just ((a,m,l),e) + acoreBoundMbVal _ = Nothing + + -- coercion + acoreCoeArg = CExpr_CoeArg + acoreExprIsCoeArg = (== CExpr_CoeArg) + + + +instance Serialize CModule where + sput (CModule_Mod a b c d) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM4 CModule_Mod sget sget sget sget + +instance Serialize CImport where + sput (CImport_Import a ) = {- sputWord8 0 >> -} sput a + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM CImport_Import sget + +instance Serialize CDeclMeta where + sput (CDeclMeta_Data a b) = {- sputWord8 0 >> -} sput a >> sput b + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM2 CDeclMeta_Data sget sget + +instance Serialize CDataCon where + sput (CDataCon_Con a b c) = {- sputWord8 0 >> -} sput a >> sput b >> sput c + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM3 CDataCon_Con sget sget sget + +instance Serialize CExpr where + sput (CExpr_Let a b c ) = sputWord8 0 >> sput a >> sput b >> sput c + sput (CExpr_App a b ) = sputWord8 1 >> sput a >> sput b + sput (CExpr_Lam a b ) = sputWord8 2 >> sput a >> sput b + sput (CExpr_Case a b c ) = sputWord8 3 >> sput a >> sput b >> sput c + sput (CExpr_Var a ) = sputWord8 4 >> sput a + sput (CExpr_Int a ) = sputWord8 5 >> sput a + sput (CExpr_Char a ) = sputWord8 6 >> sput a + sput (CExpr_String a ) = sputWord8 7 >> sput a + sput (CExpr_Tup a ) = sputWord8 8 >> sput a + sput (CExpr_TupDel a b c d ) = sputWord8 9 >> sput a >> sput b >> sput c >> sput d + sput (CExpr_TupIns a b c d e ) = sputWord8 10 >> sput a >> sput b >> sput c >> sput d >> sput e + sput (CExpr_TupUpd a b c d e ) = sputWord8 11 >> sput a >> sput b >> sput c >> sput d >> sput e + sput (CExpr_CaseAltFail + a b ) = sputWord8 12 >> sput a >> sput b + sput (CExpr_Hole a ) = sputWord8 13 >> sput a + sput (CExpr_HoleLet a b ) = sputWord8 14 >> sput a >> sput b + sput (CExpr_ImplsApp a b ) = sputWord8 15 >> sput a >> sput b + sput (CExpr_ImplsLam a b ) = sputWord8 16 >> sput a >> sput b + sput (CExpr_CoeArg ) = sputWord8 17 + sput (CExpr_Integer a ) = sputWord8 18 >> sput a + sput (CExpr_Ann a b ) = sputWord8 19 >> sput a >> sput b + sput (CExpr_FFI a b c d ) = sputWord8 20 >> sput a >> sput b >> sput c >> sput d + sput (CExpr_Dbg a ) = sputWord8 21 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> liftM3 CExpr_Let sget sget sget + 1 -> liftM2 CExpr_App sget sget + 2 -> liftM2 CExpr_Lam sget sget + 3 -> liftM3 CExpr_Case sget sget sget + 4 -> liftM CExpr_Var sget + 5 -> liftM CExpr_Int sget + 6 -> liftM CExpr_Char sget + 7 -> liftM CExpr_String sget + 8 -> liftM CExpr_Tup sget + 9 -> liftM4 CExpr_TupDel sget sget sget sget + 10 -> liftM5 CExpr_TupIns sget sget sget sget sget + 11 -> liftM5 CExpr_TupUpd sget sget sget sget sget + 12 -> liftM2 CExpr_CaseAltFail sget sget + 13 -> liftM CExpr_Hole sget + 14 -> liftM2 CExpr_HoleLet sget sget + 15 -> liftM2 CExpr_ImplsApp sget sget + 16 -> liftM2 CExpr_ImplsLam sget sget + 17 -> return CExpr_CoeArg + 18 -> liftM CExpr_Integer sget + 19 -> liftM2 CExpr_Ann sget sget + 20 -> liftM4 CExpr_FFI sget sget sget sget + 21 -> liftM CExpr_Dbg sget + +instance Serialize CMetaVal where + sput (CMetaVal_Val ) = sputWord8 0 + sput (CMetaVal_Dict ) = sputWord8 1 + sput (CMetaVal_DictClass a ) = sputWord8 2 >> sput a + sput (CMetaVal_DictInstance a ) = sputWord8 3 >> sput a + sput (CMetaVal_Track a ) = sputWord8 4 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> return CMetaVal_Val + 1 -> return CMetaVal_Dict + 2 -> liftM CMetaVal_DictClass sget + 3 -> liftM CMetaVal_DictInstance sget + 4 -> liftM CMetaVal_Track sget + +instance Serialize CExprAnn where + sput (CExprAnn_Ty a) = sputWord8 0 >> sput a + sput (CExprAnn_Coe a) = sputWord8 1 >> sput a + sput (CExprAnn_Debug _) = sputWord8 2 + sget + = do t <- sgetWord8 + case t of + 0 -> liftM CExprAnn_Ty sget + 1 -> liftM CExprAnn_Coe sget + 2 -> return (CExprAnn_Debug "") + +instance Serialize CBindAnn where + sput (CBindAnn_Coe a) = sputWord8 0 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> liftM CBindAnn_Coe sget + +instance Serialize CBound where + sput (CBound_Bind a b ) = sputWord8 0 >> sput a >> sput b + -- sput (CBound_FFI a b c d ) = sputWord8 1 >> sput a >> sput b >> sput c >> sput d + sput (CBound_FFE a b c d ) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d + sput (CBound_RelevTy a b ) = sputWord8 3 >> sput a >> sput b + sput (CBound_Meta a b ) = sputWord8 4 >> sput a >> sput b + sput (CBound_Val a b c d ) = sputWord8 5 >> sput a >> sput b >> sput c >> sput d + sput (CBound_Ty a b ) = sputWord8 6 >> sput a >> sput b + sget + = do t <- sgetWord8 + case t of + 0 -> liftM2 CBound_Bind sget sget + -- 1 -> liftM4 CBound_FFI sget sget sget sget + 2 -> liftM4 CBound_FFE sget sget sget sget + 3 -> liftM2 CBound_RelevTy sget sget + 4 -> liftM2 CBound_Meta sget sget + 5 -> liftM4 CBound_Val sget sget sget sget + 6 -> liftM2 CBound_Ty sget sget + +instance Serialize CBind where + sput (CBind_Bind a b ) = {- sputWord8 0 >> -} sput a >> sput b + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM2 CBind_Bind sget sget + +instance Serialize CAlt where + sput (CAlt_Alt a b ) = {- sputWord8 0 >> -} sput a >> sput b + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM2 CAlt_Alt sget sget + +instance Serialize CPat where + sput (CPat_Var a ) = sputWord8 0 >> sput a + sput (CPat_Con a b c ) = sputWord8 1 >> sput a >> sput b >> sput c + sput (CPat_Int a ) = sputWord8 2 >> sput a + sput (CPat_Char a ) = sputWord8 3 >> sput a + sput (CPat_BoolExpr a ) = sputWord8 4 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> liftM CPat_Var sget + 1 -> liftM3 CPat_Con sget sget sget + 2 -> liftM CPat_Int sget + 3 -> liftM CPat_Char sget + 4 -> liftM CPat_BoolExpr sget + +instance Serialize CPatRest where + sput (CPatRest_Var a ) = sputWord8 0 >> sput a + sput (CPatRest_Empty ) = sputWord8 1 + sget + = do t <- sgetWord8 + case t of + 0 -> liftM CPatRest_Var sget + 1 -> return CPatRest_Empty + +instance Serialize CPatFld where + sput (CPatFld_Fld a b c d ) = {- sputWord8 0 >> -} sput a >> sput b >> sput c >> sput d + sget + = do {- t <- sgetWord8 + case t of + 0 -> -} liftM4 CPatFld_Fld sget sget sget sget + +instance Serialize CBindCateg where + sput = sputEnum8 + sget = sgetEnum8 + +instance Serialize CMetaBind where + sput = sputEnum8 + sget = sgetEnum8 + +-- CAlt -------------------------------------------------------- +data CAlt = CAlt_Alt {pat_CAlt_Alt :: !(CPat),expr_CAlt_Alt :: !(CExpr)} + deriving ( Data,Eq,Typeable) +-- CAltL ------------------------------------------------------- +type CAltL = [CAlt] +-- CBind ------------------------------------------------------- +data CBind = CBind_Bind {nm_CBind_Bind :: !(HsName),bindAspects_CBind_Bind :: !(CBoundL)} + deriving ( Data,Eq,Typeable) +-- CBindAnn ---------------------------------------------------- +data CBindAnn = CBindAnn_Coe {coe_CBindAnn_Coe :: !(RelevCoe)} + deriving ( Data,Eq,Typeable) +-- CBindAnnL --------------------------------------------------- +type CBindAnnL = [CBindAnn] +-- CBindL ------------------------------------------------------ +type CBindL = [CBind] +-- CBound ------------------------------------------------------ +data CBound = CBound_Bind {bindMeta_CBound_Bind :: !(CMetas),expr_CBound_Bind :: !(CExpr)} + | CBound_Meta {aspectKeyS_CBound_Meta :: !(ACoreBindAspectKeyS),cmetas_CBound_Meta :: !(CMetas)} + | CBound_RelevTy {aspectKeyS_CBound_RelevTy :: !(ACoreBindAspectKeyS),relevTy_CBound_RelevTy :: !(RelevTy)} + | CBound_Val {aspectKeyS_CBound_Val :: !(ACoreBindAspectKeyS),mlev_CBound_Val :: !(MetaLev),lbl_CBound_Val :: !(CLbl),expr_CBound_Val :: !(CExpr)} + | CBound_Ty {aspectKeyS_CBound_Ty :: !(ACoreBindAspectKeyS),ty_CBound_Ty :: !(Ty)} + | CBound_FFE {callconv_CBound_FFE :: !(FFIWay),expEnt_CBound_FFE :: !(ForeignEnt),expr_CBound_FFE :: !(CExpr),ty_CBound_FFE :: !(Ty)} + deriving ( Data,Eq,Typeable) +-- CBoundL ----------------------------------------------------- +type CBoundL = [CBound] +-- CDataCon ---------------------------------------------------- +data CDataCon = CDataCon_Con {conNm_CDataCon_Con :: !(HsName),tagNr_CDataCon_Con :: !(Int),arity_CDataCon_Con :: !(Int)} + deriving ( Data,Typeable) +-- CDataConL --------------------------------------------------- +type CDataConL = [CDataCon] +-- CDeclMeta --------------------------------------------------- +data CDeclMeta = CDeclMeta_Data {tyNm_CDeclMeta_Data :: !(HsName),dataCons_CDeclMeta_Data :: !(CDataConL)} + deriving ( Data,Typeable) +-- CDeclMetaL -------------------------------------------------- +type CDeclMetaL = [CDeclMeta] +-- CExpr ------------------------------------------------------- +data CExpr = CExpr_Var {ref_CExpr_Var :: !(ACoreBindRef)} + | CExpr_Int {int_CExpr_Int :: !(Int)} + | CExpr_Char {char_CExpr_Char :: !(Char)} + | CExpr_String {str_CExpr_String :: !(String)} + | CExpr_Integer {integer_CExpr_Integer :: !(Integer)} + | CExpr_Tup {tag_CExpr_Tup :: !(CTag)} + | CExpr_Let {categ_CExpr_Let :: !(CBindCateg),binds_CExpr_Let :: !(CBindL),body_CExpr_Let :: !(CExpr)} + | CExpr_App {func_CExpr_App :: !(CExpr),arg_CExpr_App :: !(CBound)} + | CExpr_Lam {bind_CExpr_Lam :: !(CBind),body_CExpr_Lam :: !(CExpr)} + | CExpr_Case {expr_CExpr_Case :: !(CExpr),alts_CExpr_Case :: !(CAltL),dflt_CExpr_Case :: !(CExpr)} + | CExpr_CaseAltFail {failReason_CExpr_CaseAltFail :: !(CaseAltFailReason),errorExpr_CExpr_CaseAltFail :: !(CExpr)} + | CExpr_TupDel {expr_CExpr_TupDel :: !(CExpr),tag_CExpr_TupDel :: !(CTag),nm_CExpr_TupDel :: !(HsName),offset_CExpr_TupDel :: !(CExpr)} + | CExpr_TupIns {expr_CExpr_TupIns :: !(CExpr),tag_CExpr_TupIns :: !(CTag),nm_CExpr_TupIns :: !(HsName),offset_CExpr_TupIns :: !(CExpr),fldExpr_CExpr_TupIns :: !(CExpr)} + | CExpr_TupUpd {expr_CExpr_TupUpd :: !(CExpr),tag_CExpr_TupUpd :: !(CTag),nm_CExpr_TupUpd :: !(HsName),offset_CExpr_TupUpd :: !(CExpr),fldExpr_CExpr_TupUpd :: !(CExpr)} + | CExpr_FFI {callconv_CExpr_FFI :: !(FFIWay),safety_CExpr_FFI :: !(String),impEnt_CExpr_FFI :: !(ForeignEnt),ty_CExpr_FFI :: !(Ty)} + | CExpr_Dbg {info_CExpr_Dbg :: !(String)} + | CExpr_Hole {uid_CExpr_Hole :: !(UID)} + | CExpr_HoleLet {bindsUid_CExpr_HoleLet :: !(UID),body_CExpr_HoleLet :: !(CExpr)} + | CExpr_CoeArg {} + | CExpr_ImplsApp {func_CExpr_ImplsApp :: !(CExpr),uid_CExpr_ImplsApp :: !(ImplsVarId)} + | CExpr_ImplsLam {uid_CExpr_ImplsLam :: !(ImplsVarId),body_CExpr_ImplsLam :: !(CExpr)} + | CExpr_Ann {ann_CExpr_Ann :: !(CExprAnn),expr_CExpr_Ann :: !(CExpr)} + deriving ( Data,Eq,Typeable) +-- CExprAnn ---------------------------------------------------- +data CExprAnn = CExprAnn_Ty {ty_CExprAnn_Ty :: !(Ty)} + | CExprAnn_Coe {coe_CExprAnn_Coe :: !(RelevCoe)} + | CExprAnn_Debug {info_CExprAnn_Debug :: !(String)} + deriving ( Data,Eq,Typeable) +-- CImport ----------------------------------------------------- +data CImport = CImport_Import {nm_CImport_Import :: !(HsName)} + deriving ( Data,Eq,Ord,Typeable) +-- CImportL ---------------------------------------------------- +type CImportL = [CImport] +-- CMetaBind --------------------------------------------------- +data CMetaBind = CMetaBind_Plain {} + | CMetaBind_Function0 {} + | CMetaBind_Function1 {} + | CMetaBind_Apply0 {} + deriving ( Data,Enum,Eq,Typeable) +-- CMetaVal ---------------------------------------------------- +data CMetaVal = CMetaVal_Val {} + | CMetaVal_Dict {} + | CMetaVal_DictClass {tracks_CMetaVal_DictClass :: !(([Track]))} + | CMetaVal_DictInstance {tracks_CMetaVal_DictInstance :: !(([Track]))} + | CMetaVal_Track {track_CMetaVal_Track :: !(Track)} + deriving ( Data,Eq,Typeable) +-- CMetas ------------------------------------------------------ +type CMetas = ( CMetaBind,CMetaVal) +-- CModule ----------------------------------------------------- +data CModule = CModule_Mod {moduleNm_CModule_Mod :: !(HsName),imports_CModule_Mod :: !(CImportL),declMetas_CModule_Mod :: !(CDeclMetaL),expr_CModule_Mod :: !(CExpr)} + deriving ( Data,Typeable) +-- CPat -------------------------------------------------------- +data CPat = CPat_Var {pnm_CPat_Var :: !(HsName)} + | CPat_Con {tag_CPat_Con :: !(CTag),rest_CPat_Con :: !(CPatRest),binds_CPat_Con :: !(CPatFldL)} + | CPat_Int {int_CPat_Int :: !(Int)} + | CPat_Char {char_CPat_Char :: !(Char)} + | CPat_BoolExpr {cexpr_CPat_BoolExpr :: !(CExpr)} + deriving ( Data,Eq,Typeable) +-- CPatFld ----------------------------------------------------- +data CPatFld = CPatFld_Fld {lbl_CPatFld_Fld :: !(HsName),offset_CPatFld_Fld :: !(CExpr),bind_CPatFld_Fld :: !(CBind),fldAnns_CPatFld_Fld :: !(CBindAnnL)} + deriving ( Data,Eq,Typeable) +-- CPatFldL ---------------------------------------------------- +type CPatFldL = [CPatFld] +-- CPatRest ---------------------------------------------------- +data CPatRest = CPatRest_Var {nm_CPatRest_Var :: !(HsName)} + | CPatRest_Empty {} + deriving ( Data,Eq,Typeable) +-- CodeAGItf --------------------------------------------------- +data CodeAGItf = CodeAGItf_AGItf {module_CodeAGItf_AGItf :: !(CModule)} + deriving ( Data,Typeable) diff --git a/src/UHC/Light/Compiler/Core/API.hs b/src/UHC/Light/Compiler/Core/API.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/API.hs @@ -0,0 +1,6 @@ +{-# LINE 2 "src/ehc/Core/API.chs" #-} +module UHC.Light.Compiler.Core.API + ( + ) + where + diff --git a/src/UHC/Light/Compiler/Core/BindExtract.hs b/src/UHC/Light/Compiler/Core/BindExtract.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/BindExtract.hs @@ -0,0 +1,1672 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/BindExtra) +module UHC.Light.Compiler.Core.BindExtract(BoundSel (..), noBoundSel, emptyBoundSel +, boundSelVal, boundSelMetaLev0, boundSelMetaLev01 +, SelVal +, cbindExtract, cboundExtract +, cbindExtractVal', cbindExtractVal, cboundExtractVal', cboundExtractVal) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty + + + + + + + +-- | Selection predicates, an algebra for CBound fixed to yield Bool +data BoundSel + = BoundSel + { selBind :: Bool + , selMeta :: ACoreBindAspectKeyS -> Bool + , selRelevTy :: ACoreBindAspectKeyS -> RelevTy -> Bool + , selVal :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> Bool + , selTy :: ACoreBindAspectKeyS -> Bool + , selFFE :: Bool + } + + +-- | Default selection +noBoundSel, emptyBoundSel :: BoundSel +noBoundSel + = BoundSel + { selBind = False + , selMeta = const False + , selRelevTy = \_ _ -> False + , selVal = \_ _ _ -> False + , selTy = const False + , selFFE = False + } + +emptyBoundSel = noBoundSel + + + +-- | Predefined selection: Val +boundSelVal :: BoundSel +boundSelVal + = noBoundSel + { selVal = \_ _ _ -> True + } + +-- | Predefined selection: same MetaLev (i.e. 0) +boundSelMetaLev0 :: BoundSel +boundSelMetaLev0 + = noBoundSel + { selBind = True + , selVal = \_ mlev _ -> mlev == 0 + , selFFE = True + } + +-- | Predefined selection: same MetaLev (i.e. 0), + 1 higher (i.e. has signature) +boundSelMetaLev01 :: BoundSel +boundSelMetaLev01 + = boundSelMetaLev0 + { selVal = \_ mlev _ -> mlev <= 1 + , selTy = const True + } + + + +type SelVal = CBound + + + +-- | Extract CBounds for a binding, partitioned according to selection +cbindExtract :: BoundSel -> CBind -> ([SelVal],[SelVal]) +cbindExtract sel b + = (selvalYesL_Syn_CBind t, selvalNoL_Syn_CBind t) + where t = wrap_CBind (sem_CBind b) + (Inh_CBind + { boundsel_Inh_CBind = sel + }) + +-- | Extract CBounds for a bound, partitioned according to selection +cboundExtract :: BoundSel -> CBound -> ([SelVal],[SelVal]) +cboundExtract sel b + = (selvalYesL_Syn_CBound t, selvalNoL_Syn_CBound t) + where t = wrap_CBound (sem_CBound b) + (Inh_CBound + { boundsel_Inh_CBound = sel + }) + + + +extractVal' :: (BoundSel -> b -> ([SelVal],[SelVal])) -> b -> (ACoreBindAspectKeyS,MetaLev,CExpr) +extractVal' extr b + = (a,ml,e) + where (CBound_Val a ml _ e:_, _) = extr boundSelVal b + +extractVal :: (BoundSel -> b -> ([SelVal],[SelVal])) -> b -> CExpr +extractVal extr b + = e + where (_,_,e) = extractVal' extr b + +cbindExtractVal' :: CBind -> (ACoreBindAspectKeyS,MetaLev,CExpr) +cbindExtractVal' = extractVal' cbindExtract + +cbindExtractVal :: CBind -> CExpr +cbindExtractVal = extractVal cbindExtract + +cboundExtractVal' :: CBound -> (ACoreBindAspectKeyS,MetaLev,CExpr) +cboundExtractVal' = extractVal' cboundExtract + +cboundExtractVal :: CBound -> CExpr +cboundExtractVal = extractVal cboundExtract + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local boundval : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (expr_) of + { ( _exprIboundval) -> + (case (pat_) of + { ( _patIboundval) -> + (case (CAlt_Alt _patIboundval _exprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local boundval : _ + alternative Nil: + visit 0: + local boundval : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIboundval) -> + (case (hd_) of + { ( _hdIboundval) -> + (case ((:) _hdIboundval _tlIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case ([]) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attribute: + boundsel : BoundSel + synthesized attributes: + boundval : CBind + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local boundval : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = BoundSel -> + ( CBind,([SelVal]),([SelVal])) +data Inh_CBind = Inh_CBind {boundsel_Inh_CBind :: !(BoundSel)} +data Syn_CBind = Syn_CBind {boundval_Syn_CBind :: !(CBind),selvalNoL_Syn_CBind :: !(([SelVal])),selvalYesL_Syn_CBind :: !(([SelVal]))} +wrap_CBind :: T_CBind -> + Inh_CBind -> + Syn_CBind +wrap_CBind sem (Inh_CBind _lhsIboundsel) = + (let ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) = sem _lhsIboundsel + in (Syn_CBind _lhsOboundval _lhsOselvalNoL _lhsOselvalYesL)) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIboundsel -> + (case (_lhsIboundsel) of + { _bindAspectsOboundsel -> + (case (bindAspects_ _bindAspectsOboundsel) of + { ( _bindAspectsIboundval,_bindAspectsIselvalNoL,_bindAspectsIselvalYesL) -> + (case (CBind_Bind nm_ _bindAspectsIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (_bindAspectsIselvalNoL) of + { _lhsOselvalNoL -> + (case (_bindAspectsIselvalYesL) of + { _lhsOselvalYesL -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local boundval : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (CBindAnn_Coe coe_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local boundval : _ + alternative Nil: + visit 0: + local boundval : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIboundval) -> + (case (hd_) of + { ( _hdIboundval) -> + (case ((:) _hdIboundval _tlIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case ([]) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attribute: + boundsel : BoundSel + synthesized attribute: + boundval : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local boundval : _ + alternative Nil: + visit 0: + local boundval : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = BoundSel -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIboundsel -> + (case (_lhsIboundsel) of + { _tlOboundsel -> + (case (tl_ _tlOboundsel) of + { ( _tlIboundval) -> + (case (_lhsIboundsel) of + { _hdOboundsel -> + (case (hd_ _hdOboundsel) of + { ( _hdIboundval,_hdIselvalNoL,_hdIselvalYesL) -> + (case ((:) _hdIboundval _tlIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIboundsel -> + (case ([]) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + boundsel : BoundSel + synthesized attributes: + boundval : CBound + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local boundval : _ + local isSelected : _ + local _tup1 : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local boundval : _ + local isSelected : _ + local _tup2 : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local boundval : _ + local isSelected : _ + local _tup3 : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local boundval : _ + local isSelected : _ + local _tup4 : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local boundval : _ + local isSelected : _ + local _tup5 : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local boundval : _ + local isSelected : _ + local _tup6 : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = BoundSel -> + ( CBound,([SelVal]),([SelVal])) +data Inh_CBound = Inh_CBound {boundsel_Inh_CBound :: !(BoundSel)} +data Syn_CBound = Syn_CBound {boundval_Syn_CBound :: !(CBound),selvalNoL_Syn_CBound :: !(([SelVal])),selvalYesL_Syn_CBound :: !(([SelVal]))} +wrap_CBound :: T_CBound -> + Inh_CBound -> + Syn_CBound +wrap_CBound sem (Inh_CBound _lhsIboundsel) = + (let ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) = sem _lhsIboundsel + in (Syn_CBound _lhsOboundval _lhsOselvalNoL _lhsOselvalYesL)) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIboundsel -> + (case (expr_) of + { ( _exprIboundval) -> + (case (bindMeta_) of + { ( _bindMetaIboundval) -> + (case (CBound_Bind _bindMetaIboundval _exprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selBind _lhsIboundsel) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup1 -> + (case (__tup1) of + { (_,_lhsOselvalNoL) -> + (case (__tup1) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIboundsel -> + (case (cmetas_) of + { ( _cmetasIboundval) -> + (case (CBound_Meta aspectKeyS_ _cmetasIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selMeta _lhsIboundsel aspectKeyS_) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup2 -> + (case (__tup2) of + { (_,_lhsOselvalNoL) -> + (case (__tup2) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIboundsel -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selRelevTy _lhsIboundsel aspectKeyS_ relevTy_) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup3 -> + (case (__tup3) of + { (_,_lhsOselvalNoL) -> + (case (__tup3) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIboundsel -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selVal _lhsIboundsel aspectKeyS_ mlev_ lbl_) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup4 -> + (case (__tup4) of + { (_,_lhsOselvalNoL) -> + (case (__tup4) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIboundsel -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selTy _lhsIboundsel aspectKeyS_) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup5 -> + (case (__tup5) of + { (_,_lhsOselvalNoL) -> + (case (__tup5) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIboundsel -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CBound_FFE callconv_ expEnt_ _exprIboundval ty_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (selFFE _lhsIboundsel) of + { _isSelected -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup6 -> + (case (__tup6) of + { (_,_lhsOselvalNoL) -> + (case (__tup6) of + { (_lhsOselvalYesL,_) -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + boundsel : BoundSel + synthesized attributes: + boundval : CBoundL + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local boundval : _ + alternative Nil: + visit 0: + local boundval : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = BoundSel -> + ( CBoundL,([SelVal]),([SelVal])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIboundsel -> + (case (_lhsIboundsel) of + { _tlOboundsel -> + (case (tl_ _tlOboundsel) of + { ( _tlIboundval,_tlIselvalNoL,_tlIselvalYesL) -> + (case (_lhsIboundsel) of + { _hdOboundsel -> + (case (hd_ _hdOboundsel) of + { ( _hdIboundval,_hdIselvalNoL,_hdIselvalYesL) -> + (case ((:) _hdIboundval _tlIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case (_hdIselvalNoL ++ _tlIselvalNoL) of + { _lhsOselvalNoL -> + (case (_hdIselvalYesL ++ _tlIselvalYesL) of + { _lhsOselvalYesL -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIboundsel -> + (case ([]) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + (case ([]) of + { _lhsOselvalNoL -> + (case ([]) of + { _lhsOselvalYesL -> + ( _lhsOboundval,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( ) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + ( ) +-- CDataConL --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( ) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + ( ) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + ( ) +-- CDeclMeta --------------------------------------------------- +{- + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + ( ) +-- CDeclMetaL -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + ( ) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + ( ) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local boundval : _ + alternative Int: + child int : {Int} + visit 0: + local boundval : _ + alternative Char: + child char : {Char} + visit 0: + local boundval : _ + alternative String: + child str : {String} + visit 0: + local boundval : _ + alternative Integer: + child integer : {Integer} + visit 0: + local boundval : _ + alternative Tup: + child tag : {CTag} + visit 0: + local boundval : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local boundsel : _ + local boundval : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local boundsel : _ + local boundval : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local boundsel : _ + local boundval : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local boundval : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local boundval : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local boundval : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local boundval : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local boundval : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local boundval : _ + alternative Dbg: + child info : {String} + visit 0: + local boundval : _ + alternative Hole: + child uid : {UID} + visit 0: + local boundval : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local boundval : _ + alternative CoeArg: + visit 0: + local boundval : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local boundval : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local boundval : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local boundval : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (CExpr_Var ref_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (CExpr_Int int_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (CExpr_Char char_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (CExpr_String str_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (CExpr_Integer integer_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (CExpr_Tup tag_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIboundval) -> + (case (noBoundSel) of + { _boundsel -> + (case (_boundsel) of + { _bindsOboundsel -> + (case (binds_ _bindsOboundsel) of + { ( _bindsIboundval) -> + (case (CExpr_Let categ_ _bindsIboundval _bodyIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (noBoundSel) of + { _boundsel -> + (case (_boundsel) of + { _argOboundsel -> + (case (arg_ _argOboundsel) of + { ( _argIboundval,_argIselvalNoL,_argIselvalYesL) -> + (case (func_) of + { ( _funcIboundval) -> + (case (CExpr_App _funcIboundval _argIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (body_) of + { ( _bodyIboundval) -> + (case (noBoundSel) of + { _boundsel -> + (case (_boundsel) of + { _bindOboundsel -> + (case (bind_ _bindOboundsel) of + { ( _bindIboundval,_bindIselvalNoL,_bindIselvalYesL) -> + (case (CExpr_Lam _bindIboundval _bodyIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (dflt_) of + { ( _dfltIboundval) -> + (case (alts_) of + { ( _altsIboundval) -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CExpr_Case _exprIboundval _altsIboundval _dfltIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIboundval) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (offset_) of + { ( _offsetIboundval) -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CExpr_TupDel _exprIboundval tag_ nm_ _offsetIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIboundval) -> + (case (offset_) of + { ( _offsetIboundval) -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CExpr_TupIns _exprIboundval tag_ nm_ _offsetIboundval _fldExprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIboundval) -> + (case (offset_) of + { ( _offsetIboundval) -> + (case (expr_) of + { ( _exprIboundval) -> + (case (CExpr_TupUpd _exprIboundval tag_ nm_ _offsetIboundval _fldExprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (CExpr_Dbg info_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (CExpr_Hole uid_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (body_) of + { ( _bodyIboundval) -> + (case (CExpr_HoleLet bindsUid_ _bodyIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (CExpr_CoeArg) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (func_) of + { ( _funcIboundval) -> + (case (CExpr_ImplsApp _funcIboundval uid_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (body_) of + { ( _bodyIboundval) -> + (case (CExpr_ImplsLam uid_ _bodyIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIboundval) -> + (case (ann_) of + { ( _annIboundval) -> + (case (CExpr_Ann _annIboundval _exprIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local boundval : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local boundval : _ + alternative Debug: + child info : {String} + visit 0: + local boundval : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (CExprAnn_Ty ty_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (CExprAnn_Coe coe_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (CExprAnn_Debug info_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CMetaBind + alternatives: + alternative Plain: + visit 0: + local boundval : _ + alternative Function0: + visit 0: + local boundval : _ + alternative Function1: + visit 0: + local boundval : _ + alternative Apply0: + visit 0: + local boundval : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (CMetaBind_Plain) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (CMetaBind_Function0) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (CMetaBind_Function1) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (CMetaBind_Apply0) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CMetaVal + alternatives: + alternative Val: + visit 0: + local boundval : _ + alternative Dict: + visit 0: + local boundval : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local boundval : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local boundval : _ + alternative Track: + child track : {Track} + visit 0: + local boundval : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (CMetaVal_Val) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (CMetaVal_Dict) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (CMetaVal_DictClass tracks_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (CMetaVal_DictInstance tracks_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (CMetaVal_Track track_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + boundval : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local boundval : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2Iboundval) -> + (case (x1_) of + { ( _x1Iboundval) -> + (case ((_x1Iboundval,_x2Iboundval)) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +-- CModule ----------------------------------------------------- +{- + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( ) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + ( ) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local boundval : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local boundval : _ + alternative Int: + child int : {Int} + visit 0: + local boundval : _ + alternative Char: + child char : {Char} + visit 0: + local boundval : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local boundval : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case (CPat_Var pnm_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIboundval) -> + (case (rest_) of + { ( _restIboundval) -> + (case (CPat_Con tag_ _restIboundval _bindsIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case (CPat_Int int_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case (CPat_Char char_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case (CPat_BoolExpr cexpr_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local boundsel : _ + local boundval : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (fldAnns_) of + { ( _fldAnnsIboundval) -> + (case (noBoundSel) of + { _boundsel -> + (case (_boundsel) of + { _bindOboundsel -> + (case (bind_ _bindOboundsel) of + { ( _bindIboundval,_bindIselvalNoL,_bindIselvalYesL) -> + (case (offset_) of + { ( _offsetIboundval) -> + (case (CPatFld_Fld lbl_ _offsetIboundval _bindIboundval _fldAnnsIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local boundval : _ + alternative Nil: + visit 0: + local boundval : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIboundval) -> + (case (hd_) of + { ( _hdIboundval) -> + (case ((:) _hdIboundval _tlIboundval) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + boundval : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local boundval : _ + alternative Empty: + visit 0: + local boundval : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (CPatRest_Var nm_) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (CPatRest_Empty) of + { _boundval -> + (case (_boundval) of + { _lhsOboundval -> + ( _lhsOboundval) }) }) +-- CodeAGItf --------------------------------------------------- +{- + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( ) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + ( ) diff --git a/src/UHC/Light/Compiler/Core/Check.hs b/src/UHC/Light/Compiler/Core/Check.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Check.hs @@ -0,0 +1,3215 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Check.ag) +module UHC.Light.Compiler.Core.Check(cmodCheck', Inh_CodeAGItf (..), Syn_CodeAGItf (..)) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core +import qualified UHC.Util.FastSeq as Seq +import Data.Maybe +import qualified Data.Map as Map +import Control.Applicative +import UHC.Util.Pretty + + + + + + + + + + + + + + + + + +cmodCheck' + :: Inh_CodeAGItf + -> CModule + -> Syn_CodeAGItf +cmodCheck' inh cmod + = t + where t = wrap_CodeAGItf + (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + inh + + + + +type UndefNmMp = Map.Map MetaLev [ACoreBindRef] + +undefmpUnion :: UndefNmMp -> UndefNmMp -> UndefNmMp +undefmpUnion = Map.unionWith (++) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = DataGam -> + EvalCtx -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev + 1) of + { _lev -> + (case (_lev) of + { _exprOlev -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_lhsIopts) of + { _patOopts -> + (case (_lev) of + { _patOlev -> + (case (_lhsIdataGam) of + { _patOdataGam -> + (case (pat_ _patOdataGam _patOlev _patOopts) of + { ( _patIerrs,_patIfldNmL,_patIisFreeOfLam,_patIundefNmMp) -> + (case (_patIerrs `Seq.union` _exprIerrs) of + { _lhsOerrs -> + (case (_patIisFreeOfLam && _exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_patIundefNmMp `undefmpUnion` _exprIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = DataGam -> + EvalCtx -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_ _tlOdataGam _tlOevalCtx _tlOlev _tlOopts) of + { ( _tlIerrs,_tlIisFreeOfLam,_tlIundefNmMp) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_ _hdOdataGam _hdOevalCtx _hdOlev _hdOopts) of + { ( _hdIerrs,_hdIisFreeOfLam,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIisFreeOfLam && _tlIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + hasMain : Bool + isFreeOfLam : Bool + isLamLifted : Bool + nm : HsName + undefNmMp : UndefNmMp + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = DataGam -> + EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( ErrSq,Bool,Bool,Bool,HsName,UndefNmMp) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts -> + (case (_lhsIlev) of + { _bindAspectsOlev -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx -> + (case (_lhsIdataGam) of + { _bindAspectsOdataGam -> + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_ _bindAspectsOdataGam _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOopts) of + { ( _bindAspectsIerrs,_bindAspectsIisFreeOfLam,_bindAspectsIisLamLifted,_bindAspectsIundefNmMp) -> + (case (_bindAspectsIerrs) of + { _lhsOerrs -> + (case (nm_ == hsnMain) of + { _lhsOhasMain -> + (case (_bindAspectsIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_bindAspectsIisLamLifted) of + { _lhsOisLamLifted -> + (case (nm_) of + { _lhsOnm -> + (case (_bindAspectsIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOnm,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Coe: + child coe : {RelevCoe} +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_ _tlOdataGam _tlOlev _tlOopts) of + { ( _tlIerrs,_tlIisFreeOfLam,_tlIundefNmMp) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_ _hdOdataGam _hdOlev _hdOopts) of + { ( _hdIerrs,_hdIisFreeOfLam,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIisFreeOfLam && _tlIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + hasMain : Bool + isFreeOfLam : Bool + isLamLifted : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = DataGam -> + EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( ErrSq,Bool,Bool,Bool,UndefNmMp) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_ _tlOdataGam _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOopts) of + { ( _tlIerrs,_tlIhasMain,_tlIisFreeOfLam,_tlIisLamLifted,_tlIundefNmMp) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_ _hdOdataGam _hdOevalCtx _hdOisGlobal _hdOletBindingsCateg _hdOlev _hdOopts) of + { ( _hdIerrs,_hdIhasMain,_hdIisFreeOfLam,_hdIisLamLifted,_hdInm,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIhasMain || _tlIhasMain) of + { _lhsOhasMain -> + (case (_hdIisFreeOfLam && _tlIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_hdIisLamLifted && _tlIisLamLifted) of + { _lhsOisLamLifted -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + isLamLifted : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isLamLifted : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isLamLifted : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = DataGam -> + EvalCtx -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( ErrSq,Bool,Bool,UndefNmMp) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_lhsIopts) of + { _bindMetaOopts -> + (case (_lhsIlev) of + { _bindMetaOlev -> + (case (_lhsIdataGam) of + { _bindMetaOdataGam -> + (case (bindMeta_ _bindMetaOdataGam _bindMetaOlev _bindMetaOopts) of + { ( _bindMetaIerrs,_bindMetaIisFreeOfLam,_bindMetaIundefNmMp) -> + (case (_bindMetaIerrs `Seq.union` _exprIerrs) of + { _lhsOerrs -> + (case (_bindMetaIisFreeOfLam && _exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (if whatExprIsLam _exprIwhatBelow + then _lhsIisGlobal && _exprIlamBodyIsFreeOfLam + else _exprIisFreeOfLam) of + { _isLamLifted -> + (case (_isLamLifted) of + { _lhsOisLamLifted -> + (case (_bindMetaIundefNmMp `undefmpUnion` _exprIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _cmetasOopts -> + (case (_lhsIlev) of + { _cmetasOlev -> + (case (_lhsIdataGam) of + { _cmetasOdataGam -> + (case (cmetas_ _cmetasOdataGam _cmetasOlev _cmetasOopts) of + { ( _cmetasIerrs,_cmetasIisFreeOfLam,_cmetasIundefNmMp) -> + (case (_cmetasIerrs) of + { _lhsOerrs -> + (case (_cmetasIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (_cmetasIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs) of + { _lhsOerrs -> + (case (_exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (if whatExprIsLam _exprIwhatBelow + then _lhsIisGlobal && _exprIlamBodyIsFreeOfLam + else _exprIisFreeOfLam) of + { _isLamLifted -> + (case (_isLamLifted) of + { _lhsOisLamLifted -> + (case (_exprIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (ExprIsLam 0) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs) of + { _lhsOerrs -> + (case (_exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted) of + { _lhsOisLamLifted -> + (case (_exprIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + isLamLifted : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = DataGam -> + EvalCtx -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( ErrSq,Bool,Bool,UndefNmMp) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsInm) of + { _tlOnm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_ _tlOdataGam _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOnm _tlOopts) of + { ( _tlIerrs,_tlIisFreeOfLam,_tlIisLamLifted,_tlIundefNmMp) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm) of + { _hdOnm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (True) of + { _hdOisTopTup -> + (case (True) of + { _hdOisTopApp -> + (case (hd_ _hdOdataGam _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm _hdOopts) of + { ( _hdIerrs,_hdIisFreeOfLam,_hdIisLamLifted,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIisFreeOfLam && _tlIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_hdIisLamLifted && _tlIisLamLifted) of + { _lhsOisLamLifted -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOundefNmMp) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + dataConstrTagMp : DataConstrTagMp + errs : ErrSq + undefNmMp : UndefNmMp + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local dti : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( DataConstrTagMp,ErrSq,UndefNmMp) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (emptyDataTagInfo + { dtiConNm = conNm_ + , dtiCTag = mkOnlyConInfoCTag conNm_ tagNr_ arity_ + }) of + { _dti -> + (case (Map.singleton conNm_ _dti) of + { _lhsOdataConstrTagMp -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOdataConstrTagMp,_lhsOerrs,_lhsOundefNmMp) }) }) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attributes: + dataConstrTagMp : DataConstrTagMp + errs : ErrSq + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( DataConstrTagMp,ErrSq,UndefNmMp) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIdataConstrTagMp,_tlIerrs,_tlIundefNmMp) -> + (case (hd_) of + { ( _hdIdataConstrTagMp,_hdIerrs,_hdIundefNmMp) -> + (case (_hdIdataConstrTagMp `Map.union` _tlIdataConstrTagMp) of + { _lhsOdataConstrTagMp -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOdataConstrTagMp,_lhsOerrs,_lhsOundefNmMp) }) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case (Map.empty) of + { _lhsOdataConstrTagMp -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOdataConstrTagMp,_lhsOerrs,_lhsOundefNmMp) }) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attributes: + errs : ErrSq + gathDataGam : DataGam + undefNmMp : UndefNmMp + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ErrSq,DataGam,UndefNmMp) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIdataConstrTagMp,_dataConsIerrs,_dataConsIundefNmMp) -> + (case (_dataConsIerrs) of + { _lhsOerrs -> + (case (gamSingleton tyNm_ $ mkDGIForCodegenOnly tyNm_ _dataConsIdataConstrTagMp) of + { _lhsOgathDataGam -> + (case (_dataConsIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOgathDataGam,_lhsOundefNmMp) }) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attributes: + errs : ErrSq + gathDataGam : DataGam + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ErrSq,DataGam,UndefNmMp) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIerrs,_tlIgathDataGam,_tlIundefNmMp) -> + (case (hd_) of + { ( _hdIerrs,_hdIgathDataGam,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIgathDataGam `gamUnion` _tlIgathDataGam) of + { _lhsOgathDataGam -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOgathDataGam,_lhsOundefNmMp) }) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case (Seq.empty) of + { _lhsOerrs -> + (case (emptyGam) of + { _lhsOgathDataGam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOgathDataGam,_lhsOundefNmMp) }) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lev : Int + opts : EHCOpts + whatAbove : WhatExpr + synthesized attributes: + errs : ErrSq + hasMain : Bool + isFreeOfLam : Bool + isLamLifted : Bool + lamBodyIsFreeOfLam : Bool + undefNmMp : UndefNmMp + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local letBindingsCateg : _ + local isTopTup : _ + local isGlobal : _ + local whatAbove : {WhatExpr} + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local isTopApp : {Bool} + local letBindingsCateg : _ + local isGlobal : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative CoeArg: + visit 0: + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = DataGam -> + EvalCtx -> + Bool -> + Bool -> + Int -> + EHCOpts -> + WhatExpr -> + ( ErrSq,Bool,Bool,Bool,Bool,UndefNmMp,WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (acbrefNm ref_) of + { _nm -> + (case (ExprIsVar _nm) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsInt int_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsTup tag_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx -> + (case (_evalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_ _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIerrs,_bodyIhasMain,_bodyIisFreeOfLam,_bodyIisLamLifted,_bodyIlamBodyIsFreeOfLam,_bodyIundefNmMp,_bodyIwhatBelow) -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (categ_) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg -> + (case (_lhsIlev == cLevModule) of + { _isGlobal -> + (case (_isGlobal) of + { _bindsOisGlobal -> + (case (_evalCtx) of + { _bindsOevalCtx -> + (case (_lhsIdataGam) of + { _bindsOdataGam -> + (case (_lhsIlev + 1) of + { _bindsOlev -> + (case (binds_ _bindsOdataGam _bindsOevalCtx _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev _bindsOopts) of + { ( _bindsIerrs,_bindsIhasMain,_bindsIisFreeOfLam,_bindsIisLamLifted,_bindsIundefNmMp) -> + (case (_bindsIerrs `Seq.union` _bodyIerrs) of + { _lhsOerrs -> + (case (_bindsIhasMain || _bodyIhasMain) of + { _lhsOhasMain -> + (case (_bindsIisFreeOfLam && _bodyIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_bindsIisLamLifted && _bodyIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_bindsIundefNmMp `undefmpUnion` _bodyIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIopts) of + { _argOopts -> + (case (_lhsIlev) of + { _argOlev -> + (case (acoreBindcategPlain) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _argOisTopTup -> + (case (False) of + { _isGlobal -> + (case (_isGlobal) of + { _argOisGlobal -> + (case (_lhsIdataGam) of + { _argOdataGam -> + (case (hsnUnknown) of + { _argOnm -> + (case (EvalCtx_Thunk) of + { _argOevalCtx -> + (case (True) of + { _argOisTopApp -> + (case (arg_ _argOdataGam _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm _argOopts) of + { ( _argIerrs,_argIisFreeOfLam,_argIisLamLifted,_argIundefNmMp) -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsIlev) of + { _funcOlev -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (_lhsIdataGam) of + { _funcOdataGam -> + (case (False) of + { _funcOisTopApp -> + (case (func_ _funcOdataGam _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIerrs,_funcIhasMain,_funcIisFreeOfLam,_funcIisLamLifted,_funcIlamBodyIsFreeOfLam,_funcIundefNmMp,_funcIwhatBelow) -> + (case (_funcIerrs `Seq.union` _argIerrs) of + { _lhsOerrs -> + (case (_funcIhasMain) of + { _lhsOhasMain -> + (case (_funcIisFreeOfLam && _argIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_funcIisLamLifted && _argIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_funcIundefNmMp `undefmpUnion` _argIundefNmMp) of + { _lhsOundefNmMp -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsIlev + 1) of + { _lev -> + (case (_lev) of + { _bodyOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_ _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIerrs,_bodyIhasMain,_bodyIisFreeOfLam,_bodyIisLamLifted,_bodyIlamBodyIsFreeOfLam,_bodyIundefNmMp,_bodyIwhatBelow) -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_lev) of + { _bindOlev -> + (case (acoreBindcategPlain) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg -> + (case (False) of + { _isGlobal -> + (case (_isGlobal) of + { _bindOisGlobal -> + (case (_lhsIevalCtx) of + { _bindOevalCtx -> + (case (_lhsIdataGam) of + { _bindOdataGam -> + (case (bind_ _bindOdataGam _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIerrs,_bindIhasMain,_bindIisFreeOfLam,_bindIisLamLifted,_bindInm,_bindIundefNmMp) -> + (case (_bindIerrs `Seq.union` _bodyIerrs) of + { _lhsOerrs -> + (case (_bindIhasMain || _bodyIhasMain) of + { _lhsOhasMain -> + (case (False) of + { _lhsOisFreeOfLam -> + (case (_bindIisLamLifted && _bodyIisLamLifted) of + { _lhsOisLamLifted -> + (case (if whatExprIsLam _bodyIwhatBelow + then _bodyIlamBodyIsFreeOfLam + else _bodyIisFreeOfLam) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_bindIundefNmMp `undefmpUnion` _bodyIundefNmMp) of + { _lhsOundefNmMp -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _dfltOwhatAbove -> + (case (_lhsIopts) of + { _dfltOopts -> + (case (_lhsIlev) of + { _dfltOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _dfltOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _dfltOisTopApp -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx -> + (case (_lhsIdataGam) of + { _dfltOdataGam -> + (case (dflt_ _dfltOdataGam _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOopts _dfltOwhatAbove) of + { ( _dfltIerrs,_dfltIhasMain,_dfltIisFreeOfLam,_dfltIisLamLifted,_dfltIlamBodyIsFreeOfLam,_dfltIundefNmMp,_dfltIwhatBelow) -> + (case (_lhsIopts) of + { _altsOopts -> + (case (_lhsIlev) of + { _altsOlev -> + (case (_lhsIevalCtx) of + { _altsOevalCtx -> + (case (_lhsIdataGam) of + { _altsOdataGam -> + (case (alts_ _altsOdataGam _altsOevalCtx _altsOlev _altsOopts) of + { ( _altsIerrs,_altsIisFreeOfLam,_altsIundefNmMp) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_isTopTup) of + { _exprOisTopTup -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs `Seq.union` _altsIerrs `Seq.union` _dfltIerrs) of + { _lhsOerrs -> + (case (_exprIhasMain || _dfltIhasMain) of + { _lhsOhasMain -> + (case (_exprIisFreeOfLam && _altsIisFreeOfLam && _dfltIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted && _dfltIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_exprIundefNmMp `undefmpUnion` _altsIundefNmMp `undefmpUnion` _dfltIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _errorExprOwhatAbove -> + (case (_lhsIopts) of + { _errorExprOopts -> + (case (_lhsIlev) of + { _errorExprOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _errorExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _errorExprOisTopApp -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx -> + (case (_lhsIdataGam) of + { _errorExprOdataGam -> + (case (errorExpr_ _errorExprOdataGam _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOopts _errorExprOwhatAbove) of + { ( _errorExprIerrs,_errorExprIhasMain,_errorExprIisFreeOfLam,_errorExprIisLamLifted,_errorExprIlamBodyIsFreeOfLam,_errorExprIundefNmMp,_errorExprIwhatBelow) -> + (case (_errorExprIerrs) of + { _lhsOerrs -> + (case (_errorExprIhasMain) of + { _lhsOhasMain -> + (case (_errorExprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_errorExprIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_errorExprIundefNmMp) of + { _lhsOundefNmMp -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_ _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIerrs,_offsetIhasMain,_offsetIisFreeOfLam,_offsetIisLamLifted,_offsetIlamBodyIsFreeOfLam,_offsetIundefNmMp,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs `Seq.union` _offsetIerrs) of + { _lhsOerrs -> + (case (_exprIhasMain || _offsetIhasMain) of + { _lhsOhasMain -> + (case (_exprIisFreeOfLam && _offsetIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted && _offsetIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_exprIundefNmMp `undefmpUnion` _offsetIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (_lhsIdataGam) of + { _fldExprOdataGam -> + (case (fldExpr_ _fldExprOdataGam _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIerrs,_fldExprIhasMain,_fldExprIisFreeOfLam,_fldExprIisLamLifted,_fldExprIlamBodyIsFreeOfLam,_fldExprIundefNmMp,_fldExprIwhatBelow) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_ _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIerrs,_offsetIhasMain,_offsetIisFreeOfLam,_offsetIisLamLifted,_offsetIlamBodyIsFreeOfLam,_offsetIundefNmMp,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs `Seq.union` _offsetIerrs `Seq.union` _fldExprIerrs) of + { _lhsOerrs -> + (case (_exprIhasMain || _offsetIhasMain || _fldExprIhasMain) of + { _lhsOhasMain -> + (case (_exprIisFreeOfLam && _offsetIisFreeOfLam && _fldExprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted && _offsetIisLamLifted && _fldExprIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_exprIundefNmMp `undefmpUnion` _offsetIundefNmMp `undefmpUnion` _fldExprIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (_lhsIdataGam) of + { _fldExprOdataGam -> + (case (fldExpr_ _fldExprOdataGam _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIerrs,_fldExprIhasMain,_fldExprIisFreeOfLam,_fldExprIisLamLifted,_fldExprIlamBodyIsFreeOfLam,_fldExprIundefNmMp,_fldExprIwhatBelow) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_ _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIerrs,_offsetIhasMain,_offsetIisFreeOfLam,_offsetIisLamLifted,_offsetIlamBodyIsFreeOfLam,_offsetIundefNmMp,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_exprIerrs `Seq.union` _offsetIerrs `Seq.union` _fldExprIerrs) of + { _lhsOerrs -> + (case (_exprIhasMain || _offsetIhasMain || _fldExprIhasMain) of + { _lhsOhasMain -> + (case (_exprIisFreeOfLam && _offsetIisFreeOfLam && _fldExprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted && _offsetIisLamLifted && _fldExprIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_exprIundefNmMp `undefmpUnion` _offsetIundefNmMp `undefmpUnion` _fldExprIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsFFI) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_ _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIerrs,_bodyIhasMain,_bodyIisFreeOfLam,_bodyIisLamLifted,_bodyIlamBodyIsFreeOfLam,_bodyIundefNmMp,_bodyIwhatBelow) -> + (case (_bodyIerrs) of + { _lhsOerrs -> + (case (_bodyIhasMain) of + { _lhsOhasMain -> + (case (_bodyIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_bodyIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_bodyIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (False) of + { _lhsOhasMain -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (True) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsIlev) of + { _funcOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _funcOisTopApp -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (_lhsIdataGam) of + { _funcOdataGam -> + (case (func_ _funcOdataGam _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIerrs,_funcIhasMain,_funcIisFreeOfLam,_funcIisLamLifted,_funcIlamBodyIsFreeOfLam,_funcIundefNmMp,_funcIwhatBelow) -> + (case (_funcIerrs) of + { _lhsOerrs -> + (case (_funcIhasMain) of + { _lhsOhasMain -> + (case (_funcIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_funcIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_funcIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_ _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIerrs,_bodyIhasMain,_bodyIisFreeOfLam,_bodyIisLamLifted,_bodyIlamBodyIsFreeOfLam,_bodyIundefNmMp,_bodyIwhatBelow) -> + (case (_bodyIerrs) of + { _lhsOerrs -> + (case (_bodyIhasMain) of + { _lhsOhasMain -> + (case (_bodyIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_bodyIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_bodyIundefNmMp) of + { _lhsOundefNmMp -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (_lhsIopts) of + { _annOopts -> + (case (_lhsIlev) of + { _annOlev -> + (case (_lhsIdataGam) of + { _annOdataGam -> + (case (ann_ _annOdataGam _annOlev _annOopts) of + { ( _annIerrs,_annIisFreeOfLam,_annIundefNmMp) -> + (case (_annIerrs `Seq.union` _exprIerrs) of + { _lhsOerrs -> + (case (_exprIhasMain) of + { _lhsOhasMain -> + (case (_annIisFreeOfLam && _exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted) of + { _lhsOisLamLifted -> + (case (False) of + { _lhsOlamBodyIsFreeOfLam -> + (case (_annIundefNmMp `undefmpUnion` _exprIundefNmMp) of + { _lhsOundefNmMp -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow -> + ( _lhsOerrs,_lhsOhasMain,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOlamBodyIsFreeOfLam,_lhsOundefNmMp,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Ty: + child ty : {Ty} + alternative Coe: + child coe : {RelevCoe} + alternative Debug: + child info : {String} +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + errs : ErrSq + impModNmL : [HsName] + undefNmMp : UndefNmMp + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ErrSq,([HsName]),UndefNmMp) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (Seq.empty) of + { _lhsOerrs -> + (case ([nm_]) of + { _lhsOimpModNmL -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOimpModNmL,_lhsOundefNmMp) }) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + errs : ErrSq + impModNmL : [HsName] + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ErrSq,([HsName]),UndefNmMp) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIerrs,_tlIimpModNmL,_tlIundefNmMp) -> + (case (hd_) of + { ( _hdIerrs,_hdIimpModNmL,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIimpModNmL ++ _tlIimpModNmL) of + { _lhsOimpModNmL -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOimpModNmL,_lhsOundefNmMp) }) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOimpModNmL -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOimpModNmL,_lhsOundefNmMp) }) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Plain: + alternative Function0: + alternative Function1: + alternative Apply0: +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Val: + alternative Dict: + alternative DictClass: + child tracks : {[Track]} + alternative DictInstance: + child tracks : {[Track]} + alternative Track: + child track : {Track} +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts -> + (case (_lhsIlev) of + { _x2Olev -> + (case (_lhsIdataGam) of + { _x2OdataGam -> + (case (x2_ _x2OdataGam _x2Olev _x2Oopts) of + { ( _x2Ierrs,_x2IisFreeOfLam,_x2IundefNmMp) -> + (case (_lhsIopts) of + { _x1Oopts -> + (case (_lhsIlev) of + { _x1Olev -> + (case (_lhsIdataGam) of + { _x1OdataGam -> + (case (x1_ _x1OdataGam _x1Olev _x1Oopts) of + { ( _x1Ierrs,_x1IisFreeOfLam,_x1IundefNmMp) -> + (case (_x1Ierrs `Seq.union` _x2Ierrs) of + { _lhsOerrs -> + (case (_x1IisFreeOfLam && _x2IisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_x1IundefNmMp `undefmpUnion` _x2IundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + gathDataGam : DataGam + hasMain : Bool + impModNmL : [HsName] + isFreeOfLam : Bool + isLamLifted : Bool + realModuleNm : HsName + undefNmMp : UndefNmMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local dataGam : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,DataGam,Bool,([HsName]),Bool,Bool,HsName,UndefNmMp) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (declMetas_) of + { ( _declMetasIerrs,_declMetasIgathDataGam,_declMetasIundefNmMp) -> + (case (_lhsIdataGam `gamUnion` _declMetasIgathDataGam) of + { _dataGam -> + (case (_dataGam) of + { _exprOdataGam -> + (case (EvalCtx_Eval) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_ _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIerrs,_exprIhasMain,_exprIisFreeOfLam,_exprIisLamLifted,_exprIlamBodyIsFreeOfLam,_exprIundefNmMp,_exprIwhatBelow) -> + (case (imports_) of + { ( _importsIerrs,_importsIimpModNmL,_importsIundefNmMp) -> + (case (_importsIerrs `Seq.union` _declMetasIerrs `Seq.union` _exprIerrs) of + { _lhsOerrs -> + (case (_declMetasIgathDataGam) of + { _lhsOgathDataGam -> + (case (_exprIhasMain) of + { _lhsOhasMain -> + (case (_importsIimpModNmL) of + { _lhsOimpModNmL -> + (case (_exprIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_exprIisLamLifted) of + { _lhsOisLamLifted -> + (case (moduleNm_) of + { _lhsOrealModuleNm -> + (case (_importsIundefNmMp `undefmpUnion` _declMetasIundefNmMp `undefmpUnion` _exprIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOgathDataGam,_lhsOhasMain,_lhsOimpModNmL,_lhsOisFreeOfLam,_lhsOisLamLifted,_lhsOrealModuleNm,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + fldNmL : [HsName] + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,([HsName]),Bool,UndefNmMp) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOfldNmL -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsIlev) of + { _bindsOlev -> + (case (_lhsIdataGam) of + { _bindsOdataGam -> + (case (binds_ _bindsOdataGam _bindsOlev _bindsOopts) of + { ( _bindsIerrs,_bindsIfldNmL,_bindsIisFreeOfLam,_bindsIundefNmMp) -> + (case (_lhsIopts) of + { _restOopts -> + (case (_lhsIlev) of + { _restOlev -> + (case (_lhsIdataGam) of + { _restOdataGam -> + (case (rest_ _restOdataGam _restOlev _restOopts) of + { ( _restIerrs,_restIisFreeOfLam,_restIundefNmMp) -> + (case (_restIerrs `Seq.union` _bindsIerrs) of + { _lhsOerrs -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (_restIisFreeOfLam && _bindsIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_restIundefNmMp `undefmpUnion` _bindsIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOfldNmL -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOfldNmL -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOfldNmL -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + fldNmL : [HsName] + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,([HsName]),Bool,UndefNmMp) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _fldAnnsOopts -> + (case (_lhsIlev) of + { _fldAnnsOlev -> + (case (_lhsIdataGam) of + { _fldAnnsOdataGam -> + (case (fldAnns_ _fldAnnsOdataGam _fldAnnsOlev _fldAnnsOopts) of + { ( _fldAnnsIerrs,_fldAnnsIisFreeOfLam,_fldAnnsIundefNmMp) -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_lhsIlev) of + { _bindOlev -> + (case (_lhsIdataGam) of + { _bindOdataGam -> + (case (False) of + { _bindOisGlobal -> + (case (EvalCtx_None) of + { _bindOevalCtx -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg -> + (case (bind_ _bindOdataGam _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIerrs,_bindIhasMain,_bindIisFreeOfLam,_bindIisLamLifted,_bindInm,_bindIundefNmMp) -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx -> + (case (True) of + { _offsetOisTopTup -> + (case (True) of + { _offsetOisTopApp -> + (case (offset_ _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIerrs,_offsetIhasMain,_offsetIisFreeOfLam,_offsetIisLamLifted,_offsetIlamBodyIsFreeOfLam,_offsetIundefNmMp,_offsetIwhatBelow) -> + (case (_offsetIerrs `Seq.union` _bindIerrs `Seq.union` _fldAnnsIerrs) of + { _lhsOerrs -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (_offsetIisFreeOfLam && _bindIisFreeOfLam && _fldAnnsIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_offsetIundefNmMp `undefmpUnion` _bindIundefNmMp `undefmpUnion` _fldAnnsIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + fldNmL : [HsName] + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,([HsName]),Bool,UndefNmMp) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_ _tlOdataGam _tlOlev _tlOopts) of + { ( _tlIerrs,_tlIfldNmL,_tlIisFreeOfLam,_tlIundefNmMp) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_ _hdOdataGam _hdOlev _hdOopts) of + { ( _hdIerrs,_hdIfldNmL,_hdIisFreeOfLam,_hdIundefNmMp) -> + (case (_hdIerrs `Seq.union` _tlIerrs) of + { _lhsOerrs -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIisFreeOfLam && _tlIisFreeOfLam) of + { _lhsOisFreeOfLam -> + (case (_hdIundefNmMp `undefmpUnion` _tlIundefNmMp) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case ([]) of + { _lhsOfldNmL -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOfldNmL,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lev : Int + opts : EHCOpts + synthesized attributes: + errs : ErrSq + isFreeOfLam : Bool + undefNmMp : UndefNmMp + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = DataGam -> + Int -> + EHCOpts -> + ( ErrSq,Bool,UndefNmMp) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIdataGam + _lhsIlev + _lhsIopts -> + (case (Seq.empty) of + { _lhsOerrs -> + (case (True) of + { _lhsOisFreeOfLam -> + (case (Map.empty) of + { _lhsOundefNmMp -> + ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOundefNmMp) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + opts : EHCOpts + synthesized attributes: + errs : ErrSq + gathDataGam : DataGam + hasMain : Bool + impModNmL : [HsName] + isLamLifted : Bool + realModuleNm : HsName + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = DataGam -> + EHCOpts -> + ( ErrSq,DataGam,Bool,([HsName]),Bool,HsName) +data Inh_CodeAGItf = Inh_CodeAGItf {dataGam_Inh_CodeAGItf :: !(DataGam),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {errs_Syn_CodeAGItf :: !(ErrSq),gathDataGam_Syn_CodeAGItf :: !(DataGam),hasMain_Syn_CodeAGItf :: !(Bool),impModNmL_Syn_CodeAGItf :: !(([HsName])),isLamLifted_Syn_CodeAGItf :: !(Bool),realModuleNm_Syn_CodeAGItf :: !(HsName)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIdataGam _lhsIopts) = + (let ( _lhsOerrs,_lhsOgathDataGam,_lhsOhasMain,_lhsOimpModNmL,_lhsOisLamLifted,_lhsOrealModuleNm) = sem _lhsIdataGam _lhsIopts + in (Syn_CodeAGItf _lhsOerrs _lhsOgathDataGam _lhsOhasMain _lhsOimpModNmL _lhsOisLamLifted _lhsOrealModuleNm)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIdataGam + _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts -> + (case (_lhsIdataGam) of + { _moduleOdataGam -> + (case (cLevModule) of + { _moduleOlev -> + (case (module_ _moduleOdataGam _moduleOlev _moduleOopts) of + { ( _moduleIerrs,_moduleIgathDataGam,_moduleIhasMain,_moduleIimpModNmL,_moduleIisFreeOfLam,_moduleIisLamLifted,_moduleIrealModuleNm,_moduleIundefNmMp) -> + (case (_moduleIerrs) of + { _lhsOerrs -> + (case (_moduleIgathDataGam) of + { _lhsOgathDataGam -> + (case (_moduleIhasMain) of + { _lhsOhasMain -> + (case (_moduleIimpModNmL) of + { _lhsOimpModNmL -> + (case (_moduleIisLamLifted) of + { _lhsOisLamLifted -> + (case (_moduleIrealModuleNm) of + { _lhsOrealModuleNm -> + ( _lhsOerrs,_lhsOgathDataGam,_lhsOhasMain,_lhsOimpModNmL,_lhsOisLamLifted,_lhsOrealModuleNm) }) }) }) }) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Coercion.hs b/src/UHC/Light/Compiler/Core/Coercion.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Coercion.hs @@ -0,0 +1,74 @@ +module UHC.Light.Compiler.Core.Coercion +( Coe, Coe' (..) +, LRCoeKind (..), lrcoeKindOfCoe +, LRCoe (..), emptyLRCoe +, lrcoeIsId +, mkLRCoe +, mkIdLRCoeWith +, lrcoeLSingleton, lrcoeRSingleton, lrcoeLFromList, lrcoeRFromList +, lrcoeUnion ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.AbstractCore +import qualified Data.Map as Map +import qualified Data.Set as Set + +{-# LINE 41 "src/ehc/Core/Coercion.chs" #-} +type Coe = Coe' CExpr CMetaVal CBind CBound CTy + +{-# LINE 53 "src/ehc/Core/Coercion.chs" #-} +data LRCoeKind = LRCoeId | LRCoeOther deriving Eq + +lrcoeKindAnd :: LRCoeKind -> LRCoeKind -> LRCoeKind +lrcoeKindAnd LRCoeId LRCoeId = LRCoeId +lrcoeKindAnd _ _ = LRCoeOther + +lrcoeKindOfCoe :: Coe -> LRCoeKind +lrcoeKindOfCoe c = if acoreCoeIsId c then LRCoeId else LRCoeOther + +{-# LINE 64 "src/ehc/Core/Coercion.chs" #-} +data LRCoe + = LRCoe + { lrcoeKind :: LRCoeKind + , lrcoeLeftL :: [Coe] + , lrcoeRightL :: [Coe] + } + +emptyLRCoe :: LRCoe +emptyLRCoe = LRCoe LRCoeId [] [] + +{-# LINE 76 "src/ehc/Core/Coercion.chs" #-} +lrcoeIsId :: LRCoe -> Bool +lrcoeIsId c = lrcoeKind c == LRCoeId + +{-# LINE 81 "src/ehc/Core/Coercion.chs" #-} +mkLRCoe :: Coe -> Coe -> LRCoe +mkLRCoe l r = LRCoe LRCoeOther [l] [r] + +mkIdLRCoe' :: Coe -> Coe -> LRCoe +mkIdLRCoe' l r = LRCoe LRCoeId [l] [r] + +{-# LINE 89 "src/ehc/Core/Coercion.chs" #-} +mkIdLRCoeWith :: HsName -> CMetaVal -> LRCoe +mkIdLRCoeWith n m = mkIdLRCoe' (acoreCoeAppN [(acoreVar n)]) (acoreCoeLam1 n) + +{-# LINE 94 "src/ehc/Core/Coercion.chs" #-} +lrcoeLFromList :: [Coe] -> LRCoe +lrcoeLFromList c = LRCoe LRCoeOther c [] + +lrcoeRFromList :: [Coe] -> LRCoe +lrcoeRFromList c = LRCoe LRCoeOther [] c + +lrcoeLSingleton :: Coe -> LRCoe +lrcoeLSingleton c = LRCoe (lrcoeKindOfCoe c) [c] [] + +lrcoeRSingleton :: Coe -> LRCoe +lrcoeRSingleton c = LRCoe (lrcoeKindOfCoe c) [] [c] + +{-# LINE 108 "src/ehc/Core/Coercion.chs" #-} +lrcoeUnion :: LRCoe -> LRCoe -> LRCoe +lrcoeUnion (LRCoe k1 l1 r1) (LRCoe k2 l2 r2) = LRCoe (lrcoeKindAnd k1 k2) (l1 ++ l2) (r1 ++ r2) + diff --git a/src/UHC/Light/Compiler/Core/ExtractFFE.hs b/src/UHC/Light/Compiler/Core/ExtractFFE.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/ExtractFFE.hs @@ -0,0 +1,1833 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ExtractFF) +module UHC.Light.Compiler.Core.ExtractFFE(cmodExtractFFE +, ExtractFFE (..)) where + +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty + + + + + + + + + +cmodExtractFFE :: CModule -> [ExtractFFE] +cmodExtractFFE m + = ffeBinds_Syn_CodeAGItf t + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf m)) Inh_CodeAGItf + + + +-- | Relevant info required outside +data ExtractFFE + = ExtractFFE + { effeBind :: CBind -- ^ the actual binding + , effeFvS :: FvS -- ^ the free vars occurring in the exported expr + } + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local fvS : _ + local self : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( FvS,CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (pat_) of + { ( _patIfldNmL,_patIfvS,_patInmL,_patIself) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (CAlt_Alt _patIself _exprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( FvS,CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS,_tlIself) -> + (case (hd_) of + { ( _hdIfvS,_hdIself) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case ((:) _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + ffeBinds : [ExtractFFE] + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + self : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local self : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ( ([ExtractFFE]),FvS,FvSMp,HsName,([HsName]),CBind) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_ _bindAspectsOnm) of + { ( _bindAspectsIffeBinds,_bindAspectsIffeBounds,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL,_bindAspectsIself) -> + (case (map (\(b,fv) -> ExtractFFE (CBind_Bind nm_ [b]) fv) _bindAspectsIffeBounds) of + { _lhsOffeBinds -> + (case (_bindAspectsIfvS) of + { _lhsOfvS -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp -> + (case (nm_) of + { _lhsOnm -> + (case ([nm_]) of + { _lhsOnmL -> + (case (CBind_Bind nm_ _bindAspectsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) }) }) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + self : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local self : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( FvS,([HsName]),CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case (CBindAnn_Coe coe_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + self : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( FvS,([HsName]),CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS,_tlInmL,_tlIself) -> + (case (hd_) of + { ( _hdIfvS,_hdInmL,_hdIself) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + (case ((:) _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case ([]) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + synthesized attributes: + ffeBinds : [ExtractFFE] + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + self : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ( ([ExtractFFE]),FvS,FvSMp,([HsName]),CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIffeBinds,_tlIfvS,_tlIfvSMp,_tlInmL,_tlIself) -> + (case (hd_) of + { ( _hdIffeBinds,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL,_hdIself) -> + (case (_hdIffeBinds ++ _tlIffeBinds) of + { _lhsOffeBinds -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + (case ((:) _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) }) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case ([]) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attributes: + ffeBinds : [ExtractFFE] + ffeBounds : [(CBound,FvS)] + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + self : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local self : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local self : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local self : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local self : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local self : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local self : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = HsName -> + ( ([ExtractFFE]),([(CBound,FvS)]),FvS,FvSMp,([HsName]),CBound) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (bindMeta_) of + { ( _bindMetaIfvS,_bindMetaIself) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (CBound_Bind _bindMetaIself _exprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsInm -> + (case ([]) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (cmetas_) of + { ( _cmetasIfvS,_cmetasIself) -> + (case (_cmetasIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (CBound_Meta aspectKeyS_ _cmetasIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsInm -> + (case ([]) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsInm -> + (case ([]) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds) of + { _lhsOffeBinds -> + (case (CBound_FFE callconv_ expEnt_ _exprIself ty_) of + { _self -> + (case ([(_self,_exprIfvS)]) of + { _lhsOffeBounds -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attributes: + ffeBinds : [ExtractFFE] + ffeBounds : [(CBound,FvS)] + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + self : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = HsName -> + ( ([ExtractFFE]),([(CBound,FvS)]),FvS,FvSMp,([HsName]),CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsInm -> + (case (_lhsInm) of + { _tlOnm -> + (case (tl_ _tlOnm) of + { ( _tlIffeBinds,_tlIffeBounds,_tlIfvS,_tlIfvSMp,_tlInmL,_tlIself) -> + (case (_lhsInm) of + { _hdOnm -> + (case (hd_ _hdOnm) of + { ( _hdIffeBinds,_hdIffeBounds,_hdIfvS,_hdIfvSMp,_hdInmL,_hdIself) -> + (case (_hdIffeBinds ++ _tlIffeBinds) of + { _lhsOffeBinds -> + (case (_hdIffeBounds ++ _tlIffeBounds) of + { _lhsOffeBounds -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + (case ((:) _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsInm -> + (case ([]) of + { _lhsOffeBinds -> + (case ([]) of + { _lhsOffeBounds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + (case ([]) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOffeBounds,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOself) }) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( ) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + ( ) +-- CDataConL --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( ) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + ( ) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + ( ) +-- CDeclMeta --------------------------------------------------- +{- + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + ( ) +-- CDeclMetaL -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + ( ) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + ( ) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + ffeBinds : [ExtractFFE] + fvS : FvS + self : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local self : _ + alternative Int: + child int : {Int} + visit 0: + local self : _ + alternative Char: + child char : {Char} + visit 0: + local self : _ + alternative String: + child str : {String} + visit 0: + local self : _ + alternative Integer: + child integer : {Integer} + visit 0: + local self : _ + alternative Tup: + child tag : {CTag} + visit 0: + local self : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local fvS : _ + local self : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local fvS : _ + local self : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + local fvS : _ + local self : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local self : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local self : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local self : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local self : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local self : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local self : _ + alternative Dbg: + child info : {String} + visit 0: + local self : _ + alternative Hole: + child uid : {UID} + visit 0: + local self : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local self : _ + alternative CoeArg: + visit 0: + local self : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local self : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local self : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local self : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( ([ExtractFFE]),FvS,CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case ([]) of + { _lhsOffeBinds -> + (case (acbrefNm ref_) of + { _nm -> + (case (Set.singleton _nm) of + { _lhsOfvS -> + (case (CExpr_Var ref_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Int int_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Char char_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_String str_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Integer integer_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Tup tag_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIffeBinds,_bodyIfvS,_bodyIself) -> + (case (binds_) of + { ( _bindsIffeBinds,_bindsIfvS,_bindsIfvSMp,_bindsInmL,_bindsIself) -> + (case (_bindsIffeBinds ++ _bodyIffeBinds) of + { _lhsOffeBinds -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (CExpr_Let categ_ _bindsIself _bodyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (hsnUnknown) of + { _argOnm -> + (case (arg_ _argOnm) of + { ( _argIffeBinds,_argIffeBounds,_argIfvS,_argIfvSMp,_argInmL,_argIself) -> + (case (func_) of + { ( _funcIffeBinds,_funcIfvS,_funcIself) -> + (case (_funcIffeBinds ++ _argIffeBinds) of + { _lhsOffeBinds -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (CExpr_App _funcIself _argIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (body_) of + { ( _bodyIffeBinds,_bodyIfvS,_bodyIself) -> + (case (bind_) of + { ( _bindIffeBinds,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL,_bindIself) -> + (case (_bindIffeBinds ++ _bodyIffeBinds) of + { _lhsOffeBinds -> + (case (_bindInm) of + { _argNm -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (CExpr_Lam _bindIself _bodyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (dflt_) of + { ( _dfltIffeBinds,_dfltIfvS,_dfltIself) -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds ++ _dfltIffeBinds) of + { _lhsOffeBinds -> + (case (alts_) of + { ( _altsIfvS,_altsIself) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS -> + (case (CExpr_Case _exprIself _altsIself _dfltIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIffeBinds,_errorExprIfvS,_errorExprIself) -> + (case (_errorExprIffeBinds) of + { _lhsOffeBinds -> + (case (_errorExprIfvS) of + { _lhsOfvS -> + (case (CExpr_CaseAltFail failReason_ _errorExprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (offset_) of + { ( _offsetIffeBinds,_offsetIfvS,_offsetIself) -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds ++ _offsetIffeBinds) of + { _lhsOffeBinds -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS -> + (case (CExpr_TupDel _exprIself tag_ nm_ _offsetIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIffeBinds,_fldExprIfvS,_fldExprIself) -> + (case (offset_) of + { ( _offsetIffeBinds,_offsetIfvS,_offsetIself) -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds ++ _offsetIffeBinds ++ _fldExprIffeBinds) of + { _lhsOffeBinds -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + (case (CExpr_TupIns _exprIself tag_ nm_ _offsetIself _fldExprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIffeBinds,_fldExprIfvS,_fldExprIself) -> + (case (offset_) of + { ( _offsetIffeBinds,_offsetIfvS,_offsetIself) -> + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds ++ _offsetIffeBinds ++ _fldExprIffeBinds) of + { _lhsOffeBinds -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + (case (CExpr_TupUpd _exprIself tag_ nm_ _offsetIself _fldExprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Dbg info_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_Hole uid_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (body_) of + { ( _bodyIffeBinds,_bodyIfvS,_bodyIself) -> + (case (_bodyIffeBinds) of + { _lhsOffeBinds -> + (case (_bodyIfvS) of + { _lhsOfvS -> + (case (CExpr_HoleLet bindsUid_ _bodyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case ([]) of + { _lhsOffeBinds -> + (case (Set.empty) of + { _lhsOfvS -> + (case (CExpr_CoeArg) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (func_) of + { ( _funcIffeBinds,_funcIfvS,_funcIself) -> + (case (_funcIffeBinds) of + { _lhsOffeBinds -> + (case (_funcIfvS) of + { _lhsOfvS -> + (case (CExpr_ImplsApp _funcIself uid_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (body_) of + { ( _bodyIffeBinds,_bodyIfvS,_bodyIself) -> + (case (_bodyIffeBinds) of + { _lhsOffeBinds -> + (case (_bodyIfvS) of + { _lhsOfvS -> + (case (CExpr_ImplsLam uid_ _bodyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds) of + { _lhsOffeBinds -> + (case (ann_) of + { ( _annIfvS,_annIself) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + (case (CExpr_Ann _annIself _exprIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOffeBinds,_lhsOfvS,_lhsOself) }) }) }) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local self : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local self : _ + alternative Debug: + child info : {String} + visit 0: + local self : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( FvS,CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CExprAnn_Ty ty_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CExprAnn_Coe coe_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CExprAnn_Debug info_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CMetaBind + alternatives: + alternative Plain: + visit 0: + local self : _ + alternative Function0: + visit 0: + local self : _ + alternative Function1: + visit 0: + local self : _ + alternative Apply0: + visit 0: + local self : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( FvS,CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaBind_Plain) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaBind_Function0) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaBind_Function1) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaBind_Apply0) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CMetaVal + alternatives: + alternative Val: + visit 0: + local self : _ + alternative Dict: + visit 0: + local self : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local self : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local self : _ + alternative Track: + child track : {Track} + visit 0: + local self : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( FvS,CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaVal_Val) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaVal_Dict) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaVal_DictClass tracks_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaVal_DictInstance tracks_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (Set.empty) of + { _lhsOfvS -> + (case (CMetaVal_Track track_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attributes: + fvS : FvS + self : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local self : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( FvS,CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2IfvS,_x2Iself) -> + (case (x1_) of + { ( _x1IfvS,_x1Iself) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS -> + (case ((_x1Iself,_x2Iself)) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOself) }) }) }) }) }) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + ffeBinds : [ExtractFFE] + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( ([ExtractFFE]),FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (expr_) of + { ( _exprIffeBinds,_exprIfvS,_exprIself) -> + (case (_exprIffeBinds) of + { _lhsOffeBinds -> + (case (_exprIfvS) of + { _lhsOfvS -> + ( _lhsOffeBinds,_lhsOfvS) }) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + self : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local self : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local self : _ + alternative Int: + child int : {Int} + visit 0: + local self : _ + alternative Char: + child char : {Char} + visit 0: + local self : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local self : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( ([HsName]),FvS,([HsName]),CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([pnm_]) of + { _lhsOnmL -> + (case (CPat_Var pnm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIfldNmL,_bindsIfvS,_bindsInmL,_bindsIself) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (rest_) of + { ( _restIfvS,_restInmL,_restIself) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL -> + (case (CPat_Con tag_ _restIself _bindsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case (CPat_Int int_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case (CPat_Char char_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case (CPat_BoolExpr cexpr_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + self : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local self : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( ([HsName]),FvS,([HsName]),CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (bind_) of + { ( _bindIffeBinds,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL,_bindIself) -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (fldAnns_) of + { ( _fldAnnsIfvS,_fldAnnsInmL,_fldAnnsIself) -> + (case (offset_) of + { ( _offsetIffeBinds,_offsetIfvS,_offsetIself) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS -> + (case ([_fldNm]) of + { _lhsOnmL -> + (case (CPatFld_Fld lbl_ _offsetIself _bindIself _fldAnnsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + self : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( ([HsName]),FvS,([HsName]),CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfldNmL,_tlIfvS,_tlInmL,_tlIself) -> + (case (hd_) of + { ( _hdIfldNmL,_hdIfvS,_hdInmL,_hdIself) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + (case ((:) _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case ([]) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + self : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local self : _ + alternative Empty: + visit 0: + local self : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( FvS,([HsName]),CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (Set.empty) of + { _lhsOfvS -> + (case ([nm_]) of + { _lhsOnmL -> + (case (CPatRest_Var nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + (case (CPatRest_Empty) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOfvS,_lhsOnmL,_lhsOself) }) }) }) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + ffeBinds : [ExtractFFE] + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( ([ExtractFFE])) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {ffeBinds_Syn_CodeAGItf :: !(([ExtractFFE]))} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOffeBinds) = sem + in (Syn_CodeAGItf _lhsOffeBinds)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (module_) of + { ( _moduleIffeBinds,_moduleIfvS) -> + (case (_moduleIffeBinds) of + { _lhsOffeBinds -> + ( _lhsOffeBinds) }) }) diff --git a/src/UHC/Light/Compiler/Core/FFI.hs b/src/UHC/Light/Compiler/Core/FFI.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/FFI.hs @@ -0,0 +1,283 @@ +module UHC.Light.Compiler.Core.FFI +( tyNmFFIBoxBasicAnnot +, tyNmGBMayLiveAsTaggedPtr, tyNmGBTagPtrBasicAnnot +, ffiMkArgUnpack +, ffiMkResPack +, ffiEvalAdapt +, ffiCoreEvalAdapt +, ffiCoreMk +, ffeCoreMk +, ffiMbIORes +, ffiIOAdapt +, ffiCoreIOAdapt ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import qualified Data.Map as Map +import Data.List +import Data.Maybe +import UHC.Light.Compiler.CodeGen.BasicAnnot +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Utils +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.Foreign.Boxing +import UHC.Light.Compiler.CodeGen.BuiltinPrims + + + + + +{-# LINE 39 "src/ehc/Core/FFI.chs" #-} +-- | is ty going to be passed unboxed to ffi, return info about it if so? +tyNmFFIBoxBasicAnnot :: EHCOpts -> HsName -> Maybe BasicAnnot +tyNmFFIBoxBasicAnnot opts + = const Nothing + +{-# LINE 55 "src/ehc/Core/FFI.chs" #-} +-- | is ty living as a tagged pointer? +tyNmGBMayLiveAsTaggedPtr :: EHCOpts -> HsName -> Maybe BuiltinInfo +tyNmGBMayLiveAsTaggedPtr opts + | otherwise = const Nothing + +-- | BasicAnnot when unboxing also means living as tagged pointer +tyNmGBTagPtrBasicAnnot :: EHCOpts -> Bool -> HsName -> BasicAnnot -> BasicAnnot +tyNmGBTagPtrBasicAnnot opts box t annot + = case tyNmGBMayLiveAsTaggedPtr opts t of + Just x + | otherwise -> annot + Nothing -> annot + +{-# LINE 80 "src/ehc/Core/FFI.chs" #-} +-- | make argument, i.e. wrap given argument name in proper introduction with annotation about what it is +ffiMkArgUnpack + :: EHCOpts + -> DataGam + -> (HsName -> BasicAnnot -> HsName -> intro) -- make intro: node around basic type + -> (HsName -> HsName -> intro) -- make intro: enum + -> (HsName -> HsName -> intro) -- make intro: var + -> (HsName -> HsName -> intro) -- make intro: opaque + -> (HsName -> HsName -> intro) -- make intro: pointer + -> HsName -- arg name + -> Ty -- its type + -> intro +ffiMkArgUnpack + opts dataGam + mkNodeI mkEnumI mkVarI mkOpaqI mkPtrI + argNm ty + = mk + where tyNm = tyAppFunConNm ty + mbAnn = tyNmFFIBoxBasicAnnot opts tyNm + mk | isJust mbAnn = mkNodeI tyNm (tyNmGBTagPtrBasicAnnot opts False tyNm (fromJust mbAnn)) argNm + | tyNmIsFFIEnumable dataGam tyNm = mkEnumI tyNm argNm + | isJust (recMbRecRow ty) = mkVarI tyNm argNm + | tyNmIsFFIOpaque dataGam tyNm = mkOpaqI tyNm argNm + | otherwise = mkPtrI tyNm argNm + +{-# LINE 131 "src/ehc/Core/FFI.chs" #-} +-- | make result, i.e. wrap given argument name in proper adaption with annotation about what it is +-- Note: 0-tuple is assumed to be Enumerable (change this here, and in the RTS, if the 0-tuple is to be regarded as a basis for extensible rows) +ffiMkResPack + :: EHCOpts + -> DataGam + -> (BasicAnnot -> HsName -> intro) -- make intro: node around basic type + -> (HsName -> HsName -> intro) -- make intro: enum + -> (HsName -> intro) -- make intro: opaque + -> (HsName -> HsName -> intro) -- make intro: pointer + -> (e -> intro -> e -> e) -- make bind: let .. in + -> (Ty -> HsName -> HsName -> e) -- make expr: node + -> (Ty -> HsName -> HsName -> e) -- make expr: enum + -> (Ty -> HsName -> HsName -> e) -- make expr: opaq + -> (Ty -> HsName -> HsName -> e) -- make expr: ptr + -> HsName -- arg name + -> Ty -- its type + -> e -- res value + -> e +ffiMkResPack + opts dataGam + mkNodeI mkEnumI mkOpaqI mkPtrI + mkBindE + mkNodeE mkEnumE mkOpaqE mkPtrE + resNm resTy res + = mk + where resTyNm = tyAppFunConNm resTy + mbAnn = tyNmFFIBoxBasicAnnot opts resTyNm + mkE e = e resTy resTyNm resNm + mk | isJust mbAnn = mkBindE res (mkNodeI (tyNmGBTagPtrBasicAnnot opts True resTyNm (fromJust mbAnn)) resNm) (mkE mkNodeE) + | tyNmIsFFIEnumable dataGam resTyNm = mkBindE res (mkEnumI resTyNm resNm) (mkE mkEnumE) + | isRec && arity == 0 = mkBindE res (mkEnumI recNm resNm) (mkE mkEnumE) + | isRec = mkBindE res (mkPtrI recNm resNm) (mkE mkPtrE ) + | tyNmIsFFIOpaque dataGam resTyNm = mkBindE res (mkOpaqI resNm) (mkE mkOpaqE) + | otherwise = mkBindE res (mkPtrI resTyNm resNm) (mkE mkPtrE ) + where isRec = isJust $ recMbRecRow resTy + arity = length $ snd $ tyRecExts resTy + recNm = builtinRecNm arity + +{-# LINE 273 "src/ehc/Core/FFI.chs" #-} +-- | is type an IO type, if so return the IO type argument (result returned by IO) +ffiMbIORes :: EHCOpts -> Ty -> Maybe Ty +ffiMbIORes opts resTy + = case appMbConApp resTy of + Just (n,[a]) | ehcOptBuiltin opts ehbnIO == n + -> Just a + _ -> Nothing + +{-# LINE 287 "src/ehc/Core/FFI.chs" #-} +-- | adapt type etc for IO ffi call +ffiIOAdapt + :: EHCOpts + -> (UID -> HsName) -- make unique name (if needed so) + -> (HsName -> Ty -> e -> e) -- handle unit result + -> (HsName -> Ty -> HsName -> Ty -> e -> e) -- make tupled result, for state representation + -> UID + -> Ty -- IO result type + -> ( [Ty] -- type of additional arguments + , [HsName] -- names of additional arguments + , e -> e -- wrapping/adaption of result + ) +ffiIOAdapt + opts + mkUniqNm + mkUnitRes + mkTupledRes + uniq iores + = ([tyState],[nmState],wrapRes) + where tyState = appCon $ ehcOptBuiltin opts ehbnRealWorld + [nmState,nmRes,nmIgnoreRes] = take 3 (map (mkUniqNm) (iterate uidNext uniq)) + wrapRes = mkTupledRes nmState (appDbg "ffiIOAdapt.mkTupledRes.state") nmRes (appDbg "ffiIOAdapt.mkTupledRes.res") . dealWithUnitRes + where dealWithUnitRes + = case tyMbRecExts iores of + Just (_,[]) -> mkUnitRes nmIgnoreRes (appDbg "ffiIOAdapt.mkUnitRes") + _ -> id + +{-# LINE 338 "src/ehc/Core/FFI.chs" #-} +-- | adapt type etc for IO ffi call, specialized for Core +ffiCoreIOAdapt + :: EHCOpts + -> UID + -> Ty -- IO result type + -> ([Ty],[HsName],CExpr -> CExpr) +ffiCoreIOAdapt + opts + uniq iores + = ffiIOAdapt + opts + mkHNm + (\ nmIgnoreRes ty r -> acoreLet1StrictTy nmIgnoreRes (SysF.ty2TyCforFFI opts ty) r $ acoreTup [] ) + (\nmState _ nmRes ty r -> acoreLet1StrictTy nmRes (SysF.ty2TyCforFFI opts ty) r $ acoreTup [acoreVar nmState,acoreVar nmRes]) + uniq iores + +{-# LINE 360 "src/ehc/Core/FFI.chs" #-} +-- | evaluate value etc for ffi call +ffiEvalAdapt + :: ((HsName,Ty,intro,Bool) -> e -> e) -- construct arg w.r.t. eval need, and bind to intro + -> ((HsName,Ty,e,Bool) -> e) -- construct result w.r.t. eval need + -> [(HsName,Ty,intro,Bool)] -- arg name + introduction + eval need + -> (HsName,Ty,e,Bool) -- result + -> e +ffiEvalAdapt + evalBindArg + evalRes + args + res + = foldr evalBindArg (evalRes res) args + +{-# LINE 390 "src/ehc/Core/FFI.chs" #-} +-- | evaluate value etc for ffi call, specialized for Core +ffiCoreEvalAdapt + :: EHCOpts + -> [(HsName,Ty,HsName,Bool)] -- arg name + introduction + eval need + -> (HsName,Ty,CExpr,Bool) -- result + -> CExpr +ffiCoreEvalAdapt opts + = ffiEvalAdapt + (\(n,ty,i,ev) e -> (if ev then acoreLet1StrictTy else acoreLet1PlainTy) i (SysF.ty2TyCforFFI opts ty) (acoreVar n) e) + (\(n,ty,e,ev) -> if ev then acoreLet1StrictTy n (SysF.ty2TyCforFFI opts ty) e (acoreVar n) else e ) + + +{-# LINE 408 "src/ehc/Core/FFI.chs" #-} +-- | Construct Core code for FFI +ffiCoreMk + :: EHCOpts + -> ( Ty -> CExpr -- make FFI call + ) + -> UID + -> RCEEnv + -> ForeignExtraction -- the ffi info + -> Ty -- original type signature of FFI + -> CExpr +ffiCoreMk + opts + (mkFFI) + uniq rceEnv + foreignEntInfo + tyFFI + = acoreLamTy (zip nmArgL (map (SysF.ty2TyCforFFI opts) argTyL) ++ zip nmArgLExtra (repeat $ acoreTyErr "ffiCoreMk.nmArgLExtra.TBD")) + $ ffiCoreEvalAdapt opts + ( zip4 nmArgL argTyL nmArgPatL primArgNeedsEvalL ) + ( nmEvalRes + , resTyAdapted + , wrapRes + $ acoreApp (mkFFI $ argTyL `appArr` resTyAdapted) + $ map acoreVar nmArgPatL + , primResNeedsEval + ) + where (argTyL,resTy) = appUnArr tyFFI + argLen = length argTyL + (_,u1,u2) = mkNewLevUID2 uniq + (nmRes:nmEvalRes:nmArgL) = take (argLen + 2) (map mkHNm (iterate uidNext u1)) + nmArgPatL = map (hsnUniqify HsNameUniqifier_FFIArg) nmArgL + (resTyAdapted,argTyLExtra,nmArgLExtra,wrapRes) + = + case ffiMbIORes opts resTy of + Just iores + -> (iores,a,n,w) + where (a,n,w) = ffiCoreIOAdapt opts u2 iores + _ -> + (resTy,[],[],id) + mbPrimNeedEval = maybe Nothing lookupPrimNeedsEval $ forextractMbEnt foreignEntInfo + primArgNeedsEvalL + = take argLen $ maybe (repeat True) (\p -> primArgNeedEval p ++ repeat True) mbPrimNeedEval + primResNeedsEval + = maybe False primResNeedEval mbPrimNeedEval + +{-# LINE 464 "src/ehc/Core/FFI.chs" #-} +-- | Construct Core code for FFE +ffeCoreMk + :: EHCOpts + -> UID + -> RCEEnv + -> Ty -- original type signature of FFE + -> ( CExpr -> CExpr -- ffe wrapper + , Ty -- corresponding type + ) +ffeCoreMk + opts uniq rceEnv + tyFFE + = ( \e -> + acoreLamTy (zipWith (\a t -> (a, SysF.ty2TyCforFFI opts t)) nmArgL argTyL) + $ acoreLet1StrictTy nmEvalRes (SysF.ty2TyCforFFI opts resTyAdapted) + (wrapRes $ acoreApp e $ map acoreVar nmArgL ++ argLExtra) + (acoreVar nmEvalRes) + , argTyL `appArr` resTyAdapted + ) + where (argTyL,resTy) = appUnArr tyFFE + argLen = length argTyL + (nmRes:nmEvalRes:nmIOEvalRes:nmArgL) = map mkHNm $ mkNewLevUIDL (argLen+3) uniq + (resTyAdapted,argLExtra,wrapRes) + = + case ffiMbIORes opts resTy of + Just iores + -> ( iores + , [acoreTup []] -- (), unit, the world + , \e -> acoreExprSatSelCaseTy rceEnv (Just (nmIOEvalRes,acoreTyErr "ffeCoreMk.wrapRes")) e CTagRec nmIOEvalRes 1 Nothing + ) + _ -> + (resTy,[],id) diff --git a/src/UHC/Light/Compiler/Core/FvS.hs b/src/UHC/Light/Compiler/Core/FvS.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/FvS.hs @@ -0,0 +1,1346 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/FvS.ag) +module UHC.Light.Compiler.Core.FvS(cexprFvS) where + +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty + + + + + + + +cexprFvS :: CExpr -> FvS +cexprFvS e + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf (mkCMod e))) Inh_CodeAGItf + in fvS_Syn_CodeAGItf t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( FvS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (expr_) of + { ( _exprIfvS) -> + (case (pat_) of + { ( _patIfldNmL,_patIfvS,_patInmL) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS) -> + (case (hd_) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ( FvS,FvSMp,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_ _bindAspectsOnm) of + { ( _bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp -> + (case (nm_) of + { _lhsOnm -> + (case ([nm_]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL) }) }) }) }) }) }) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS,_tlInmL) -> + (case (hd_) of + { ( _hdIfvS,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ( FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfvS,_tlIfvSMp,_tlInmL) -> + (case (hd_) of + { ( _hdIfvS,_hdIfvSMp,_hdInm,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = HsName -> + ( FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIfvS) -> + (case (bindMeta_) of + { ( _bindMetaIfvS) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsInm -> + (case (cmetas_) of + { ( _cmetasIfvS) -> + (case (_cmetasIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = HsName -> + ( FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsInm -> + (case (_lhsInm) of + { _tlOnm -> + (case (tl_ _tlOnm) of + { ( _tlIfvS,_tlIfvSMp,_tlInmL) -> + (case (_lhsInm) of + { _hdOnm -> + (case (hd_ _hdOnm) of + { ( _hdIfvS,_hdIfvSMp,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( ) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + ( ) +-- CDataConL --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( ) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + ( ) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + ( ) +-- CDeclMeta --------------------------------------------------- +{- + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + ( ) +-- CDeclMetaL -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + ( ) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + ( ) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative String: + child str : {String} + alternative Integer: + child integer : {Integer} + alternative Tup: + child tag : {CTag} + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local fvS : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local fvS : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + local fvS : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + alternative Dbg: + child info : {String} + alternative Hole: + child uid : {UID} + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + alternative CoeArg: + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + alternative Ann: + child ann : CExprAnn + child expr : CExpr +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( FvS) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (acbrefNm ref_) of + { _nm -> + (case (Set.singleton _nm) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIfvS) -> + (case (binds_) of + { ( _bindsIfvS,_bindsIfvSMp,_bindsInmL) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (hsnUnknown) of + { _argOnm -> + (case (arg_ _argOnm) of + { ( _argIfvS,_argIfvSMp,_argInmL) -> + (case (func_) of + { ( _funcIfvS) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (bind_) of + { ( _bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) -> + (case (_bindInm) of + { _argNm -> + (case (body_) of + { ( _bodyIfvS) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (dflt_) of + { ( _dfltIfvS) -> + (case (alts_) of + { ( _altsIfvS) -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIfvS) -> + (case (_errorExprIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (offset_) of + { ( _offsetIfvS) -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIfvS) -> + (case (offset_) of + { ( _offsetIfvS) -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIfvS) -> + (case (offset_) of + { ( _offsetIfvS) -> + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (body_) of + { ( _bodyIfvS) -> + (case (_bodyIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (func_) of + { ( _funcIfvS) -> + (case (_funcIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (body_) of + { ( _bodyIfvS) -> + (case (_bodyIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIfvS) -> + (case (ann_) of + { ( _annIfvS) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + alternative Coe: + child coe : {RelevCoe} + alternative Debug: + child info : {String} +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Plain: + alternative Function0: + alternative Function1: + alternative Apply0: +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Val: + alternative Dict: + alternative DictClass: + child tracks : {[Track]} + alternative DictInstance: + child tracks : {[Track]} + alternative Track: + child track : {Track} +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( FvS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( FvS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2IfvS) -> + (case (x1_) of + { ( _x1IfvS) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (expr_) of + { ( _exprIfvS) -> + (case (_exprIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( ([HsName]),FvS,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([pnm_]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIfldNmL,_bindsIfvS,_bindsInmL) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (rest_) of + { ( _restIfvS,_restInmL) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( ([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (bind_) of + { ( _bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (fldAnns_) of + { ( _fldAnnsIfvS,_fldAnnsInmL) -> + (case (offset_) of + { ( _offsetIfvS) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS -> + (case ([_fldNm]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( ([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfldNmL,_tlIfvS,_tlInmL) -> + (case (hd_) of + { ( _hdIfldNmL,_hdIfvS,_hdInmL) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (Set.empty) of + { _lhsOfvS -> + (case ([nm_]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + fvS : FvS + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( FvS) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {fvS_Syn_CodeAGItf :: !(FvS)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOfvS) = sem + in (Syn_CodeAGItf _lhsOfvS)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (module_) of + { ( _moduleIfvS) -> + (case (_moduleIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) diff --git a/src/UHC/Light/Compiler/Core/Merge.hs b/src/UHC/Light/Compiler/Core/Merge.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Merge.hs @@ -0,0 +1,68 @@ +module UHC.Light.Compiler.Core.Merge +( cModMerge ) +where +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core hiding (cModMerge) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Module.Merge +import Data.List +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.Utils +import Control.Monad.Identity +import Control.Monad.State +import Data.Array +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Core.FvS +import UHC.Light.Compiler.Core.ModAsMap +import UHC.Light.Compiler.Core.ExtractFFE + + +{-# LINE 45 "src/ehc/Core/Merge.chs" #-} +instance ModPuller + CModule + (CModuleDatabase, Map.Map HsName CModuleDatabase) + (HsName,CImportL,CDeclMetaL) + CModule CExpr CBindCateg CBind + where + mpullSplit mmain@(CModule_Mod modNm _ _ _) mimpL = + ( cmoddbMainExpr modDbMain + , + Just (CBindCateg_FFE, [ (effeBind e, effeFvS e) | m <- mmain : mimpL, e <- cmodExtractFFE m ]) + , ( modDbMain + , Map.unions [ Map.singleton (cmoddbModNm db) db | db <- modDbMain : modDbImp ] + ) + , ( modNm + , Set.toList $ Set.fromList $ concatMap cmoddbImports $ modDbMain : modDbImp + , concatMap cmoddbMeta $ modDbMain : modDbImp + ) ) + where modDbMain = cexprModAsDatabase mmain + modDbImp = map cexprModAsDatabase mimpL + modDbMp = Map.unions [ Map.singleton (cmoddbModNm db) db | db <- modDbMain : modDbImp ] + + mpullUsedBindings n (modDbMain,modDbMp) = return $ do + db <- maybe (Just modDbMain) (\m -> Map.lookup m modDbMp) $ hsnQualifier n + (bi,_) <- cmoddbLookup n db + let (cat,bsarr) = cmoddbBindArr db ! bi + bs = elems bsarr + return + ( cat, bs + , Set.fromList $ map cbindNm bs + ) + + mpullRelevantExprs = cbindExprs + + mpullFreeVars = cexprFvS + + mpullBindingsAddToMod (modNm,allImports,allMeta) rootExpr bs _ = CModule_Mod modNm allImports allMeta (acoreLetN bs $ rootExpr) + +{-# LINE 88 "src/ehc/Core/Merge.chs" #-} +-- | merge by pulling +cModMerge :: (CModule,[CModule]) -> CModule +cModMerge mods@(mmain,mimpL) + = mkM mmain + where (mkM,_) = modMergeByPullingIn mods + diff --git a/src/UHC/Light/Compiler/Core/ModAsMap.hs b/src/UHC/Light/Compiler/Core/ModAsMap.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/ModAsMap.hs @@ -0,0 +1,1647 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ModAsMap.) +module UHC.Light.Compiler.Core.ModAsMap(cexprModAsDatabase) where + +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Array +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty + + + + + + + + + + + +cexprModAsDatabase :: CModule -> CModuleDatabase +cexprModAsDatabase m + = db_Syn_CodeAGItf t + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf m)) Inh_CodeAGItf + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local copy : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (pat_) of + { ( _patIcopy) -> + (case (CAlt_Alt _patIcopy _exprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local copy : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ( CBind) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (case (bindAspects_) of + { ( _bindAspectsIcopy) -> + (case (CBind_Bind nm_ _bindAspectsIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local copy : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (CBindAnn_Coe coe_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + copy : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CBound ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + copy : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local copy : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local copy : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local copy : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local copy : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local copy : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local copy : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = ( CBound) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (bindMeta_) of + { ( _bindMetaIcopy) -> + (case (CBound_Bind _bindMetaIcopy _exprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (case (cmetas_) of + { ( _cmetasIcopy) -> + (case (CBound_Meta aspectKeyS_ _cmetasIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (case (CBound_Ty aspectKeyS_ ty_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CBound_FFE callconv_ expEnt_ _exprIcopy ty_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local copy : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local copy : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcopy) -> + (case (CDeclMeta_Data tyNm_ _dataConsIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + bindSq : Seq.Seq CDbBindLetInfo + copy : CExpr + expr : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local copy : _ + alternative Int: + child int : {Int} + visit 0: + local copy : _ + alternative Char: + child char : {Char} + visit 0: + local copy : _ + alternative String: + child str : {String} + visit 0: + local copy : _ + alternative Integer: + child integer : {Integer} + visit 0: + local copy : _ + alternative Tup: + child tag : {CTag} + visit 0: + local copy : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local copy : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local copy : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local copy : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local copy : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local copy : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local copy : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local copy : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local copy : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local copy : _ + alternative Dbg: + child info : {String} + visit 0: + local copy : _ + alternative Hole: + child uid : {UID} + visit 0: + local copy : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local copy : _ + alternative CoeArg: + visit 0: + local copy : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local copy : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local copy : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local copy : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( (Seq.Seq CDbBindLetInfo),CExpr,CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Var ref_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Int int_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Char char_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_String str_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Integer integer_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Tup tag_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIbindSq,_bodyIcopy,_bodyIexpr) -> + (case (binds_) of + { ( _bindsIcopy) -> + (case (Seq.singleton (categ_,_bindsIcopy) `Seq.union` _bodyIbindSq) of + { _lhsObindSq -> + (case (CExpr_Let categ_ _bindsIcopy _bodyIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_bodyIexpr) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (arg_) of + { ( _argIcopy) -> + (case (func_) of + { ( _funcIbindSq,_funcIcopy,_funcIexpr) -> + (case (CExpr_App _funcIcopy _argIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (body_) of + { ( _bodyIbindSq,_bodyIcopy,_bodyIexpr) -> + (case (bind_) of + { ( _bindIcopy) -> + (case (CExpr_Lam _bindIcopy _bodyIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (dflt_) of + { ( _dfltIbindSq,_dfltIcopy,_dfltIexpr) -> + (case (alts_) of + { ( _altsIcopy) -> + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CExpr_Case _exprIcopy _altsIcopy _dfltIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (errorExpr_) of + { ( _errorExprIbindSq,_errorExprIcopy,_errorExprIexpr) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (offset_) of + { ( _offsetIbindSq,_offsetIcopy,_offsetIexpr) -> + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CExpr_TupDel _exprIcopy tag_ nm_ _offsetIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (fldExpr_) of + { ( _fldExprIbindSq,_fldExprIcopy,_fldExprIexpr) -> + (case (offset_) of + { ( _offsetIbindSq,_offsetIcopy,_offsetIexpr) -> + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CExpr_TupIns _exprIcopy tag_ nm_ _offsetIcopy _fldExprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (fldExpr_) of + { ( _fldExprIbindSq,_fldExprIcopy,_fldExprIexpr) -> + (case (offset_) of + { ( _offsetIbindSq,_offsetIcopy,_offsetIexpr) -> + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (CExpr_TupUpd _exprIcopy tag_ nm_ _offsetIcopy _fldExprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Dbg info_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_Hole uid_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (body_) of + { ( _bodyIbindSq,_bodyIcopy,_bodyIexpr) -> + (case (CExpr_HoleLet bindsUid_ _bodyIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (Seq.empty) of + { _lhsObindSq -> + (case (CExpr_CoeArg) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (func_) of + { ( _funcIbindSq,_funcIcopy,_funcIexpr) -> + (case (CExpr_ImplsApp _funcIcopy uid_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (body_) of + { ( _bodyIbindSq,_bodyIcopy,_bodyIexpr) -> + (case (CExpr_ImplsLam uid_ _bodyIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (Seq.empty) of + { _lhsObindSq -> + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (ann_) of + { ( _annIcopy) -> + (case (CExpr_Ann _annIcopy _exprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (_copy) of + { _lhsOexpr -> + ( _lhsObindSq,_lhsOcopy,_lhsOexpr) }) }) }) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local copy : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local copy : _ + alternative Debug: + child info : {String} + visit 0: + local copy : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (CExprAnn_Ty ty_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (CExprAnn_Coe coe_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (CExprAnn_Debug info_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local copy : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CMetaBind + alternatives: + alternative Plain: + visit 0: + local copy : _ + alternative Function0: + visit 0: + local copy : _ + alternative Function1: + visit 0: + local copy : _ + alternative Apply0: + visit 0: + local copy : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (CMetaBind_Plain) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (CMetaBind_Function0) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (CMetaBind_Function1) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (CMetaBind_Apply0) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CMetaVal + alternatives: + alternative Val: + visit 0: + local copy : _ + alternative Dict: + visit 0: + local copy : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local copy : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local copy : _ + alternative Track: + child track : {Track} + visit 0: + local copy : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (CMetaVal_Val) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (CMetaVal_Dict) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (CMetaVal_DictClass tracks_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (CMetaVal_DictInstance tracks_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (CMetaVal_Track track_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + copy : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local copy : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2Icopy) -> + (case (x1_) of + { ( _x1Icopy) -> + (case ((_x1Icopy,_x2Icopy)) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + copy : CModule + db : CModuleDatabase + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local copy : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( CModule,CModuleDatabase) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (expr_) of + { ( _exprIbindSq,_exprIcopy,_exprIexpr) -> + (case (declMetas_) of + { ( _declMetasIcopy) -> + (case (imports_) of + { ( _importsIcopy) -> + (case (CModule_Mod moduleNm_ _importsIcopy _declMetasIcopy _exprIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + (case (let binds = Seq.toList _exprIbindSq + nrBinds = length binds + (refs,arrs) + = unzip + [ (Map.unions refs, (cat, listArray (0, nrSubBinds-1) bs)) + | (bi,(cat,bs)) <- zip [0 .. nrBinds-1] binds + , let nrSubBinds = length bs + , let refs = zipWith (\b i -> Map.singleton (cbindNm b) (bi,i)) bs [0 .. nrSubBinds-1] + ] + in emptyCModuleDatabase + { cmoddbModNm = moduleNm_ + , cmoddbBindMp = Map.unions refs + , cmoddbBindArr = listArray (0, nrBinds-1) arrs + , cmoddbMainExpr = _exprIexpr + , cmoddbImports = _importsIcopy + , cmoddbMeta = _declMetasIcopy + }) of + { _lhsOdb -> + ( _lhsOcopy,_lhsOdb) }) }) }) }) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local copy : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local copy : _ + alternative Int: + child int : {Int} + visit 0: + local copy : _ + alternative Char: + child char : {Char} + visit 0: + local copy : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local copy : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case (CPat_Var pnm_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIcopy) -> + (case (rest_) of + { ( _restIcopy) -> + (case (CPat_Con tag_ _restIcopy _bindsIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case (CPat_Int int_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case (CPat_Char char_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case (CPat_BoolExpr cexpr_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local copy : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (fldAnns_) of + { ( _fldAnnsIcopy) -> + (case (bind_) of + { ( _bindIcopy) -> + (case (offset_) of + { ( _offsetIbindSq,_offsetIcopy,_offsetIexpr) -> + (case (CPatFld_Fld lbl_ _offsetIcopy _bindIcopy _fldAnnsIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local copy : _ + alternative Nil: + visit 0: + local copy : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcopy) -> + (case (hd_) of + { ( _hdIcopy) -> + (case ((:) _hdIcopy _tlIcopy) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + copy : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local copy : _ + alternative Empty: + visit 0: + local copy : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (CPatRest_Var nm_) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (CPatRest_Empty) of + { _copy -> + (case (_copy) of + { _lhsOcopy -> + ( _lhsOcopy) }) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + db : CModuleDatabase + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModuleDatabase) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {db_Syn_CodeAGItf :: !(CModuleDatabase)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOdb) = sem + in (Syn_CodeAGItf _lhsOdb)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (module_) of + { ( _moduleIcopy,_moduleIdb) -> + (case (_moduleIdb) of + { _lhsOdb -> + ( _lhsOdb) }) }) diff --git a/src/UHC/Light/Compiler/Core/Parser.hs b/src/UHC/Light/Compiler/Core/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Parser.hs @@ -0,0 +1,254 @@ +module UHC.Light.Compiler.Core.Parser +( pCModule, pCExpr ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Scanner.Scanner +import UU.Parsing as P +import UHC.Util.ParseUtils +import UHC.Light.Compiler.Base.Parser +import UHC.Light.Compiler.Ty.Parser +import Data.Maybe +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Foreign.Parser + + +{-# LINE 31 "src/ehc/Core/Parser.chs" #-} +type CParser hp = PlainParser Token hp + +pS :: CParser String +pS = pStr + +{-# LINE 38 "src/ehc/Core/Parser.chs" #-} +pINT , + pINTEGER , + pCHAR + :: CParser HsName +pINT = tokMkQName <$> pKeyTk "Int" -- pKeywHsNname hsnInt +pCHAR = tokMkQName <$> pKeyTk "Char" -- pKeywHsNname hsnChar +pINTEGER = tokMkQName <$> pKeyTk "Integer" -- pKeywHsNname hsnInteger + +pCTy :: CParser Ty +pCTy + = pTy' ( pDollNm <|> pINT <|> pCHAR + <|> pINTEGER + ) + +{-# LINE 60 "src/ehc/Core/Parser.chs" #-} +pCModule :: CParser CModule +pCModule + = (\m mt e -> CModule_Mod m mt e) + <$ pMODULE <*> pDollNm <* pSEMI + <*> pI + <*> pM + <*> pCExpr -- <*> pA (pA pCTag) + where -- pA pE = pOCURLY *> pListSep pSEMI ((,) <$> pDollNm <* pEQUAL <*> pE) <* pCCURLY + pM = pList pCDeclMeta -- pMaybe [] id $ pOCURLY *> pListSep pSEMI pCDeclMeta <* pCCURLY + pI = pList pCImport + +pCImport :: CParser CImport +pCImport + = CImport_Import <$ pIMPORT <*> pDollNm <* pSEMI + +pCDeclMeta :: CParser CDeclMeta +pCDeclMeta + = CDeclMeta_Data <$ pDATA <*> pDollNm <* pEQUAL <*> pListSep pCOMMA pCDataCon <* pSEMI + +pCDataCon :: CParser CDataCon +pCDataCon = CDataCon_Con <$> pDollNm <* pEQUAL <* pOCURLY <*> pInt <* pCOMMA <*> pInt <* pCCURLY + +pCTagTag :: CParser CTag +pCTagTag = pKeyTk "Tag" *> pCTag + +pCTagOnly :: CParser CTag +pCTagOnly = pHASH *> pCTagTag + +pCNumber :: CParser CExpr +pCNumber + = pHASH + *> ( ( (CExpr_Int . read) <$ pINT + <|> (CExpr_Char . head) <$ pCHAR + <|> (CExpr_String ) <$ pKeyTk "String" + <|> (CExpr_Integer . read) <$ pINTEGER + ) + <*> (tokMkStr <$> pStringTk) + <|> CExpr_Tup <$ pKeyTk "Tag" <*> pCTag + ) + +{- +pCExprAnn :: CParser (CExpr -> CExpr) +pCExprAnn + = CExpr_Ann + <$> (pDCOLON *> (CExprAnn_Ty <$> pTy) + ) + <|> pSucceed id +-} + +pCExprBase :: CParser CExpr +pCExprBase + = acoreVar <$> pDollNm + <|> pCNumber + <|> pOPAREN *> (pCExpr {- <**> pCExprAnn -}) <* pCPAREN + +{- +pCExprBaseMeta :: CParser (CExpr,CMetaVal) +pCExprBaseMeta + = (\v m -> (acoreVar v, m))<$> pDollNm <*> pCMetaValOpt + <|> (\n -> (n, CMetaVal_Val) ) <$> pCNumber + <|> pOPAREN *> pCExpr P.<+> pCMetaValOpt <* pCPAREN + +pCExprSelSuffix :: CParser (CExpr -> CExpr) +pCExprSelSuffix + = (\(t,o,l) e -> CExpr_TupDel e t l o ) <$ pKeyTk "-=" <*> pS + <|> (\(t,o,l) e' e -> CExpr_TupIns e t l o e') <$ pKeyTk "+=" <*> pS <*> pCExprBase + <|> (\(t,o,l) e' e -> CExpr_TupUpd e t l o e') <$ pKeyTk ":=" <*> pS <*> pCExprBase + where pS = (,,) <$ pOCURLY <*> pCTagOnly <* pCOMMA <*> pCExpr <* pCOMMA <*> pDollNm <* pCCURLY + +pCExprSelSuffixMeta :: CParser ((CExpr,CMetaVal) -> (CExpr,CMetaVal)) +pCExprSelSuffixMeta + = (\f (e,m) -> (f e,m)) <$> pCExprSelSuffix + +pCExprSelMeta :: CParser (CExpr,CMetaVal) +pCExprSelMeta = pCExprBaseMeta pCExprSelSuffixMeta +-} + +pCExprSel :: CParser CExpr +pCExprSel = pCExprBase -- pCExprSelSuffix + +pCExpr :: CParser CExpr +pCExpr +{- + = (\f as -> acoreApp f (map fst as)) + <$> pCExprSel <*> pList pCExprSelMeta +-} + = (\f as -> acoreApp f as) + <$> pCExprSel <*> pList pCExprSel -- pCExprSelMeta + <|> mkLam <$ pLAM <*> pList1 (pDollNm) <* pRARROW <*> pCExpr + <|> CExpr_Let <$ pLET <*> pMaybe CBindCateg_Plain id pCBindCateg <* pOCURLY <*> pListSep pSEMI pCBind <* pCCURLY <* pIN <*> pCExpr + <|> (\(c,_) s i t -> CExpr_FFI c s (mkImpEnt c i) t) + <$ pFOREIGN <* pOCURLY <*> pFFIWay <* pCOMMA <*> pS <* pCOMMA <*> pS <* pCOMMA <*> pTy <* pCCURLY + <|> CExpr_Case <$ pCASE <*> pCExpr <* pOF + <* pOCURLY <*> pListSep pSEMI pCAlt <* pCCURLY + <* pOCURLY <* pDEFAULT <*> {- pMb -} pCExpr <* pCCURLY + where pCBindCateg + = CBindCateg_Rec <$ pKeyTk "rec" + <|> CBindCateg_FFI <$ pFOREIGN + <|> CBindCateg_FFE <$ pKeyTk "foreignexport" + <|> CBindCateg_Strict <$ pBANG + -- mkLam = acoreLam -- not used to avoid spurious intro of error type info + mkLam as e = foldr (\n e -> CExpr_Lam (CBind_Bind n []) e) e as + mkEnt d c e = fst $ parseForeignEnt d c Nothing e + mkImpEnt c e = mkEnt ForeignDirection_Import c e + + +{- +pTrack :: CParser Track +pTrack = (\x -> TrackVarApply x []) <$> pDollNm -- TODO: this is just a mockup, should do real track parsing +-} + +{- +pMbDollNm :: CParser (Maybe HsName) +pMbDollNm + = f <$> pDollNm + where f n | isJust ms && m == "_" + = Nothing + where ms@(~(Just m)) = hsnMbBaseString n + f x = Just x + +pManyDollNm :: CParser [HsName] +pManyDollNm + = f <$> pList pDollNm + where -- for backward compatibility with libraries created before 20090917 + f [n] | isJust ms && m == "_" + = [] + where ms@(~(Just m)) = hsnMbBaseString n + f ns = ns +-} + +{- +pCMetas :: CParser CMetas +pCMetas + = (,) <$ pOCURLY <*> pCMetaBind <* pCOMMA <*> pCMetaVal <* pCCURLY + +pCMetasOpt :: CParser CMetas +pCMetasOpt + = pMaybe cmetasDefault id pCMetas + +pCMetaBind :: CParser CMetaBind +pCMetaBind + = CMetaBind_Plain <$ pKeyTk "BINDPLAIN" + <|> CMetaBind_Function0 <$ pKeyTk "BINDFUNCTION0" + <|> CMetaBind_Function1 <$ pKeyTk "BINDFUNCTION1" + <|> CMetaBind_Apply0 <$ pKeyTk "BINDAPPLY0" + +pCMetaVal :: CParser CMetaVal +pCMetaVal + = CMetaVal_Val <$ pKeyTk "VAL" + <|> CMetaVal_Dict <$ pKeyTk "DICT" + <|> CMetaVal_DictClass <$ pKeyTk "DICTCLASS" <* pOCURLY <*> pListSep pCOMMA pTrack <* pCCURLY + <|> CMetaVal_DictInstance <$ pKeyTk "DICTINSTANCE" <* pOCURLY <*> pList1Sep pCOMMA pTrack <* pCCURLY + -- TODO: parse Track + +pCMetaValOpt :: CParser CMetaVal +pCMetaValOpt + = pMaybe CMetaVal_Val id (pCOLON *> pCMetaVal) +-} + +pCBound :: CParser CBound +pCBound + = CBound_Bind cmetasDefault <$> pCExpr + +pCBind :: CParser CBind +pCBind + = (\n b -> CBind_Bind n [b]) <$> pDollNm <* pEQUAL <*> pCBound + +{- +-- 20100806 AD: due to intro of CBound not consistent with pretty printing anymore, just patched it to have it compiled +pCBind :: CParser CBind +pCBind + = ( (pDollNm P.<+> pCMetasOpt) <* pEQUAL) + <**> ( (\e (n,m) -> CBind_Bind n [CBound_Bind m e]) <$> pCExpr + <|> (\(c,_) s i t (n,m) -> CBind_Bind n [CBound_Bind m $ CExpr_FFI c s (mkImpEnt c i) t]) + <$ pFOREIGN <* pOCURLY <*> pFFIWay <* pCOMMA <*> pS <* pCOMMA <*> pS <* pCOMMA <*> pTy <* pCCURLY + <|> (\(c,_) e en t (n,m) -> CBind_Bind n [CBound_FFE c (mkEnt ForeignDirection_Export c e) en t]) + <$ pKeyTk "foreignexport" <* pOCURLY <*> pFFIWay <* pCOMMA <*> pS <* pCOMMA <*> pCExpr {- pDollNm -} <* pCOMMA <*> pTy <* pCCURLY + ) + where pS = tokMkStr <$> pStringTk + mkEnt d c e = fst $ parseForeignEnt d c Nothing e + mkImpEnt c e = mkEnt ForeignDirection_Import c e +-} + +pCAlt :: CParser CAlt +pCAlt + = (\p e -> CAlt_Alt p e) <$> pCPat <* pRARROW <*> pCExpr + +pCPat :: CParser CPat +pCPat + = pHASH + *> ( ( (CPat_Int . read) <$ pINT + <|> (CPat_Char . head) <$ pCHAR + ) + <*> (tokMkStr <$> pStringTk) + -- <|> (\t r fs -> CPat_Con t r $ zipWith (\o (mf,n) -> acorePatFldTy (acoreTyErr "pCPatFld") (maybe (n, CExpr_Int o) id mf) n) [0..] fs) -- TODO, use refGen instead of baked in 0.. ... + <|> + -- TODO, use refGen instead of baked in 0.. ... + (\t r fs -> CPat_Con t r $ zipWith (\o (mf,n) -> let (lbl',o') = fromMaybe (n, CExpr_Int o) mf + in CPatFld_Fld lbl' o' (CBind_Bind n []) []) [0..] fs) + <$> pCTagTag + <* pOCURLY <*> pCPatRest <*> pListSep pCOMMA pCPatFld <* pCCURLY + ) + <|> CPat_Var <$> pDollNm + where -- pRPatNm = RPatNmOrig <$> pDollNm <|> RPatNmUniq <$ pKeyTk "uniq" <*> pDollNm + pCPatRest = pMaybe CPatRest_Empty CPatRest_Var (pDollNm <* pVBAR) + +-- pCPatFld :: CParser CPatFld +pCPatFld :: CParser (Maybe (HsName,CExpr),HsName) +pCPatFld + -- = (\l o n -> CPatFld_Fld l o n []) <$ pOCURLY <*> pDollNm <* pCOMMA <*> pCExpr <* pCCURLY <* pEQUAL <*> pCBind -- pCPat + -- = (\l o n -> acorePatFldTy (acoreTyErr "pCPatFld") (l, o) n) <$ pOCURLY <*> pDollNm <* pCOMMA <*> pCExpr <* pCCURLY <* pEQUAL <*> pDollNm -- pCPat + = pLblOff <+> pDollNm -- pCPat + where pLblOff = pMb $ (,) <$ pOCURLY <*> pDollNm <* pCOMMA <*> pCExpr <* pCCURLY <* pEQUAL diff --git a/src/UHC/Light/Compiler/Core/Pretty.hs b/src/UHC/Light/Compiler/Core/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Pretty.hs @@ -0,0 +1,3059 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Pretty.ag) +module UHC.Light.Compiler.Core.Pretty(ppCModule +, ppCBindL) where + +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.CfgPP +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Scanner.Common(coreScanOpts) +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.AnaDomain.Pretty +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.Foreign.Pretty + + + + + + + + + + + + +ppCModule :: EHCOpts -> {- LamMp -> -} CModule -> PP_Doc +ppCModule opts {- lamMp -} cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { {- lamMp_Inh_CodeAGItf = lamMp + , -} opts_Inh_CodeAGItf = opts + }) + in (pp_Syn_CodeAGItf t) + +ppCExpr :: CExpr -> PP_Doc +ppCExpr ce + = let t = wrap_CExpr (sem_CExpr ce) + (Inh_CExpr + { varPPMp_Inh_CExpr = Map.empty + -- , lamMp_Inh_CExpr = Map.empty + , ppHow_Inh_CExpr = howHor + , opts_Inh_CExpr = emptyEHCOpts + , mlev_Inh_CExpr = metaLevVal + }) + in (pp_Syn_CExpr t) + +ppCBound :: CBound -> PP_Doc +ppCBound ce + = let t = wrap_CBound (sem_CBound ce) + (Inh_CBound + { varPPMp_Inh_CBound = Map.empty + -- , lamMp_Inh_CBound = Map.empty + , ppHow_Inh_CBound = howHor + , opts_Inh_CBound = emptyEHCOpts + , nm_Inh_CBound = hsnUnknown + , minMetaLev_Inh_CBound = metaLevVal -- gathMinMetaLev_Syn_CBound t + , mlev_Inh_CBound = metaLevVal -- gathMinMetaLev_Syn_CBound t + }) + in (pp_Syn_CBound t) + +instance PP CBound where + pp = ppCBound + +instance PP CExpr where + pp = ppCExpr + + + +ppCNm :: HsName -> PP_Doc +ppCNm = cfgppHsName CfgPP_Core + + + +ppTrack :: Track -> PP_Doc +ppTrack t = text (show t) + +ppHole :: UID -> PP_Doc +ppHole i = "<" >|< pp i >|< ">" + + + +ppSemi :: PP x => x -> PP_Doc +ppSemi = (>|< ";") + + + +ppOptCMetas :: CMetas -> PP_Doc +ppOptCMetas x + = let t = wrap_CMetas (sem_CMetas x) + (Inh_CMetas + { {- lamMp_Inh_CMetas = Map.empty + , -} opts_Inh_CMetas = emptyEHCOpts + , mlev_Inh_CMetas = metaLevVal + }) + in (pp_Syn_CMetas t) + + + +ehcOptDumpMore :: EHCOpts -> Bool +ehcOptDumpMore opts = CoreOpt_DumpAlsoNonParseable `elem` ehcOptCoreOpts opts + +alsoMore :: EHCOpts -> (PP_Doc -> PP_Doc) -> PP_Doc -> PP_Doc +alsoMore opts mk + | ehcOptDumpMore opts = mk + | otherwise = id + +whenMore :: EHCOpts -> PP_Doc -> PP_Doc +whenMore opts + | ehcOptDumpMore opts = id + | otherwise = const empty + + + +ppCBindL :: CBindL -> PP_Doc +ppCBindL + = ppAssocL + . map (\b -> case b of + CBind_Bind n [CBound_Bind m v] -> (n,v >|< ppOptCMetas m) + CBind_Bind n a -> (n, vlist a) + ) + + + + +ppSignedInt :: Int -> PP_Doc +ppSignedInt n = " " >#< show n + +ppDef :: (PP a, PP b) => a -> b -> PP_Doc +ppDef n v = n >-< indent 2 v + +ppDef' :: (PP a, PP b) => a -> b -> PP_Doc +ppDef' n v = ppOr (n >-< indent 2 v) (n >#< v) +-- ppDef' n v = ppDef n v + +ppOr :: (PP a, PP b) => a -> b -> PP_Doc +-- ppOr a b = join (a >//< b) +ppOr a b = pp a + +ppOr' :: (PP a, PP b) => a -> b -> PP_Doc +-- ppOr' a b = ppOr a b +ppOr' a b = pp a + +ppLit :: String -> String -> PP_Doc +ppLit kind val = "#" >|< kind >|< pp (show val) + +ppTag :: CTag -> PP_Doc +ppTag t + -- = ppCTag' CfgPP_Plain t + = ppCTag' CfgPP_Core t + +ppCurlyList :: (a -> PP_Doc) -> [a] -> PP_Doc +ppCurlyList pL xs = ppListSep "{ " " }" ", " $ map pL xs + + + + +type CmbPP = PP_Doc -> PP_Doc -> PP_Doc + +data HowPP + = HowPP + { howDef :: CmbPP + , howAside :: CmbPP + , howList :: [PP_Doc] -> PP_Doc + , howSep :: PP_Doc -> PP_Doc -> PP_Doc -> [PP_Doc] -> PP_Doc + } + +howVert = HowPP ppDef (>-<) vlist ppBlock +howHor = HowPP (>#<) (>#<) ppSpaces ppListSep + + + +-- | pp a CBound, for internal use here +ppBound :: EHCOpts -> Bool -> Maybe String -> String -> PP_Doc -> PP_Doc +ppBound opts isSingleNoNm mbLev s pv + = lev $ sep (pp s) pv + where sep | isSingleNoNm = flip const + | otherwise = (>#<) + lev | ehcOptDumpMore opts = maybe id (>#<) mbLev + | otherwise = id + + + +type PPBindInfo + = ( String -- separator + , Bool -- outside parenthesization required + , PP_Doc -- actual payload + ) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _patOvarPPMp -> + (case (_lhsIppHow) of + { _patOppHow -> + (case (_lhsIopts) of + { _patOopts -> + (case (_lhsImlev) of + { _patOmlev -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (pat_ _patOmlev _patOopts _patOppHow _patOvarPPMp) of + { ( _patIfldNmL,_patIpp) -> + (case (howDef _lhsIppHow (_patIpp >#< "->") (_exprIpp)) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attribute: + mlev : MetaLev + synthesized attribute: + gathMinMetaLev : MetaLev + visit 1: + inherited attributes: + minMetaLev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + nm : HsName + pp : PP_Doc + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = MetaLev -> + ( MetaLev,T_CBind_1) +type T_CBind_1 = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( HsName,PP_Doc) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsImlev -> + (case (_lhsImlev) of + { _bindAspectsOmlev -> + (case (bindAspects_ _bindAspectsOmlev) of + { ( _bindAspectsIgathMinMetaLev,_bindAspectsIgathVarPPMp,bindAspects_1) -> + (case (_bindAspectsIgathMinMetaLev) of + { _lhsOgathMinMetaLev -> + (case ((let sem_CBind_Bind_1 :: T_CBind_1 + sem_CBind_Bind_1 = + (\ _lhsIminMetaLev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (nm_) of + { _lhsOnm -> + (case (_lhsIppHow) of + { _bindAspectsOppHow -> + (case (_lhsIopts) of + { _bindAspectsOopts -> + (case (_lhsIminMetaLev) of + { _bindAspectsOminMetaLev -> + (case (Map.union _bindAspectsIgathVarPPMp _lhsIvarPPMp) of + { _bindAspectsOvarPPMp -> + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_1 _bindAspectsOminMetaLev _bindAspectsOnm _bindAspectsOopts _bindAspectsOppHow _bindAspectsOvarPPMp) of + { ( _bindAspectsIpp,_bindAspectsIppBindInfoL,_bindAspectsIppL) -> + (case (let p [ ] = empty + p [a] = a + p as = ppCurlysSemisBlock as + par | or [ m | (_,m,_) <- _bindAspectsIppBindInfoL ] = ppParens + | otherwise = id + isSingleNoNm = hsnIsWild nm_ && length _bindAspectsIppBindInfoL == 1 + def | isSingleNoNm = par val + | otherwise = par $ howDef _lhsIppHow (ppCNm nm_) val + where val = p $ [ ppBound _lhsIopts isSingleNoNm Nothing s pv | (s,_,pv) <- _bindAspectsIppBindInfoL ] + in def) of + { _lhsOpp -> + ( _lhsOnm,_lhsOpp) }) }) }) }) }) }) }) })) + in sem_CBind_Bind_1)) of + { ( sem_CBind_1) -> + ( _lhsOgathMinMetaLev,sem_CBind_1) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local pp : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ("~" >#< ppRelevCoe _lhsIvarPPMp coe_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local minMetaLev : _ + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,([PP_Doc])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (hd_ _hdOmlev) of + { ( _hdIgathMinMetaLev,hd_1) -> + (case (_hdIgathMinMetaLev) of + { _minMetaLev -> + (case (_minMetaLev) of + { _hdOminMetaLev -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (hd_1 _hdOminMetaLev _hdOopts _hdOppHow _hdOvarPPMp) of + { ( _hdInm,_hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + mlev : MetaLev + synthesized attributes: + gathMinMetaLev : MetaLev + gathVarPPMp : VarPPMp + visit 1: + inherited attributes: + minMetaLev : MetaLev + nm : HsName + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppBindInfoL : [PPBindInfo] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local mlevHere : _ + visit 1: + local ppBound : _ + local pp : _ + local sep : _ + local mustPar : _ + intra mlevHere : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 1: + local ppBound : _ + local pp : _ + local sep : _ + local mustPar : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local _tup1 : _ + visit 1: + local tyPP : {PP_Doc} + local ppBound : _ + local pp : _ + local sep : _ + local mustPar : _ + intra _tup1 : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local mlevHere : _ + visit 1: + local ppHow : _ + local _tup2 : _ + local lev : _ + local sep : _ + local ppBound : _ + local pp : _ + local mustPar : _ + intra mlevHere : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local mlevHere : _ + visit 1: + local tyPP : {PP_Doc} + local ppBound : _ + local pp : _ + local sep : _ + local mustPar : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 1: + local ppBound : _ + local pp : _ + local sep : _ + local mustPar : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = MetaLev -> + ( MetaLev,VarPPMp,T_CBound_1) +type T_CBound_1 = MetaLev -> + HsName -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,([PPBindInfo])) +data Inh_CBound = Inh_CBound {minMetaLev_Inh_CBound :: !(MetaLev),mlev_Inh_CBound :: !(MetaLev),nm_Inh_CBound :: !(HsName),opts_Inh_CBound :: !(EHCOpts),ppHow_Inh_CBound :: !(HowPP),varPPMp_Inh_CBound :: !(VarPPMp)} +data Syn_CBound = Syn_CBound {gathMinMetaLev_Syn_CBound :: !(MetaLev),gathVarPPMp_Syn_CBound :: !(VarPPMp),pp_Syn_CBound :: !(PP_Doc),ppBindInfoL_Syn_CBound :: !(([PPBindInfo]))} +wrap_CBound :: T_CBound -> + Inh_CBound -> + Syn_CBound +wrap_CBound sem (Inh_CBound _lhsIminMetaLev _lhsImlev _lhsInm _lhsIopts _lhsIppHow _lhsIvarPPMp) = + (let ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_1) = sem _lhsImlev + ( _lhsOpp,_lhsOppBindInfoL) = sem_1 _lhsIminMetaLev _lhsInm _lhsIopts _lhsIppHow _lhsIvarPPMp + in (Syn_CBound _lhsOgathMinMetaLev _lhsOgathVarPPMp _lhsOpp _lhsOppBindInfoL)) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsImlev -> + (case (_lhsImlev + metaLevVal) of + { _mlevHere -> + (case (_mlevHere) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBound_Bind_1 :: T_CBound_1 + sem_CBound_Bind_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_mlevHere) of + { _exprOmlev -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (_lhsIopts) of + { _bindMetaOopts -> + (case (_lhsImlev) of + { _bindMetaOmlev -> + (case (bindMeta_ _bindMetaOmlev _bindMetaOopts) of + { ( _bindMetaIpp) -> + (case (whenMore _lhsIopts _bindMetaIpp >-< _exprIpp) of + { _ppBound -> + (case (_ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case ("=") of + { _sep -> + (case (False) of + { _mustPar -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Bind_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsImlev -> + (case (100) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBound_Meta_1 :: T_CBound_1 + sem_CBound_Meta_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIopts) of + { _cmetasOopts -> + (case (_lhsImlev) of + { _cmetasOmlev -> + (case (cmetas_ _cmetasOmlev _cmetasOopts) of + { ( _cmetasIpp) -> + (case (ppACBaspKeyS aspectKeyS_ >#< _cmetasIpp) of + { _ppBound -> + (case (_ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case ("::M") of + { _sep -> + (case (False) of + { _mustPar -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) })) + in sem_CBound_Meta_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsImlev -> + (case (100) of + { _lhsOgathMinMetaLev -> + (case (ppRelevTy Map.empty relevTy_) of + { __tup1 -> + (case (__tup1) of + { (_,_lhsOgathVarPPMp) -> + (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 + sem_CBound_RelevTy_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (__tup1) of + { (_tyPP,_) -> + (case (ppACBaspKeyS aspectKeyS_ >#< _tyPP) of + { _ppBound -> + (case (_ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case ("::R") of + { _sep -> + (case (False) of + { _mustPar -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) })) + in sem_CBound_RelevTy_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsImlev -> + (case (_lhsImlev + acbaspkeyMetaLev mlev_ aspectKeyS_) of + { _mlevHere -> + (case (_mlevHere) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBound_Val_1 :: T_CBound_1 + sem_CBound_Val_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (if _mlevHere == _lhsIminMetaLev then _lhsIppHow else howHor) of + { _ppHow -> + (case (_ppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_mlevHere) of + { _exprOmlev -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (let asp | Set.null aspectKeyS_ || ACoreBindAspectKey_Default `Set.member` aspectKeyS_ + = id + | otherwise = \x -> ppACBaspKeyS aspectKeyS_ >#< x + lbl | lbl_ == CLbl_None = id + | otherwise = \x -> lbl_ >#< "=" >#< x + in ( asp $ lbl _exprIpp + , "@" ++ show mlev_ + , not $ mlev_ == 0 && lbl_ == CLbl_None && Set.null aspectKeyS_ + )) of + { __tup2 -> + (case (__tup2) of + { (_,_lev,_) -> + (case ((if _mlevHere == _lhsIminMetaLev then "=" else "::") ++ (if _mlevHere > _lhsImlev then _lev else "")) of + { _sep -> + (case (__tup2) of + { (_ppBound,_,_) -> + (case (ppBound _lhsIopts True (Just _lev) _sep _ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (__tup2) of + { (_,_,_mustPar) -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Val_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsImlev -> + (case (_lhsImlev + acbaspkeyMetaLev metaLevTy aspectKeyS_) of + { _mlevHere -> + (case (_mlevHere) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBound_Ty_1 :: T_CBound_1 + sem_CBound_Ty_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (ppTyWithCfg' CfgPP_Core ty_) of + { _tyPP -> + (case (ppACBaspKeyS aspectKeyS_ >#< _tyPP) of + { _ppBound -> + (case (_ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case ("::") of + { _sep -> + (case (False) of + { _mustPar -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) })) + in sem_CBound_Ty_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsImlev -> + (case (100) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBound_FFE_1 :: T_CBound_1 + sem_CBound_FFE_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case ("foreignexport" >#< ppCurlysCommasBlock [pp (show callconv_),"\"" >|< expEnt_ >|< "\"",_exprIpp ,ppTyWithCfg' CfgPP_Core ty_]) of + { _ppBound -> + (case (_ppBound) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case ("=") of + { _sep -> + (case (False) of + { _mustPar -> + (case ([(_sep,_mustPar,_ppBound)]) of + { _lhsOppBindInfoL -> + ( _lhsOpp,_lhsOppBindInfoL) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_FFE_1)) of + { ( sem_CBound_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBound_1) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + mlev : MetaLev + synthesized attributes: + gathMinMetaLev : MetaLev + gathVarPPMp : VarPPMp + visit 1: + inherited attributes: + minMetaLev : MetaLev + nm : HsName + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppBindInfoL : [PPBindInfo] + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = MetaLev -> + ( MetaLev,VarPPMp,T_CBoundL_1) +type T_CBoundL_1 = MetaLev -> + HsName -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,([PPBindInfo]),([PP_Doc])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsImlev -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (tl_ _tlOmlev) of + { ( _tlIgathMinMetaLev,_tlIgathVarPPMp,tl_1) -> + (case (hd_ _hdOmlev) of + { ( _hdIgathMinMetaLev,_hdIgathVarPPMp,hd_1) -> + (case (_hdIgathMinMetaLev `min` _tlIgathMinMetaLev) of + { _lhsOgathMinMetaLev -> + (case (_hdIgathVarPPMp `Map.union` _tlIgathVarPPMp) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBoundL_Cons_1 :: T_CBoundL_1 + sem_CBoundL_Cons_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIminMetaLev) of + { _tlOminMetaLev -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIminMetaLev) of + { _hdOminMetaLev -> + (case (_lhsInm) of + { _tlOnm -> + (case (tl_1 _tlOminMetaLev _tlOnm _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppBindInfoL,_tlIppL) -> + (case (_lhsInm) of + { _hdOnm -> + (case (hd_1 _hdOminMetaLev _hdOnm _hdOopts _hdOppHow _hdOvarPPMp) of + { ( _hdIpp,_hdIppBindInfoL) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIppBindInfoL ++ _tlIppBindInfoL) of + { _lhsOppBindInfoL -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppBindInfoL,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBoundL_Cons_1)) of + { ( sem_CBoundL_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBoundL_1) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsImlev -> + (case (100) of + { _lhsOgathMinMetaLev -> + (case (Map.empty) of + { _lhsOgathVarPPMp -> + (case ((let sem_CBoundL_Nil_1 :: T_CBoundL_1 + sem_CBoundL_Nil_1 = + (\ _lhsIminMetaLev + _lhsInm + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppBindInfoL -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppBindInfoL,_lhsOppL) }) }) })) + in sem_CBoundL_Nil_1)) of + { ( sem_CBoundL_1) -> + ( _lhsOgathMinMetaLev,_lhsOgathVarPPMp,sem_CBoundL_1) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + inherited attributes: + opts : EHCOpts + ppHow : HowPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = EHCOpts -> + HowPP -> + ( PP_Doc) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (\ _lhsIopts + _lhsIppHow -> + (case (ppCNm conNm_ >#< "=" >#< ppCurlysCommas [pp tagNr_, pp arity_]) of + { _lhsOpp -> + ( _lhsOpp) })) +-- CDataConL --------------------------------------------------- +{- + visit 0: + inherited attributes: + opts : EHCOpts + ppHow : HowPP + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = EHCOpts -> + HowPP -> + ( PP_Doc,([PP_Doc])) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (\ _lhsIopts + _lhsIppHow -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (tl_ _tlOopts _tlOppHow) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (hd_ _hdOopts _hdOppHow) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) })) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (\ _lhsIopts + _lhsIppHow -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + inherited attributes: + opts : EHCOpts + ppHow : HowPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = EHCOpts -> + HowPP -> + ( PP_Doc) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (\ _lhsIopts + _lhsIppHow -> + (case (_lhsIppHow) of + { _dataConsOppHow -> + (case (_lhsIopts) of + { _dataConsOopts -> + (case (dataCons_ _dataConsOopts _dataConsOppHow) of + { ( _dataConsIpp,_dataConsIppL) -> + (case (howDef _lhsIppHow ("data" >#< ppCNm tyNm_) ("=" >#< ppBlockWithStrings "" "" ", " _dataConsIppL)) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) })) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + inherited attributes: + opts : EHCOpts + ppHow : HowPP + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = EHCOpts -> + HowPP -> + ( PP_Doc,([PP_Doc])) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (\ _lhsIopts + _lhsIppHow -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (tl_ _tlOopts _tlOppHow) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (hd_ _hdOopts _hdOppHow) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) }) }) })) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (\ _lhsIopts + _lhsIppHow -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + appArgPPL : [PP_Doc] + appFunPP : PP_Doc + lamArgPPL : [PP_Doc] + lamBodyPP : PP_Doc + pp : PP_Doc + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local pp : _ + alternative Int: + child int : {Int} + visit 0: + local pp : _ + alternative Char: + child char : {Char} + visit 0: + local pp : _ + alternative String: + child str : {String} + visit 0: + local pp : _ + alternative Integer: + child integer : {Integer} + visit 0: + local pp : _ + alternative Tup: + child tag : {CTag} + visit 0: + local pp : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local ppCateg : _ + local pp : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local minMetaLev : _ + local appArgPPL : _ + local appFunPP : _ + local pp : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local minMetaLev : _ + local lamArgPPL : _ + local lamBodyPP : _ + local pp : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local pp : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local pp : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local pp : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local pp : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local pp : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local ppent : _ + local pp : _ + alternative Dbg: + child info : {String} + visit 0: + local pp : _ + alternative Hole: + child uid : {UID} + visit 0: + local pp : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local pp : _ + alternative CoeArg: + visit 0: + local pp : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local pp : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local pp : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local pp : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( ([PP_Doc]),PP_Doc,([PP_Doc]),PP_Doc,PP_Doc) +data Inh_CExpr = Inh_CExpr {mlev_Inh_CExpr :: !(MetaLev),opts_Inh_CExpr :: !(EHCOpts),ppHow_Inh_CExpr :: !(HowPP),varPPMp_Inh_CExpr :: !(VarPPMp)} +data Syn_CExpr = Syn_CExpr {appArgPPL_Syn_CExpr :: !(([PP_Doc])),appFunPP_Syn_CExpr :: !(PP_Doc),lamArgPPL_Syn_CExpr :: !(([PP_Doc])),lamBodyPP_Syn_CExpr :: !(PP_Doc),pp_Syn_CExpr :: !(PP_Doc)} +wrap_CExpr :: T_CExpr -> + Inh_CExpr -> + Syn_CExpr +wrap_CExpr sem (Inh_CExpr _lhsImlev _lhsIopts _lhsIppHow _lhsIvarPPMp) = + (let ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) = sem _lhsImlev _lhsIopts _lhsIppHow _lhsIvarPPMp + in (Syn_CExpr _lhsOappArgPPL _lhsOappFunPP _lhsOlamArgPPL _lhsOlamBodyPP _lhsOpp)) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppACoreBindRef ppCNm ref_) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppLit "Int" (show int_)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppLit "Char" [char_]) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppLit "String" str_) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppLit "Integer" (show integer_)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case ("#Tag" >#< ppTag tag_) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (_lhsIvarPPMp) of + { _bindsOvarPPMp -> + (case (_lhsIppHow) of + { _bindsOppHow -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsImlev) of + { _bindsOmlev -> + (case (case categ_ of + CBindCateg_Rec -> pp " rec" + CBindCateg_Strict -> pp " !" + CBindCateg_FFI -> pp " foreign" + CBindCateg_FFE -> pp " foreignexport" + _ -> empty) of + { _ppCateg -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case (binds_ _bindsOmlev _bindsOopts _bindsOppHow _bindsOvarPPMp) of + { ( _bindsIpp,_bindsIppL) -> + (case (howDef _lhsIppHow ("let" >|< _ppCateg) (ppCurlysSemisBlock _bindsIppL) >#< "in" >-< _bodyIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _argOvarPPMp -> + (case (_lhsIppHow) of + { _argOppHow -> + (case (_lhsIopts) of + { _argOopts -> + (case (_lhsImlev) of + { _argOmlev -> + (case (arg_ _argOmlev) of + { ( _argIgathMinMetaLev,_argIgathVarPPMp,arg_1) -> + (case (_argIgathMinMetaLev) of + { _minMetaLev -> + (case (_minMetaLev) of + { _argOminMetaLev -> + (case (_lhsIvarPPMp) of + { _funcOvarPPMp -> + (case (_lhsIppHow) of + { _funcOppHow -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImlev) of + { _funcOmlev -> + (case (hsnUnknown) of + { _argOnm -> + (case (arg_1 _argOminMetaLev _argOnm _argOopts _argOppHow _argOvarPPMp) of + { ( _argIpp,_argIppBindInfoL) -> + (case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of + { ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) -> + (case ((_argIpp) : _funcIappArgPPL) of + { _appArgPPL -> + (case (_appArgPPL) of + { _lhsOappArgPPL -> + (case (_funcIappFunPP) of + { _appFunPP -> + (case (_appFunPP) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (let args = reverse $ map ppParens $ _appArgPPL + fun = ppParens _appFunPP + in howDef _lhsIppHow fun (foldr1 (howAside _lhsIppHow) args)) of + { _pp -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (_lhsIvarPPMp) of + { _bindOvarPPMp -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_lhsImlev) of + { _bindOmlev -> + (case (bind_ _bindOmlev) of + { ( _bindIgathMinMetaLev,bind_1) -> + (case (_bindIgathMinMetaLev) of + { _minMetaLev -> + (case (_minMetaLev) of + { _bindOminMetaLev -> + (case (howHor) of + { _bindOppHow -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case (bind_1 _bindOminMetaLev _bindOopts _bindOppHow _bindOvarPPMp) of + { ( _bindInm,_bindIpp) -> + (case (_bindIpp : _bodyIlamArgPPL) of + { _lamArgPPL -> + (case (_bodyIlamBodyPP) of + { _lamBodyPP -> + (case (howDef _lhsIppHow ("\\" >|< ppSpaces _lamArgPPL >#< "->") (_lamBodyPP)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (_lamArgPPL) of + { _lhsOlamArgPPL -> + (case (_lamBodyPP) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _dfltOvarPPMp -> + (case (_lhsIppHow) of + { _dfltOppHow -> + (case (_lhsIopts) of + { _dfltOopts -> + (case (_lhsImlev) of + { _dfltOmlev -> + (case (_lhsIvarPPMp) of + { _altsOvarPPMp -> + (case (_lhsIppHow) of + { _altsOppHow -> + (case (_lhsIopts) of + { _altsOopts -> + (case (_lhsImlev) of + { _altsOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (dflt_ _dfltOmlev _dfltOopts _dfltOppHow _dfltOvarPPMp) of + { ( _dfltIappArgPPL,_dfltIappFunPP,_dfltIlamArgPPL,_dfltIlamBodyPP,_dfltIpp) -> + (case (alts_ _altsOmlev _altsOopts _altsOppHow _altsOvarPPMp) of + { ( _altsIpp,_altsIppL) -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case ("case" >#< _exprIpp >#< "of" + >-< indent 1 (ppCurlysSemisBlock _altsIppL >-< ppCurlysSemisBlock [howDef _lhsIppHow (pp "default") _dfltIpp])) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _errorExprOvarPPMp -> + (case (_lhsIppHow) of + { _errorExprOppHow -> + (case (_lhsIopts) of + { _errorExprOopts -> + (case (_lhsImlev) of + { _errorExprOmlev -> + (case (errorExpr_ _errorExprOmlev _errorExprOopts _errorExprOppHow _errorExprOvarPPMp) of + { ( _errorExprIappArgPPL,_errorExprIappFunPP,_errorExprIlamArgPPL,_errorExprIlamBodyPP,_errorExprIpp) -> + (case (pp "FAIL" >#< failReason_ >-< whenMore _lhsIopts (indent 2 $ ppCurlys _errorExprIpp)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (howDef _lhsIppHow (ppParens _exprIpp) ("-=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm nm_])) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _fldExprOvarPPMp -> + (case (_lhsIppHow) of + { _fldExprOppHow -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImlev) of + { _fldExprOmlev -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of + { ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow ("+=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm nm_]) (ppParens _fldExprIpp))) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _fldExprOvarPPMp -> + (case (_lhsIppHow) of + { _fldExprOppHow -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImlev) of + { _fldExprOmlev -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of + { ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow (":=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm nm_]) (ppParens _fldExprIpp))) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case ("\"" >|< impEnt_ >|< "\"") of + { _ppent -> + (case (("foreign" >#< ppCurlysCommasBlock [pp (show callconv_),pp (show safety_),_ppent,ppTyWithCfg' CfgPP_Core ty_])) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppParens $ "<#< info_ >#< ">>") of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppHole uid_) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case ("let --" >#< ppHole bindsUid_ >-< howDef _lhsIppHow (pp "in") _bodyIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (pp "<_>") of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _funcOvarPPMp -> + (case (_lhsIppHow) of + { _funcOppHow -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImlev) of + { _funcOmlev -> + (case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of + { ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) -> + (case (howDef _lhsIppHow (_funcIpp >#< "-- Impl") (ppHole uid_)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case (howDef _lhsIppHow ("\\" >|< ppHole uid_ >#< "-- Impl") ("->" >#< _bodyIpp)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _annOvarPPMp -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (_lhsIppHow) of + { _annOppHow -> + (case (_lhsIopts) of + { _annOopts -> + (case (_lhsImlev) of + { _annOmlev -> + (case (ann_ _annOmlev _annOopts _annOppHow _annOvarPPMp) of + { ( _annIpp) -> + (case (alsoMore _lhsIopts (\x -> ppParens (x >#< _annIpp)) _exprIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case ([]) of + { _lhsOlamArgPPL -> + (case (_pp) of + { _lhsOlamBodyPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOappArgPPL,_lhsOappFunPP,_lhsOlamArgPPL,_lhsOlamBodyPP,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local pp : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local pp : _ + alternative Debug: + child info : {String} + visit 0: + local pp : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ("::" >#< ppTyWithCfg' CfgPP_Plain ty_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ("~" >#< ppRelevCoe _lhsIvarPPMp coe_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (ppCmt $ pp info_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = EHCOpts -> + ( PP_Doc) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (\ _lhsIopts -> + (case ("import" >#< ppCNm nm_) of + { _lhsOpp -> + ( _lhsOpp) })) +-- CImportL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = EHCOpts -> + ( PP_Doc,([PP_Doc])) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (tl_ _tlOopts) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (hd_ _hdOopts) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (\ _lhsIopts -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Plain: + visit 0: + local pp : _ + alternative Function0: + visit 0: + local pp : _ + alternative Function1: + visit 0: + local pp : _ + alternative Apply0: + visit 0: + local pp : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = MetaLev -> + EHCOpts -> + ( PP_Doc) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsImlev + _lhsIopts -> + (case (pp "BINDPLAIN") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsImlev + _lhsIopts -> + (case (pp "BINDFUNCTION0") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsImlev + _lhsIopts -> + (case (pp "BINDFUNCTION1") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsImlev + _lhsIopts -> + (case (pp "BINDAPPLY0") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + synthesized attributes: + optPP : PP_Doc + pp : PP_Doc + alternatives: + alternative Val: + visit 0: + local optPP : _ + local pp : _ + alternative Dict: + visit 0: + local pp : _ + local optPP : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local pp : _ + local optPP : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local pp : _ + local optPP : _ + alternative Track: + child track : {Track} + visit 0: + local pp : _ + local optPP : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = MetaLev -> + EHCOpts -> + ( PP_Doc,PP_Doc) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsImlev + _lhsIopts -> + (case (empty) of + { _optPP -> + (case (_optPP) of + { _lhsOoptPP -> + (case (pp "VAL") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOoptPP,_lhsOpp) }) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsImlev + _lhsIopts -> + (case (pp "DICT") of + { _pp -> + (case (" :" >#< _pp) of + { _optPP -> + (case (_optPP) of + { _lhsOoptPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOoptPP,_lhsOpp) }) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsImlev + _lhsIopts -> + (case (pp "DICTCLASS" >|< ppCurlyList ppTrack tracks_) of + { _pp -> + (case (" :" >#< _pp) of + { _optPP -> + (case (_optPP) of + { _lhsOoptPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOoptPP,_lhsOpp) }) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsImlev + _lhsIopts -> + (case (pp "DICTINSTANCE" >|< ppCurlyList ppTrack tracks_) of + { _pp -> + (case (" :" >#< _pp) of + { _optPP -> + (case (_optPP) of + { _lhsOoptPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOoptPP,_lhsOpp) }) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsImlev + _lhsIopts -> + (case (pp "TRACK" >|< ppCurlys (show track_)) of + { _pp -> + (case (" :" >#< _pp) of + { _optPP -> + (case (_optPP) of + { _lhsOoptPP -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOoptPP,_lhsOpp) }) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local pp : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = MetaLev -> + EHCOpts -> + ( PP_Doc) +data Inh_CMetas = Inh_CMetas {mlev_Inh_CMetas :: !(MetaLev),opts_Inh_CMetas :: !(EHCOpts)} +data Syn_CMetas = Syn_CMetas {pp_Syn_CMetas :: !(PP_Doc)} +wrap_CMetas :: T_CMetas -> + Inh_CMetas -> + Syn_CMetas +wrap_CMetas sem (Inh_CMetas _lhsImlev _lhsIopts) = + (let ( _lhsOpp) = sem _lhsImlev _lhsIopts + in (Syn_CMetas _lhsOpp)) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsImlev + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts -> + (case (_lhsImlev) of + { _x2Omlev -> + (case (x2_ _x2Omlev _x2Oopts) of + { ( _x2IoptPP,_x2Ipp) -> + (case (_lhsIopts) of + { _x1Oopts -> + (case (_lhsImlev) of + { _x1Omlev -> + (case (x1_ _x1Omlev _x1Oopts) of + { ( _x1Ipp) -> + (case (ppCurlysCommas [_x1Ipp,_x2Ipp]) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = MetaLev -> + EHCOpts -> + HowPP -> + ( PP_Doc) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIppHow) of + { _declMetasOppHow -> + (case (Map.empty) of + { _exprOvarPPMp -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (_lhsIopts) of + { _declMetasOopts -> + (case (declMetas_ _declMetasOopts _declMetasOppHow) of + { ( _declMetasIpp,_declMetasIppL) -> + (case (_lhsIopts) of + { _importsOopts -> + (case (imports_ _importsOopts) of + { ( _importsIpp,_importsIppL) -> + (case (ppSemi ("module" >#< ppCNm moduleNm_) + >-< (vlist $ map ppSemi _importsIppL) + >-< (vlist $ map ppSemi _declMetasIppL) + >-< _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + fldNmL : [HsName] + pp : PP_Doc + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( ([HsName]),PP_Doc) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOfldNmL -> + (case (ppCNm pnm_) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _bindsOvarPPMp -> + (case (_lhsIppHow) of + { _bindsOppHow -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsImlev) of + { _bindsOmlev -> + (case (binds_ _bindsOmlev _bindsOopts _bindsOppHow _bindsOvarPPMp) of + { ( _bindsIfldNmL,_bindsIpp,_bindsIppL) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (_lhsIvarPPMp) of + { _restOvarPPMp -> + (case (_lhsIppHow) of + { _restOppHow -> + (case (_lhsIopts) of + { _restOopts -> + (case (_lhsImlev) of + { _restOmlev -> + (case (rest_ _restOmlev _restOopts _restOppHow _restOvarPPMp) of + { ( _restIpp,_restIppMb) -> + (case (howDef _lhsIppHow ("#Tag" >#< ppTag tag_) + (ppCurly (ppMbPre (>#< "|") _restIppMb $ ppCommas' _bindsIppL))) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOfldNmL -> + (case (ppLit "Int" (show int_)) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOfldNmL -> + (case (ppLit "Char" [char_]) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOfldNmL -> + (case (empty) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + fldNmL : [HsName] + pp : PP_Doc + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local minMetaLev : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( ([HsName]),PP_Doc) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsImlev) of + { _bindOmlev -> + (case (bind_ _bindOmlev) of + { ( _bindIgathMinMetaLev,bind_1) -> + (case (_lhsIvarPPMp) of + { _bindOvarPPMp -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_bindIgathMinMetaLev) of + { _minMetaLev -> + (case (_minMetaLev) of + { _bindOminMetaLev -> + (case (howHor) of + { _bindOppHow -> + (case (bind_1 _bindOminMetaLev _bindOopts _bindOppHow _bindOvarPPMp) of + { ( _bindInm,_bindIpp) -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (_lhsIvarPPMp) of + { _fldAnnsOvarPPMp -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIppHow) of + { _fldAnnsOppHow -> + (case (_lhsIopts) of + { _fldAnnsOopts -> + (case (_lhsImlev) of + { _fldAnnsOmlev -> + (case (fldAnns_ _fldAnnsOmlev _fldAnnsOopts _fldAnnsOppHow _fldAnnsOvarPPMp) of + { ( _fldAnnsIpp,_fldAnnsIppL) -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (whenMore _lhsIopts (ppCurlysCommas' [ppCNm lbl_,_offsetIpp ] >|< "=") >|< _bindIpp + >|< (if null _fldAnnsIppL then empty else ppParensCommas' _fldAnnsIppL)) of + { _lhsOpp -> + ( _lhsOfldNmL,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + fldNmL : [HsName] + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( ([HsName]),PP_Doc,([PP_Doc])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIfldNmL,_tlIpp,_tlIppL) -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of + { ( _hdIfldNmL,_hdIpp) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOfldNmL,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case ([]) of + { _lhsOfldNmL -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOfldNmL,_lhsOpp,_lhsOppL) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + mlev : MetaLev + opts : EHCOpts + ppHow : HowPP + varPPMp : VarPPMp + synthesized attributes: + pp : PP_Doc + ppMb : Maybe PP_Doc + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local pp : _ + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = MetaLev -> + EHCOpts -> + HowPP -> + VarPPMp -> + ( PP_Doc,(Maybe PP_Doc)) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (ppCNm nm_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (Just _pp) of + { _lhsOppMb -> + ( _lhsOpp,_lhsOppMb) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsImlev + _lhsIopts + _lhsIppHow + _lhsIvarPPMp -> + (case (empty) of + { _lhsOpp -> + (case (Nothing) of + { _lhsOppMb -> + ( _lhsOpp,_lhsOppMb) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + pp : PP_Doc + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local ppHow : _ + local mlev : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = EHCOpts -> + ( PP_Doc) +data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {pp_Syn_CodeAGItf :: !(PP_Doc)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = + (let ( _lhsOpp) = sem _lhsIopts + in (Syn_CodeAGItf _lhsOpp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIopts -> + (case (howVert) of + { _ppHow -> + (case (_ppHow) of + { _moduleOppHow -> + (case (_lhsIopts) of + { _moduleOopts -> + (case (metaLevVal) of + { _mlev -> + (case (_mlev) of + { _moduleOmlev -> + (case (module_ _moduleOmlev _moduleOopts _moduleOppHow) of + { ( _moduleIpp) -> + (case (_moduleIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Subst.hs b/src/UHC/Light/Compiler/Core/Subst.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Subst.hs @@ -0,0 +1,2553 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Subst.ag) +module UHC.Light.Compiler.Core.Subst(CSubst +, cSubstAppExpr, cSubstAppBind, cSubstAppBound +, cSubstAppExprAndBinds +, cAppCoeArg +, coeEvalOnAsSubst +, coeWipeWeaveAsSubst2 +, mkLamBodyCoe +, lrcoeWipeWeaveAsSubst, lrcoeForLamTyAppAsSubst) where + +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Core.FvS +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core.Coercion + + + + + + + + + + + +type CSubstInfo = CSubstInfo' CExpr CMetaVal CBind CBound CTy +type CSubst = CSubst' CExpr CMetaVal CBind CBound CTy + + + +cSubstAppExpr :: Bool -> CSubst -> CExpr -> Maybe CExpr -> CExpr +cSubstAppExpr doDeepSubst cs ce mbOnCe + = cRepl_Syn_CExpr t + where t = wrap_CExpr + (sem_CExpr ce) + (Inh_CExpr { cSubst_Inh_CExpr = cs + , coeArg_Inh_CExpr = maybe CExpr_CoeArg id mbOnCe + , doDeepSubst_Inh_CExpr = doDeepSubst + }) + +cSubstAppBind :: Bool -> CSubst -> CBind -> CBind +cSubstAppBind doDeepSubst cs ce + = cRepl_Syn_CBind t + where t = wrap_CBind + (sem_CBind ce) + (Inh_CBind { cSubst_Inh_CBind = cs + , coeArg_Inh_CBind = maybe CExpr_CoeArg id Nothing + , doDeepSubst_Inh_CBind = doDeepSubst + }) + +cSubstAppBound :: {- Bool -> -} CSubst -> CBound -> CBound +cSubstAppBound {- doDeepSubst -} cs ce + = cRepl_Syn_CBound t + where t = wrap_CBound + (sem_CBound ce) + (Inh_CBound { cSubst_Inh_CBound = cs + , coeArg_Inh_CBound = maybe CExpr_CoeArg id Nothing + , doDeepSubst_Inh_CBound = False -- doDeepSubst + }) + + + +cSubstAppExprAndBinds :: CSubst -> CBind -> CBind +cSubstAppExprAndBinds cs ct = cSubstAppBind {- (defaultCSubstOpts {csoptsDoSubstBind = True}) -} False cs ct + + + +cAppCoeArg :: CExpr -> CExpr -> CExpr +cAppCoeArg ce coeArg + = cSubstAppExpr False emptyCSubst ce (Just coeArg) + + + +instance CSubstitutable CExpr CMetaVal CBind CBound CTy CExpr where + cSubstApp cs ce | Map.null cs + = ce + cSubstApp cs ce + = cSubstAppExpr False cs ce Nothing + + + +cStopSubst = CExpr_String "Core.Subst.cStopSubst: may not happen" + + + +coeEvalOnAsSubst :: UID -> Coe -> CExpr -> (CExpr,CSubst) +coeEvalOnAsSubst uniq coe ce + = (c,s) + where (_,c,s) = ev uniq coe ce + ev uniq coe ce + = case coe of + c | acoreCoeIsId c-> mk ce + Coe_Map f -> mk $ f ce + Coe_App1 a -> mk $ acore1App ce a + Coe_Lam n t -> mk $ acoreLam1Ty n t ce + Coe_LamLet n t i -> mk $ acoreLam1Ty n t $ acoreHoleLet i ce + Coe_LetRec b -> mk $ acoreLetRec b ce + Coe_Compose c1 c2 -> (u2, c1', s2 `cSubstAppSubst` s1) + where (u1,c2',s1) = ev uniq c2 ce + (u2,c1',s2) = ev u1 c1 c2' + Coe_C e -> (u', e `cAppCoeArg` acoreUidHole u, acoreCSubstFromUidExprL [(u,ce)]) + where (u',u) = mkNewUID uniq + Coe_ImplApp iv -> mk $ CExpr_ImplsApp ce iv + Coe_ImplLam iv -> mk $ CExpr_ImplsLam iv ce + where mk c = (uniq,c,emptyCSubst) + + + +coeEvalOn :: Coe -> CExpr -> CExpr +coeEvalOn coe ce + = s `cSubstApp` ce' + where (ce',s) = coeEvalOnAsSubst uidStart coe ce + + + +coeWeaveOnAsSubst :: UID -> [Coe] -> [Coe] -> CExpr -> (CExpr,CSubst) +coeWeaveOnAsSubst = coeWeaveWithSubstOnAsSubst emptyCSubst + +coeWeaveWithSubstOnAsSubst :: CSubst -> UID -> [Coe] -> [Coe] -> CExpr -> (CExpr,CSubst) +coeWeaveWithSubstOnAsSubst cs uniq lCoeL rCoeL ce + = snd $ foldr ev (foldr ev (uniq,(ce,emptyCSubst)) (reverse lCoeL)) rCoeL + where ev c (uniq,(e,s)) = (u',(cs `cSubstApp` e',s' `cSubstAppSubst` s)) + where (u',u ) = mkNewUID uniq + (e',s') = coeEvalOnAsSubst u c e + + + +coeWeaveOn2 :: CSubst -> [Coe] -> [Coe] -> CExpr -> CExpr +coeWeaveOn2 cs lCoeL rCoeL ce + = cSubstAppExpr True s e Nothing + where (e,s) = coeWeaveWithSubstOnAsSubst cs uidStart lCoeL rCoeL ce + + + +coeWipe :: [Coe] -> [Coe] -> ([Coe],[Coe]) +coeWipe l r + = (reverse l', reverse r') + where w l r = case lr of + (Coe_ImplApp li:ls,Coe_ImplLam ri:rs) + | li == ri -> w ls rs + | otherwise -> lr + _ -> lr + where lr = (l,r) + (l',r') = w (reverse l) (reverse r) + + + +coeWipeWeaveAsSubst :: EHCOpts -> UID -> VarMp -> [Coe] -> [Coe] -> (Coe,CSubst) +coeWipeWeaveAsSubst opts uniq c lCoeL rCoeL + = (Coe_C e,s) + where (lCoeL',rCoeL') = coeWipe (concatMap (coeImplsAppLVarMp opts c) lCoeL) (concatMap (coeImplsAppRVarMp c) rCoeL) + (e,s) = coeWeaveOnAsSubst uniq lCoeL' rCoeL' CExpr_CoeArg + +coeWipeWeaveAsSubst2 :: EHCOpts -> UID -> VarMp -> CSubst -> [Coe] -> [Coe] -> (Coe,CSubst) +coeWipeWeaveAsSubst2 opts uniq c cs lCoeL rCoeL + = (Coe_C e,s) + where (lCoeL',rCoeL') = coeWipe (concatMap (coeImplsAppLVarMp opts c) lCoeL) (concatMap (coeImplsAppRVarMp c) rCoeL) + (e,s) = coeWeaveWithSubstOnAsSubst cs uniq lCoeL' rCoeL' CExpr_CoeArg + + + +coeImplsAppLVarMp :: EHCOpts -> VarMp -> Coe -> [Coe] +coeImplsAppLVarMp opts c coe + = case coe of + Coe_ImplApp i -> maybe [coe] (acoreCoeImplsApp) (varmpImplsLookupCyc i c) + _ -> [coe] + +coeImplsAppRVarMp :: VarMp -> Coe -> [Coe] +coeImplsAppRVarMp c coe + = case coe of + Coe_ImplLam i -> maybe [coe] (acoreCoeImplsLam acoreCoeId) (varmpImplsLookupCyc i c) + _ -> [coe] + +mkLamBodyCoe :: Coe -> [Coe] -> [Coe] +mkLamBodyCoe onLast l + = case l of + (_:_) -> h ++ [onLast `acoreCoeCompose` t] + where h = init l + t = last l + _ | acoreCoeIsId onLast -> [] + | otherwise -> [onLast] + + + +instance PP Coe where + pp c = "<" >|< pp (fst $ coeEvalOnAsSubst uidStart c CExpr_CoeArg) >|< ">" + + + +lrcoeWipeWeaveAsSubst :: EHCOpts -> UID -> VarMp -> LRCoe -> (Coe,CSubst) +lrcoeWipeWeaveAsSubst opts uniq cnstr (LRCoe LRCoeId _ _) = (acoreCoeId,emptyCSubst) +lrcoeWipeWeaveAsSubst opts uniq cnstr lrcoe = coeWipeWeaveAsSubst opts uniq cnstr (lrcoeLeftL lrcoe) (lrcoeRightL lrcoe) + +lrcoeForLamTyAppAsSubst :: EHCOpts -> UID -> LRCoe -> LRCoe -> (LRCoe,CSubst) +lrcoeForLamTyAppAsSubst opts uniq f a + = (LRCoe k [l] [r] `lrcoeUnion` a, s) + where (u',u1,u2,u3) = mkNewLevUID3 uniq + n = uidHNm u1 + r = acoreCoeLam1 n + (k,l,s) + = case f of + lr@(LRCoe LRCoeOther _ _) + -> (lrcoeKindOfCoe c, acoreCoeAppN [a], cSubstAppSubst s1 s2) + where (c,s1) = lrcoeWipeWeaveAsSubst opts u2 emptyVarMp lr + (a,s2) = coeEvalOnAsSubst u3 c (acoreVar n) + LRCoe LRCoeId _ _ + -> (LRCoeId, l, emptyCSubst) + where l = acoreCoeAppN [acoreVar n] + + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cRepl : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = CSubst -> + CExpr -> + Bool -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (_lhsIdoDeepSubst) of + { _patOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _patOcoeArg -> + (case (_lhsIcSubst) of + { _patOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (pat_ _patOcSubst _patOcoeArg _patOdoDeepSubst) of + { ( _patIcRepl) -> + (case (CAlt_Alt _patIcRepl _exprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = CSubst -> + CExpr -> + Bool -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _tlOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _tlOcoeArg -> + (case (_lhsIcSubst) of + { _tlOcSubst -> + (case (_lhsIdoDeepSubst) of + { _hdOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _hdOcoeArg -> + (case (_lhsIcSubst) of + { _hdOcSubst -> + (case (tl_ _tlOcSubst _tlOcoeArg _tlOdoDeepSubst) of + { ( _tlIcRepl) -> + (case (hd_ _hdOcSubst _hdOcoeArg _hdOdoDeepSubst) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cRepl : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = CSubst -> + CExpr -> + Bool -> + ( CBind) +data Inh_CBind = Inh_CBind {cSubst_Inh_CBind :: !(CSubst),coeArg_Inh_CBind :: !(CExpr),doDeepSubst_Inh_CBind :: !(Bool)} +data Syn_CBind = Syn_CBind {cRepl_Syn_CBind :: !(CBind)} +wrap_CBind :: T_CBind -> + Inh_CBind -> + Syn_CBind +wrap_CBind sem (Inh_CBind _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst) = + (let ( _lhsOcRepl) = sem _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst + in (Syn_CBind _lhsOcRepl)) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bindAspectsOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindAspectsOcoeArg -> + (case (_lhsIcSubst) of + { _bindAspectsOcSubst -> + (case (bindAspects_ _bindAspectsOcSubst _bindAspectsOcoeArg _bindAspectsOdoDeepSubst) of + { ( _bindAspectsIcRepl) -> + (case (CBind_Bind nm_ _bindAspectsIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cRepl : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = CSubst -> + CExpr -> + Bool -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CBindAnn_Coe coe_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = CSubst -> + CExpr -> + Bool -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _tlOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _tlOcoeArg -> + (case (_lhsIcSubst) of + { _tlOcSubst -> + (case (tl_ _tlOcSubst _tlOcoeArg _tlOdoDeepSubst) of + { ( _tlIcRepl) -> + (case (_lhsIdoDeepSubst) of + { _hdOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _hdOcoeArg -> + (case (_lhsIcSubst) of + { _hdOcSubst -> + (case (hd_ _hdOcSubst _hdOcoeArg _hdOdoDeepSubst) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = CSubst -> + CExpr -> + Bool -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _tlOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _tlOcoeArg -> + (case (_lhsIcSubst) of + { _tlOcSubst -> + (case (_lhsIdoDeepSubst) of + { _hdOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _hdOcoeArg -> + (case (_lhsIcSubst) of + { _hdOcSubst -> + (case (tl_ _tlOcSubst _tlOcoeArg _tlOdoDeepSubst) of + { ( _tlIcRepl) -> + (case (hd_ _hdOcSubst _hdOcoeArg _hdOdoDeepSubst) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cRepl : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cRepl : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cRepl : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cRepl : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cRepl : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cRepl : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = CSubst -> + CExpr -> + Bool -> + ( CBound) +data Inh_CBound = Inh_CBound {cSubst_Inh_CBound :: !(CSubst),coeArg_Inh_CBound :: !(CExpr),doDeepSubst_Inh_CBound :: !(Bool)} +data Syn_CBound = Syn_CBound {cRepl_Syn_CBound :: !(CBound)} +wrap_CBound :: T_CBound -> + Inh_CBound -> + Syn_CBound +wrap_CBound sem (Inh_CBound _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst) = + (let ( _lhsOcRepl) = sem _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst + in (Syn_CBound _lhsOcRepl)) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (_lhsIdoDeepSubst) of + { _bindMetaOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindMetaOcoeArg -> + (case (_lhsIcSubst) of + { _bindMetaOcSubst -> + (case (bindMeta_ _bindMetaOcSubst _bindMetaOcoeArg _bindMetaOdoDeepSubst) of + { ( _bindMetaIcRepl) -> + (case (CBound_Bind _bindMetaIcRepl _exprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _cmetasOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _cmetasOcoeArg -> + (case (_lhsIcSubst) of + { _cmetasOcSubst -> + (case (cmetas_ _cmetasOcSubst _cmetasOcoeArg _cmetasOdoDeepSubst) of + { ( _cmetasIcRepl) -> + (case (CBound_Meta aspectKeyS_ _cmetasIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CBound_FFE callconv_ expEnt_ _exprIcRepl ty_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = CSubst -> + CExpr -> + Bool -> + ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _tlOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _tlOcoeArg -> + (case (_lhsIcSubst) of + { _tlOcSubst -> + (case (_lhsIdoDeepSubst) of + { _hdOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _hdOcoeArg -> + (case (_lhsIcSubst) of + { _hdOcSubst -> + (case (tl_ _tlOcSubst _tlOcoeArg _tlOdoDeepSubst) of + { ( _tlIcRepl) -> + (case (hd_ _hdOcSubst _hdOcoeArg _hdOdoDeepSubst) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cRepl : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcRepl) -> + (case (hd_) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cRepl : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcRepl) -> + (case (CDeclMeta_Data tyNm_ _dataConsIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcRepl) -> + (case (hd_) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cRepl : _ + local csKey : _ + local _tup1 : _ + local isRepl : _ + local replv : _ + inst repl' : CExpr + alternative Int: + child int : {Int} + visit 0: + local cRepl : _ + alternative Char: + child char : {Char} + visit 0: + local cRepl : _ + alternative String: + child str : {String} + visit 0: + local cRepl : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cRepl : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cRepl : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local cRepl : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local cRepl : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cRepl : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cRepl : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cRepl : _ + local _tup2 : _ + local uid : _ + local csKey : _ + local canSubst : _ + local _tup3 : _ + local isRepl : _ + local replv : _ + inst repl' : CExpr + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cRepl : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cRepl : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cRepl : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cRepl : _ + alternative Dbg: + child info : {String} + visit 0: + local cRepl : _ + alternative Hole: + child uid : {UID} + visit 0: + local cRepl : _ + local csKey : _ + local _tup4 : _ + local isRepl : _ + local replv : _ + inst repl' : CExpr + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cRepl : _ + local csKey : _ + local _tup5 : _ + local isRepl : _ + local replv : _ + inst repl' : CExpr + alternative CoeArg: + visit 0: + local _tup6 : _ + local replv : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local csKey : _ + local _tup7 : _ + local coeAppL : _ + local replv : _ + local isRepl : _ + inst repl' : CExpr + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local csKey : _ + local _tup8 : _ + local coeLamL : _ + local replv : _ + local isRepl : _ + inst repl' : CExpr + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cRepl : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = CSubst -> + CExpr -> + Bool -> + ( CExpr) +data Inh_CExpr = Inh_CExpr {cSubst_Inh_CExpr :: !(CSubst),coeArg_Inh_CExpr :: !(CExpr),doDeepSubst_Inh_CExpr :: !(Bool)} +data Syn_CExpr = Syn_CExpr {cRepl_Syn_CExpr :: !(CExpr)} +wrap_CExpr :: T_CExpr -> + Inh_CExpr -> + Syn_CExpr +wrap_CExpr sem (Inh_CExpr _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst) = + (let ( _lhsOcRepl) = sem _lhsIcSubst _lhsIcoeArg _lhsIdoDeepSubst + in (Syn_CExpr _lhsOcRepl)) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Var ref_) of + { _cRepl -> + (case (CSKey_Ref ref_) of + { _csKey -> + (case (case Map.lookup _csKey _lhsIcSubst of + Just (CSIExpr e) -> (e,True) + _ -> (_cRepl,False)) of + { __tup1 -> + (case (__tup1) of + { (_,_isRepl) -> + (case (__tup1) of + { (_replv,_) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Int int_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Char char_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_String str_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Integer integer_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Tup tag_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bodyOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bodyOcoeArg -> + (case (_lhsIcSubst) of + { _bodyOcSubst -> + (case (_lhsIdoDeepSubst) of + { _bindsOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindsOcoeArg -> + (case (_lhsIcSubst) of + { _bindsOcSubst -> + (case (body_ _bodyOcSubst _bodyOcoeArg _bodyOdoDeepSubst) of + { ( _bodyIcRepl) -> + (case (binds_ _bindsOcSubst _bindsOcoeArg _bindsOdoDeepSubst) of + { ( _bindsIcRepl) -> + (case (CExpr_Let categ_ _bindsIcRepl _bodyIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _argOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _argOcoeArg -> + (case (_lhsIcSubst) of + { _argOcSubst -> + (case (_lhsIdoDeepSubst) of + { _funcOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _funcOcoeArg -> + (case (_lhsIcSubst) of + { _funcOcSubst -> + (case (arg_ _argOcSubst _argOcoeArg _argOdoDeepSubst) of + { ( _argIcRepl) -> + (case (func_ _funcOcSubst _funcOcoeArg _funcOdoDeepSubst) of + { ( _funcIcRepl) -> + (case (CExpr_App _funcIcRepl _argIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bodyOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bodyOcoeArg -> + (case (_lhsIcSubst) of + { _bodyOcSubst -> + (case (_lhsIdoDeepSubst) of + { _bindOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindOcoeArg -> + (case (_lhsIcSubst) of + { _bindOcSubst -> + (case (body_ _bodyOcSubst _bodyOcoeArg _bodyOdoDeepSubst) of + { ( _bodyIcRepl) -> + (case (bind_ _bindOcSubst _bindOcoeArg _bindOdoDeepSubst) of + { ( _bindIcRepl) -> + (case (CExpr_Lam _bindIcRepl _bodyIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _dfltOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _dfltOcoeArg -> + (case (_lhsIcSubst) of + { _dfltOcSubst -> + (case (_lhsIdoDeepSubst) of + { _altsOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _altsOcoeArg -> + (case (_lhsIcSubst) of + { _altsOcSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (dflt_ _dfltOcSubst _dfltOcoeArg _dfltOdoDeepSubst) of + { ( _dfltIcRepl) -> + (case (alts_ _altsOcSubst _altsOcoeArg _altsOdoDeepSubst) of + { ( _altsIcRepl) -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CExpr_Case _exprIcRepl _altsIcRepl _dfltIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _errorExprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _errorExprOcoeArg -> + (case (_lhsIcSubst) of + { _errorExprOcSubst -> + (case (errorExpr_ _errorExprOcSubst _errorExprOcoeArg _errorExprOdoDeepSubst) of + { ( _errorExprIcRepl) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcRepl) of + { _cRepl -> + (case (cafailHasId failReason_) of + { __tup2 -> + (case (__tup2) of + { (_,_uid) -> + (case (CSKey_UID _uid) of + { _csKey -> + (case (__tup2) of + { (_canSubst,_) -> + (case (if _canSubst + then case Map.lookup _csKey _lhsIcSubst of + Just (CSIExpr ce) -> (ce,True) + _ -> (_cRepl,False) + else (_cRepl,False)) of + { __tup3 -> + (case (__tup3) of + { (_,_isRepl) -> + (case (__tup3) of + { (_replv,_) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _offsetOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _offsetOcoeArg -> + (case (_lhsIcSubst) of + { _offsetOcSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (offset_ _offsetOcSubst _offsetOcoeArg _offsetOdoDeepSubst) of + { ( _offsetIcRepl) -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CExpr_TupDel _exprIcRepl tag_ nm_ _offsetIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _fldExprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _fldExprOcoeArg -> + (case (_lhsIcSubst) of + { _fldExprOcSubst -> + (case (_lhsIdoDeepSubst) of + { _offsetOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _offsetOcoeArg -> + (case (_lhsIcSubst) of + { _offsetOcSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (fldExpr_ _fldExprOcSubst _fldExprOcoeArg _fldExprOdoDeepSubst) of + { ( _fldExprIcRepl) -> + (case (offset_ _offsetOcSubst _offsetOcoeArg _offsetOdoDeepSubst) of + { ( _offsetIcRepl) -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CExpr_TupIns _exprIcRepl tag_ nm_ _offsetIcRepl _fldExprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _fldExprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _fldExprOcoeArg -> + (case (_lhsIcSubst) of + { _fldExprOcSubst -> + (case (_lhsIdoDeepSubst) of + { _offsetOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _offsetOcoeArg -> + (case (_lhsIcSubst) of + { _offsetOcSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (fldExpr_ _fldExprOcSubst _fldExprOcoeArg _fldExprOdoDeepSubst) of + { ( _fldExprIcRepl) -> + (case (offset_ _offsetOcSubst _offsetOcoeArg _offsetOdoDeepSubst) of + { ( _offsetIcRepl) -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (CExpr_TupUpd _exprIcRepl tag_ nm_ _offsetIcRepl _fldExprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Dbg info_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExpr_Hole uid_) of + { _cRepl -> + (case (CSKey_UID uid_) of + { _csKey -> + (case (case Map.lookup _csKey _lhsIcSubst of + Just (CSIExpr ce) -> (ce,True) + _ -> (_cRepl,False)) of + { __tup4 -> + (case (__tup4) of + { (_,_isRepl) -> + (case (__tup4) of + { (_replv,_) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bodyOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bodyOcoeArg -> + (case (_lhsIcSubst) of + { _bodyOcSubst -> + (case (body_ _bodyOcSubst _bodyOcoeArg _bodyOdoDeepSubst) of + { ( _bodyIcRepl) -> + (case (CExpr_HoleLet bindsUid_ _bodyIcRepl) of + { _cRepl -> + (case (CSKey_UID bindsUid_) of + { _csKey -> + (case (case Map.lookup _csKey _lhsIcSubst of + Just (CSIBinds b) -> (_lhsIcSubst `cSubstApp` acoreLetRec b _bodyIcRepl,True) + _ -> (_cRepl,False)) of + { __tup5 -> + (case (__tup5) of + { (_,_isRepl) -> + (case (__tup5) of + { (_replv,_) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ((_lhsIcoeArg,True)) of + { __tup6 -> + (case (__tup6) of + { (_replv,_) -> + (case (_replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _funcOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _funcOcoeArg -> + (case (_lhsIcSubst) of + { _funcOcSubst -> + (case (CSKey_UID uid_) of + { _csKey -> + (case (case Map.lookup _csKey _lhsIcSubst of + Just (CSIImpls ca cl) -> (ca,cl,True) + _ -> ([],[],False)) of + { __tup7 -> + (case (__tup7) of + { (_coeAppL,_,_) -> + (case (func_ _funcOcSubst _funcOcoeArg _funcOdoDeepSubst) of + { ( _funcIcRepl) -> + (case (coeWeaveOn2 emptyCSubst _coeAppL [] _funcIcRepl) of + { _replv -> + (case (__tup7) of + { (_,_,_isRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bodyOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bodyOcoeArg -> + (case (_lhsIcSubst) of + { _bodyOcSubst -> + (case (CSKey_UID uid_) of + { _csKey -> + (case (case Map.lookup _csKey _lhsIcSubst of + Just (CSIImpls ca cl) -> (ca,cl,True) + _ -> ([],[],False)) of + { __tup8 -> + (case (__tup8) of + { (_,_coeLamL,_) -> + (case (body_ _bodyOcSubst _bodyOcoeArg _bodyOdoDeepSubst) of + { ( _bodyIcRepl) -> + (case (coeWeaveOn2 emptyCSubst [] _coeLamL _bodyIcRepl) of + { _replv -> + (case (__tup8) of + { (_,_,_isRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _replv else cStopSubst) of + { repl'_val_ -> + (case ((sem_CExpr repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIdoDeepSubst) of + { _repl'OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _repl'OcoeArg -> + (case (Map.delete _csKey _lhsIcSubst) of + { _repl'OcSubst -> + (case (repl'_inst_ _repl'OcSubst _repl'OcoeArg _repl'OdoDeepSubst) of + { ( _repl'IcRepl) -> + (case (if _lhsIdoDeepSubst && _isRepl then _repl'IcRepl else _replv) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (_lhsIdoDeepSubst) of + { _annOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _annOcoeArg -> + (case (_lhsIcSubst) of + { _annOcSubst -> + (case (ann_ _annOcSubst _annOcoeArg _annOdoDeepSubst) of + { ( _annIcRepl) -> + (case (CExpr_Ann _annIcRepl _exprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cRepl : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cRepl : _ + alternative Debug: + child info : {String} + visit 0: + local cRepl : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = CSubst -> + CExpr -> + Bool -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExprAnn_Ty ty_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExprAnn_Coe coe_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CExprAnn_Debug info_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cRepl : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cRepl : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcRepl) -> + (case (hd_) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cRepl : _ + alternative Function0: + visit 0: + local cRepl : _ + alternative Function1: + visit 0: + local cRepl : _ + alternative Apply0: + visit 0: + local cRepl : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = CSubst -> + CExpr -> + Bool -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaBind_Plain) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaBind_Function0) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaBind_Function1) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaBind_Apply0) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CMetaVal + alternatives: + alternative Val: + visit 0: + local cRepl : _ + alternative Dict: + visit 0: + local cRepl : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cRepl : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cRepl : _ + alternative Track: + child track : {Track} + visit 0: + local cRepl : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = CSubst -> + CExpr -> + Bool -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaVal_Val) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaVal_Dict) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaVal_DictClass tracks_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaVal_DictInstance tracks_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CMetaVal_Track track_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cRepl : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = CSubst -> + CExpr -> + Bool -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _x2OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _x2OcoeArg -> + (case (_lhsIcSubst) of + { _x2OcSubst -> + (case (x2_ _x2OcSubst _x2OcoeArg _x2OdoDeepSubst) of + { ( _x2IcRepl) -> + (case (_lhsIdoDeepSubst) of + { _x1OdoDeepSubst -> + (case (_lhsIcoeArg) of + { _x1OcoeArg -> + (case (_lhsIcSubst) of + { _x1OcSubst -> + (case (x1_ _x1OcSubst _x1OcoeArg _x1OdoDeepSubst) of + { ( _x1IcRepl) -> + (case ((_x1IcRepl,_x2IcRepl)) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cRepl : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = CSubst -> + CExpr -> + Bool -> + ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _exprOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _exprOcoeArg -> + (case (_lhsIcSubst) of + { _exprOcSubst -> + (case (expr_ _exprOcSubst _exprOcoeArg _exprOdoDeepSubst) of + { ( _exprIcRepl) -> + (case (declMetas_) of + { ( _declMetasIcRepl) -> + (case (imports_) of + { ( _importsIcRepl) -> + (case (CModule_Mod moduleNm_ _importsIcRepl _declMetasIcRepl _exprIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cRepl : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cRepl : _ + alternative Int: + child int : {Int} + visit 0: + local cRepl : _ + alternative Char: + child char : {Char} + visit 0: + local cRepl : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cRepl : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = CSubst -> + CExpr -> + Bool -> + ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPat_Var pnm_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bindsOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindsOcoeArg -> + (case (_lhsIcSubst) of + { _bindsOcSubst -> + (case (binds_ _bindsOcSubst _bindsOcoeArg _bindsOdoDeepSubst) of + { ( _bindsIcRepl) -> + (case (_lhsIdoDeepSubst) of + { _restOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _restOcoeArg -> + (case (_lhsIcSubst) of + { _restOcSubst -> + (case (rest_ _restOcSubst _restOcoeArg _restOdoDeepSubst) of + { ( _restIcRepl) -> + (case (CPat_Con tag_ _restIcRepl _bindsIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPat_Int int_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPat_Char char_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPat_BoolExpr cexpr_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local cRepl : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = CSubst -> + CExpr -> + Bool -> + ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _bindOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _bindOcoeArg -> + (case (_lhsIcSubst) of + { _bindOcSubst -> + (case (_lhsIdoDeepSubst) of + { _offsetOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _offsetOcoeArg -> + (case (_lhsIcSubst) of + { _offsetOcSubst -> + (case (_lhsIdoDeepSubst) of + { _fldAnnsOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _fldAnnsOcoeArg -> + (case (_lhsIcSubst) of + { _fldAnnsOcSubst -> + (case (fldAnns_ _fldAnnsOcSubst _fldAnnsOcoeArg _fldAnnsOdoDeepSubst) of + { ( _fldAnnsIcRepl) -> + (case (bind_ _bindOcSubst _bindOcoeArg _bindOdoDeepSubst) of + { ( _bindIcRepl) -> + (case (offset_ _offsetOcSubst _offsetOcoeArg _offsetOdoDeepSubst) of + { ( _offsetIcRepl) -> + (case (CPatFld_Fld lbl_ _offsetIcRepl _bindIcRepl _fldAnnsIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cRepl : _ + alternative Nil: + visit 0: + local cRepl : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = CSubst -> + CExpr -> + Bool -> + ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _tlOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _tlOcoeArg -> + (case (_lhsIcSubst) of + { _tlOcSubst -> + (case (_lhsIdoDeepSubst) of + { _hdOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _hdOcoeArg -> + (case (_lhsIcSubst) of + { _hdOcSubst -> + (case (tl_ _tlOcSubst _tlOcoeArg _tlOdoDeepSubst) of + { ( _tlIcRepl) -> + (case (hd_ _hdOcSubst _hdOcoeArg _hdOdoDeepSubst) of + { ( _hdIcRepl) -> + (case ((:) _hdIcRepl _tlIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case ([]) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cRepl : _ + alternative Empty: + visit 0: + local cRepl : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = CSubst -> + CExpr -> + Bool -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPatRest_Var nm_) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (CPatRest_Empty) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + cSubst : CSubst + coeArg : CExpr + doDeepSubst : Bool + synthesized attribute: + cRepl : CodeAGItf + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local cRepl : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = CSubst -> + CExpr -> + Bool -> + ( CodeAGItf) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIcSubst + _lhsIcoeArg + _lhsIdoDeepSubst -> + (case (_lhsIdoDeepSubst) of + { _moduleOdoDeepSubst -> + (case (_lhsIcoeArg) of + { _moduleOcoeArg -> + (case (_lhsIcSubst) of + { _moduleOcSubst -> + (case (module_ _moduleOcSubst _moduleOcoeArg _moduleOdoDeepSubst) of + { ( _moduleIcRepl) -> + (case (CodeAGItf_AGItf _moduleIcRepl) of + { _cRepl -> + (case (_cRepl) of + { _lhsOcRepl -> + ( _lhsOcRepl) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/SysF/AsTy.hs b/src/UHC/Light/Compiler/Core/SysF/AsTy.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/SysF/AsTy.hs @@ -0,0 +1,37 @@ +module UHC.Light.Compiler.Core.SysF.AsTy +( Ty +, ty2TySysfWithEnv, ty2TyC +, ty2TyCforFFI ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Error +import qualified UHC.Light.Compiler.Core as C +import qualified UHC.Light.Compiler.Ty as T +import UHC.Light.Compiler.FinalEnv + +{-# LINE 50 "src/ehc/Core/SysF/AsTy.chs" #-} +-- | The type, represented by a term CExpr +type Ty = C.SysfTy -- base ty + +-- | Binding the bound +type TyBind = C.SysfTyBind +type TyBound = C.SysfTyBound + +-- | A sequence of parameters (for now just a single type) +type TySeq = C.SysfTySeq + + +{-# LINE 67 "src/ehc/Core/SysF/AsTy.chs" #-} +ty2TySysfWithEnv :: ToSysfEnv -> T.Ty -> Ty +ty2TySysfWithEnv _ t = t + +-- | Construct a type for use by AbstractCore +ty2TyC :: EHCOpts -> ToSysfEnv -> T.Ty -> C.CTy +ty2TyC o env t = C.mkCTy o t (ty2TySysfWithEnv env t) + +{-# LINE 93 "src/ehc/Core/SysF/AsTy.chs" #-} +-- | Construct a type for use by AbstractCore, specifically for use by FFI +ty2TyCforFFI :: EHCOpts -> T.Ty -> C.CTy +ty2TyCforFFI o t = C.mkCTy o t t + diff --git a/src/UHC/Light/Compiler/Core/ToCoreRun.hs b/src/UHC/Light/Compiler/Core/ToCoreRun.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/ToCoreRun.hs @@ -0,0 +1,5550 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ToCoreRun) +module UHC.Light.Compiler.Core.ToCoreRun(cmod2CoreRun', cmod2CoreRun) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import Data.Maybe +import qualified Data.Map as Map +import Data.Char +import UHC.Util.Utils +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.CodeGen.BasicAnnot +import qualified UHC.Light.Compiler.CoreRun as CR +import qualified UHC.Light.Compiler.CoreRun.Prim as CR +import UHC.Light.Compiler.Foreign.Extract + + + + + + + + + + + + + + + + + +cmod2CoreRun' + :: EHCOpts + -> Int -- sequence nr of module (offset), used to create global per module references + -> CR.Nm2RefMp -- outer bindings + -> CModule + -> ( CR.Mod -- generated CoreRun + , CR.Nm2RefMp -- name to ref mapping of toplevel bindings + ) +cmod2CoreRun' opts modNr nm2ref cmod + = ( crm_Syn_CodeAGItf t + , nm2refGath_Syn_CodeAGItf t + ) + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { modNr_Inh_CodeAGItf = modNr + , opts_Inh_CodeAGItf = opts + , nm2ref_Inh_CodeAGItf = nm2ref + }) + +cmod2CoreRun :: CModule -> CR.Mod +cmod2CoreRun m = m' + where (m',_) = cmod2CoreRun' defaultEHCOpts 0 Map.empty m + + + +-- | Debug info is embedded in Exp +dbg = CR.Exp_Dbg + + + +-- | What to do with binding in terms of thunking/forcing? +data ToBe + = ToBe_Thunked + | ToBe_Forced + | ToBe_LeftAsIs + deriving Eq + + + +-- | Tail context +data TailCtx + = TailCtx_Plain + | TailCtx_TailCall + | TailCtx_CaseAlt + +tailCtxIsTailRec :: TailCtx -> Bool +tailCtxIsTailRec TailCtx_TailCall = True +tailCtxIsTailRec _ = False + +-- | Wrap according to tail context +cseCtxWrap :: TailCtx -> CR.Exp -> CR.Exp +cseCtxWrap TailCtx_TailCall = CR.Exp_Tail +cseCtxWrap _ = id + + + +-- | Construct application +mkApp :: CR.Exp -> CR.CRArray CR.Exp -> CR.Exp +mkApp f as = CR.Exp_App (CR.Exp_Ret $ CR.Exp_Force f) as + + + +-- | Wrap context saving if not at tail recursive position +tailrec :: TailCtx -> CR.Exp -> CR.Exp +tailrec tailCtx = if tailCtxIsTailRec tailCtx then id else id -- CR.Exp_Ret -- id + +-- | Wrap forcing if at tail recursive position +taileval :: TailCtx -> CR.Exp -> CR.Exp +taileval tailCtx = if tailCtxIsTailRec tailCtx then CR.Exp_Force else id + +-- CAlt -------------------------------------------------------- +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + evalCtx : EvalCtx + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + scrutRef : CR.RRef + tailCtx : TailCtx + chained attribute: + stackDepth : Int + synthesized attributes: + cra : [CR.Alt] + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 1: + local whatAbove : {WhatExpr} + local nm2refNew : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = Int -> + ( Int,T_CAlt_1) +type T_CAlt_1 = EvalCtx -> + Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + (CR.RRef) -> + Int -> + TailCtx -> + ( ([CR.Alt]),Int,Int,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CAlt_Alt_1 :: T_CAlt_1 + sem_CAlt_Alt_1 = + (\ _lhsIevalCtx + _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIscrutRef + _lhsIstackDepth + _lhsItailCtx -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsItailCtx) of + { _exprOtailCtx -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIstackDepth) of + { _patOstackDepth -> + (case (_lhsIrefOffset) of + { _patOrefOffset -> + (case (_lhsIopts) of + { _patOopts -> + (case (_lhsInm2ref) of + { _patOnm2ref -> + (case (_lhsImodNr) of + { _patOmodNr -> + (case (_lhsIlev) of + { _patOlev -> + (case (pat_ _patOlev _patOmodNr _patOnm2ref _patOopts _patOrefOffset _patOstackDepth) of + { ( _patIcrp,_patIfldNmL,_patIrefOffset,_patIstackDepth) -> + (case (Map.fromList [ (n, CR.RRef_Fld _lhsIscrutRef i) | (n,i) <- zip _patIfldNmL [0..] ]) of + { _nm2refNew -> + (case (_nm2refNew `Map.union` _lhsInm2ref) of + { _exprOnm2ref -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case ([CR.Alt_Alt (CR.nm2RefMpInverse _nm2refNew) _patIcrp _exprIcre]) of + { _lhsOcra -> + (case (max _exprIrefOffset _exprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (max _exprIstackDepth _exprIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CAlt_Alt_1)) of + { ( sem_CAlt_1) -> + ( _lhsOrefOffset,sem_CAlt_1) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + evalCtx : EvalCtx + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + scrutRef : CR.RRef + tailCtx : TailCtx + chained attribute: + stackDepth : Int + synthesized attributes: + cra : [CR.Alt] + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = Int -> + ( Int,T_CAltL_1) +type T_CAltL_1 = EvalCtx -> + Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + (CR.RRef) -> + Int -> + TailCtx -> + ( ([CR.Alt]),Int,Int,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _hdOrefOffset -> + (case (hd_ _hdOrefOffset) of + { ( _hdIrefOffset,hd_1) -> + (case (_hdIrefOffset) of + { _tlOrefOffset -> + (case (tl_ _tlOrefOffset) of + { ( _tlIrefOffset,tl_1) -> + (case (_tlIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CAltL_Cons_1 :: T_CAltL_1 + sem_CAltL_Cons_1 = + (\ _lhsIevalCtx + _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIscrutRef + _lhsIstackDepth + _lhsItailCtx -> + (case (_lhsItailCtx) of + { _tlOtailCtx -> + (case (_lhsIstackDepth) of + { _hdOstackDepth -> + (case (_lhsItailCtx) of + { _hdOtailCtx -> + (case (_lhsIscrutRef) of + { _hdOscrutRef -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm2ref) of + { _hdOnm2ref -> + (case (_lhsImodNr) of + { _hdOmodNr -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (hd_1 _hdOevalCtx _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOscrutRef _hdOstackDepth _hdOtailCtx) of + { ( _hdIcra,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> + (case (_hdIstackDepth) of + { _tlOstackDepth -> + (case (_lhsIscrutRef) of + { _tlOscrutRef -> + (case (_lhsInm2ref) of + { _tlOnm2ref -> + (case (_lhsImodNr) of + { _tlOmodNr -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (tl_1 _tlOevalCtx _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOscrutRef _tlOstackDepth _tlOtailCtx) of + { ( _tlIcra,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> + (case (_hdIcra ++ _tlIcra) of + { _lhsOcra -> + (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_tlIstackDepth) of + { _lhsOstackDepth -> + (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CAltL_Cons_1)) of + { ( sem_CAltL_1) -> + ( _lhsOrefOffset,sem_CAltL_1) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CAltL_Nil_1 :: T_CAltL_1 + sem_CAltL_Nil_1 = + (\ _lhsIevalCtx + _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIscrutRef + _lhsIstackDepth + _lhsItailCtx -> + (case ([]) of + { _lhsOcra -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcra,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) + in sem_CAltL_Nil_1)) of + { ( sem_CAltL_1) -> + ( _lhsOrefOffset,sem_CAltL_1) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + modNr : Int + chained attribute: + refOffset : Int + synthesized attributes: + nm : HsName + nm2refGath : CR.Nm2RefMp + visit 1: + inherited attributes: + evalCtx : EvalCtx + letBindingsCateg : CBindCateg + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + synthesized attributes: + crb : [(HsName, CR.Bind)] + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local ref : _ + local nm2refGath : _ + local refOffsetHere : _ + visit 1: + local crb : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = Bool -> + Int -> + Int -> + Int -> + ( HsName,(CR.Nm2RefMp),Int,T_CBind_1) +type T_CBind_1 = EvalCtx -> + CBindCateg -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( ([(HsName, CR.Bind)]),Int,Int,Int) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (nm_) of + { _lhsOnm -> + (case (if _lhsIisGlobal + then CR.RRef_Glb _lhsImodNr _lhsIrefOffset + else CR.RRef_Loc _lhsIlev _lhsIrefOffset) of + { _ref -> + (case (Map.singleton nm_ _ref) of + { _nm2refGath -> + (case (_nm2refGath) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset + 1) of + { _refOffsetHere -> + (case (_refOffsetHere) of + { _lhsOrefOffset -> + (case ((let sem_CBind_Bind_1 :: T_CBind_1 + sem_CBind_Bind_1 = + (\ _lhsIevalCtx + _lhsIletBindingsCateg + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _bindAspectsOstackDepth -> + (case (_lhsIrefOffset) of + { _bindAspectsOrefOffset -> + (case (_lhsInm2ref) of + { _bindAspectsOnm2ref -> + (case (_lhsImodNr) of + { _bindAspectsOmodNr -> + (case (_lhsIlev) of + { _bindAspectsOlev -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx -> + (case (nm_) of + { _bindAspectsOnm -> + (case (_lhsIopts) of + { _bindAspectsOopts -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNr _bindAspectsOnm _bindAspectsOnm2ref _bindAspectsOopts _bindAspectsOrefOffset _bindAspectsOstackDepth) of + { ( _bindAspectsIcrb,_bindAspectsInm2refGath,_bindAspectsIrefOffset,_bindAspectsIrefOffsetMax,_bindAspectsIstackDepth,_bindAspectsIstackDepthMax) -> + (case (take 1 _bindAspectsIcrb) of + { _crb -> + (case (_crb) of + { _lhsOcrb -> + (case (_bindAspectsIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_bindAspectsIstackDepth) of + { _lhsOstackDepth -> + (case (_bindAspectsIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBind_Bind_1)) of + { ( sem_CBind_1) -> + ( _lhsOnm,_lhsOnm2refGath,_lhsOrefOffset,sem_CBind_1) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + alternatives: + alternative Coe: + child coe : {RelevCoe} +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( Int,Int) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOrefOffset,_lhsOstackDepth) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( Int,Int) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _hdOrefOffset -> + (case (_lhsIstackDepth) of + { _hdOstackDepth -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm2ref) of + { _hdOnm2ref -> + (case (_lhsImodNr) of + { _hdOmodNr -> + (case (_lhsIlev) of + { _hdOlev -> + (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of + { ( _hdIrefOffset,_hdIstackDepth) -> + (case (_hdIrefOffset) of + { _tlOrefOffset -> + (case (_hdIstackDepth) of + { _tlOstackDepth -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsInm2ref) of + { _tlOnm2ref -> + (case (_lhsImodNr) of + { _tlOmodNr -> + (case (_lhsIlev) of + { _tlOlev -> + (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of + { ( _tlIrefOffset,_tlIstackDepth) -> + (case (_tlIrefOffset) of + { _lhsOrefOffset -> + (case (_tlIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOrefOffset,_lhsOstackDepth) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + modNr : Int + chained attribute: + refOffset : Int + synthesized attribute: + nm2refGath : CR.Nm2RefMp + visit 1: + inherited attributes: + evalCtx : EvalCtx + letBindingsCateg : CBindCateg + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + synthesized attributes: + crb : [(HsName, CR.Bind)] + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = Bool -> + Int -> + Int -> + Int -> + ( (CR.Nm2RefMp),Int,T_CBindL_1) +type T_CBindL_1 = EvalCtx -> + CBindCateg -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( ([(HsName, CR.Bind)]),Int,Int,Int) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _hdOrefOffset -> + (case (_lhsImodNr) of + { _hdOmodNr -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (hd_ _hdOisGlobal _hdOlev _hdOmodNr _hdOrefOffset) of + { ( _hdInm,_hdInm2refGath,_hdIrefOffset,hd_1) -> + (case (_hdIrefOffset) of + { _tlOrefOffset -> + (case (_lhsImodNr) of + { _tlOmodNr -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (tl_ _tlOisGlobal _tlOlev _tlOmodNr _tlOrefOffset) of + { ( _tlInm2refGath,_tlIrefOffset,tl_1) -> + (case (_hdInm2refGath `Map.union` _tlInm2refGath) of + { _lhsOnm2refGath -> + (case (_tlIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBindL_Cons_1 :: T_CBindL_1 + sem_CBindL_Cons_1 = + (\ _lhsIevalCtx + _lhsIletBindingsCateg + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _hdOstackDepth -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm2ref) of + { _hdOnm2ref -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (hd_1 _hdOevalCtx _hdOletBindingsCateg _hdOnm2ref _hdOopts _hdOstackDepth) of + { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> + (case (_hdIstackDepth) of + { _tlOstackDepth -> + (case (_lhsInm2ref) of + { _tlOnm2ref -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (tl_1 _tlOevalCtx _tlOletBindingsCateg _tlOnm2ref _tlOopts _tlOstackDepth) of + { ( _tlIcrb,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> + (case (_hdIcrb ++ _tlIcrb) of + { _lhsOcrb -> + (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_tlIstackDepth) of + { _lhsOstackDepth -> + (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBindL_Cons_1)) of + { ( sem_CBindL_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBindL_Nil_1 :: T_CBindL_1 + sem_CBindL_Nil_1 = + (\ _lhsIevalCtx + _lhsIletBindingsCateg + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case ([]) of + { _lhsOcrb -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) + in sem_CBindL_Nil_1)) of + { ( sem_CBindL_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBindL_1) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + lev : Int + modNr : Int + chained attribute: + refOffset : Int + synthesized attribute: + nm2refGath : CR.Nm2RefMp + visit 1: + inherited attributes: + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + nm : HsName + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + synthesized attributes: + crb : [(HsName, CR.Bind)] + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local toBe : _ + local isToBeThunked : _ + local lev : _ + local refOffsetExpr : _ + visit 1: + local tailCtx : _ + local isToBeReturned : _ + local creMkReturned : _ + local nm2refNew : _ + local isToBeALam : _ + local stackDepthMaxThunked : _ + local creMkForce : _ + local creBind : _ + local crb : _ + local stackDepthExpr : _ + intra isToBeThunked : _ + intra lev : _ + intra toBe : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local toBe : _ + local isToBeThunked : _ + local lev : _ + local refOffsetExpr : _ + visit 1: + local tailCtx : _ + local isToBeReturned : _ + local creMkReturned : _ + local nm2refNew : _ + local isToBeALam : _ + local stackDepthMaxThunked : _ + local creMkForce : _ + local creBind : _ + local crb : _ + local stackDepthExpr : _ + intra isToBeThunked : _ + intra lev : _ + intra toBe : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + visit 1: + local tailCtx : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Int -> + Int -> + Int -> + ( (CR.Nm2RefMp),Int,T_CBound_1) +type T_CBound_1 = Bool -> + Bool -> + CBindCateg -> + HsName -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( ([(HsName, CR.Bind)]),Int,Int,Int) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow + isVar = isJust $ whatExprMbVar _exprIwhatBelow + isGlbVar = isVar && _lhsIisGlobal + isApp = isJust mba + isTup = isApp && whatExprIsTup w + isWHNF = whatExprIsWHNF _exprIwhatBelow + isNotWHNF = not isWHNF + in case _lhsIevalCtx of + EvalCtx_Eval + | isApp -> ToBe_LeftAsIs + | isVar -> ToBe_Forced + | isNotWHNF -> ToBe_Forced + EvalCtx_Thunk + | isTup -> ToBe_LeftAsIs + | isGlbVar -> ToBe_Thunked + | isNotWHNF -> ToBe_Thunked + _ -> ToBe_LeftAsIs) of + { _toBe -> + (case (_toBe == ToBe_Thunked) of + { _isToBeThunked -> + (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of + { _lev -> + (case (_lev) of + { _exprOlev -> + (case (if _isToBeThunked then 0 else _lhsIrefOffset) of + { _refOffsetExpr -> + (case (_refOffsetExpr) of + { _exprOrefOffset -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprInm2refGath) of + { _lhsOnm2refGath -> + (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_Bind_1 :: T_CBound_1 + sem_CBound_Bind_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _exprOtailCtx -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (case _lhsIevalCtx of + EvalCtx_Eval -> True + _ -> False) of + { _isToBeReturned -> + (case (if _isToBeReturned then CR.Exp_Ret else id) of + { _creMkReturned -> + (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of + { _nm2refNew -> + (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of + { _isToBeALam -> + (case (if _isToBeALam then 0 else _lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (max _exprIstackDepth _exprIstackDepthMax) of + { _stackDepthMaxThunked -> + (case (case _toBe of + ToBe_Forced -> tailrec _tailCtx . CR.Exp_Force + ToBe_Thunked -> CR.Exp_Lam _lev 0 (_exprIrefOffsetMax) (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew) + ToBe_LeftAsIs -> id) of + { _creMkForce -> + (case (_creMkReturned $ _creMkForce _exprIcre) of + { _creBind -> + (case ([( _lhsInm, _creBind )]) of + { _crb -> + (case (_crb) of + { _lhsOcrb -> + (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of + { _stackDepthExpr -> + (case (_stackDepthExpr) of + { _lhsOstackDepth -> + (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Bind_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _cmetasOrefOffset -> + (case (cmetas_ _cmetasOrefOffset) of + { ( _cmetasIrefOffset,cmetas_1) -> + (case (_cmetasIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_Meta_1 :: T_CBound_1 + sem_CBound_Meta_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case ([]) of + { _lhsOcrb -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _cmetasOstackDepth -> + (case (_lhsIopts) of + { _cmetasOopts -> + (case (_lhsInm2ref) of + { _cmetasOnm2ref -> + (case (_lhsImodNr) of + { _cmetasOmodNr -> + (case (_lhsIlev) of + { _cmetasOlev -> + (case (cmetas_1 _cmetasOlev _cmetasOmodNr _cmetasOnm2ref _cmetasOopts _cmetasOstackDepth) of + { ( _cmetasIstackDepth) -> + (case (_cmetasIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Meta_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 + sem_CBound_RelevTy_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case ([]) of + { _lhsOcrb -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) + in sem_CBound_RelevTy_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (let mba@(~(Just (_,w))) = whatExprMbApp _exprIwhatBelow + isVar = isJust $ whatExprMbVar _exprIwhatBelow + isGlbVar = isVar && _lhsIisGlobal + isApp = isJust mba + isTup = isApp && whatExprIsTup w + isWHNF = whatExprIsWHNF _exprIwhatBelow + isNotWHNF = not isWHNF + in case _lhsIevalCtx of + EvalCtx_Eval + | isApp -> ToBe_LeftAsIs + | isVar -> ToBe_Forced + | isNotWHNF -> ToBe_Forced + EvalCtx_Thunk + | isTup -> ToBe_LeftAsIs + | isGlbVar -> ToBe_Thunked + | isNotWHNF -> ToBe_Thunked + _ -> ToBe_LeftAsIs) of + { _toBe -> + (case (_toBe == ToBe_Thunked) of + { _isToBeThunked -> + (case (if _isToBeThunked then _lhsIlev + 1 else _lhsIlev) of + { _lev -> + (case (_lev) of + { _exprOlev -> + (case (if _isToBeThunked then 0 else _lhsIrefOffset) of + { _refOffsetExpr -> + (case (_refOffsetExpr) of + { _exprOrefOffset -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprInm2refGath) of + { _lhsOnm2refGath -> + (case (if _isToBeThunked then _lhsIrefOffset else _exprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_Val_1 :: T_CBound_1 + sem_CBound_Val_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (if _isToBeThunked then TailCtx_TailCall else TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _exprOtailCtx -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (case _lhsIevalCtx of + EvalCtx_Eval -> True + _ -> False) of + { _isToBeReturned -> + (case (if _isToBeReturned then CR.Exp_Ret else id) of + { _creMkReturned -> + (case (if _isToBeThunked then _exprInm2refGath else Map.empty) of + { _nm2refNew -> + (case (_isToBeThunked || whatExprIsLam _exprIwhatBelow) of + { _isToBeALam -> + (case (if _isToBeALam then 0 else _lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (max _exprIstackDepth _exprIstackDepthMax) of + { _stackDepthMaxThunked -> + (case (case _toBe of + ToBe_Forced -> tailrec _tailCtx . CR.Exp_Force + ToBe_Thunked -> CR.Exp_Lam _lev 0 (_exprIrefOffsetMax) (_stackDepthMaxThunked) (CR.nm2RefMpInverse _nm2refNew) + ToBe_LeftAsIs -> id) of + { _creMkForce -> + (case (_creMkReturned $ _creMkForce _exprIcre) of + { _creBind -> + (case ([( _lhsInm, _creBind )]) of + { _crb -> + (case (_crb) of + { _lhsOcrb -> + (case (if _isToBeThunked then _lhsIrefOffset else max _exprIrefOffset _exprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (if _isToBeALam then _lhsIstackDepth+1 else _exprIstackDepth) of + { _stackDepthExpr -> + (case (_stackDepthExpr) of + { _lhsOstackDepth -> + (case (if _isToBeALam then _stackDepthExpr else _stackDepthMaxThunked) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Val_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_Ty_1 :: T_CBound_1 + sem_CBound_Ty_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case ([]) of + { _lhsOcrb -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) })) + in sem_CBound_Ty_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlev + _lhsImodNr + _lhsIrefOffset -> + (case (ExprIsLam 0) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprInm2refGath) of + { _lhsOnm2refGath -> + (case (_exprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CBound_FFE_1 :: T_CBound_1 + sem_CBound_FFE_1 = + (\ _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _exprOtailCtx -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (_exprIcrb) of + { _lhsOcrb -> + (case (_exprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_exprIstackDepth) of + { _lhsOstackDepth -> + (case (_exprIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_FFE_1)) of + { ( sem_CBound_1) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CBound_1) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + modNr : Int + nm : HsName + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + synthesized attributes: + crb : [(HsName, CR.Bind)] + nm2refGath : CR.Nm2RefMp + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + Int -> + HsName -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( ([(HsName, CR.Bind)]),(CR.Nm2RefMp),Int,Int,Int,Int) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNr + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _hdOstackDepth -> + (case (_lhsIrefOffset) of + { _hdOrefOffset -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsImodNr) of + { _hdOmodNr -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOlev _hdOmodNr _hdOrefOffset) of + { ( _hdInm2refGath,_hdIrefOffset,hd_1) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm2ref) of + { _hdOnm2ref -> + (case (_lhsInm) of + { _hdOnm -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (True) of + { _hdOisTopTup -> + (case (True) of + { _hdOisTopApp -> + (case (hd_1 _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOnm _hdOnm2ref _hdOopts _hdOstackDepth) of + { ( _hdIcrb,_hdIrefOffsetMax,_hdIstackDepth,_hdIstackDepthMax) -> + (case (_hdIstackDepth) of + { _tlOstackDepth -> + (case (_hdIrefOffset) of + { _tlOrefOffset -> + (case (_lhsInm2ref) of + { _tlOnm2ref -> + (case (_lhsInm) of + { _tlOnm -> + (case (_lhsImodNr) of + { _tlOmodNr -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNr _tlOnm _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of + { ( _tlIcrb,_tlInm2refGath,_tlIrefOffset,_tlIrefOffsetMax,_tlIstackDepth,_tlIstackDepthMax) -> + (case (_hdIcrb ++ _tlIcrb) of + { _lhsOcrb -> + (case (_hdInm2refGath `Map.union` _tlInm2refGath) of + { _lhsOnm2refGath -> + (case (_tlIrefOffset) of + { _lhsOrefOffset -> + (case (_hdIrefOffsetMax `max` _tlIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_tlIstackDepth) of + { _lhsOstackDepth -> + (case (_hdIstackDepthMax `max` _tlIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNr + _lhsInm + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case ([]) of + { _lhsOcrb -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + (case (0) of + { _lhsOstackDepthMax -> + ( _lhsOcrb,_lhsOnm2refGath,_lhsOrefOffset,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( ) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + ( ) +-- CDataConL --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( ) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + ( ) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + ( ) +-- CDeclMeta --------------------------------------------------- +{- + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + ( ) +-- CDeclMetaL -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + ( ) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + ( ) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + whatBelow : WhatExpr + visit 1: + inherited attributes: + lev : Int + modNr : Int + whatAbove : WhatExpr + chained attribute: + refOffset : Int + synthesized attribute: + nm2refGath : CR.Nm2RefMp + visit 2: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + nm2ref : CR.Nm2RefMp + opts : EHCOpts + tailCtx : TailCtx + chained attribute: + stackDepth : Int + synthesized attributes: + appFunKind : AppFunKind + crb : [(HsName, CR.Bind)] + cre : CR.Exp + creAppArgL : [CR.Exp] + creAppFun : TailCtx -> CR.CRArray CR.Exp -> CR.Exp + creLamArgL : [HsName] + creLamBody : CR.Exp + crse : CR.SExp + mbFFIApp : Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + ) + mbLam : Maybe [HsName] + mbVar : Maybe HsName + refOffsetMax : Int + stackDepthMax : Int + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local whatBelow : _ + visit 1: + intra nm : {HsName} + visit 2: + local crse : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local mbVar : {Maybe HsName} + local stackDepthHere : _ + intra nm : {HsName} + alternative Int: + child int : {Int} + visit 0: + local whatBelow : _ + visit 2: + local crse : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local stackDepthHere : _ + alternative Char: + child char : {Char} + visit 0: + local whatBelow : _ + visit 2: + local crse : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local stackDepthHere : _ + alternative String: + child str : {String} + visit 0: + local whatBelow : _ + visit 2: + local crse : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local stackDepthHere : _ + alternative Integer: + child integer : {Integer} + visit 0: + local whatBelow : _ + visit 2: + local crse : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local stackDepthHere : _ + alternative Tup: + child tag : {CTag} + visit 0: + local whatBelow : _ + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + local isGlobal : _ + local _tup1 : _ + visit 2: + local evalCtx : _ + local letBindingsCateg : _ + local _tup2 : _ + local isTopTup : _ + local isTopApp : {Bool} + local nm2refNew : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local refOffsetMax : _ + local stackDepthMax : _ + intra isGlobal : _ + intra _tup1 : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + local isGlobal : _ + visit 2: + local tailCtx : _ + local isTopTup : _ + local creAppFun : _ + local stackDepthFunc : _ + local letBindingsCateg : _ + local creAppArgL : _ + local isTopApp' : _ + local creBase : _ + local cre : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthMax : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + local isTopLam : _ + local lev : _ + local _tup3 : _ + local refOffsetBody : _ + local refOffset : _ + local isGlobal : _ + local nm2refNew : _ + visit 2: + local nm2ref : _ + local isTopTup : _ + local isTopApp : {Bool} + local creLamArgL : _ + local stackDepthMax : _ + local refOffsetMax : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamBody : _ + local crse : _ + local argNm : _ + intra nm2refNew : _ + intra isTopLam : _ + intra refOffsetBody : _ + intra lev : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local isTopTup : _ + local isTopApp : {Bool} + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + local stackDepthMax : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local isTopTup : _ + local isTopApp : {Bool} + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopApp : {Bool} + local isTopTup : _ + local stackDepthHere : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopApp : {Bool} + local isTopTup : _ + local stackDepthHere : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopApp : {Bool} + local isTopTup : _ + local stackDepthHere : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local whatBelow : _ + visit 2: + local foreignEntInfo : _ + local creEntMb : _ + local creMk : _ + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local mbPrimNeedEval : {Maybe PrimitiveNeedsEval} + local primResNeedsEval : {Bool} + local argTyLresTy : {( TyL, Ty )} + local resTy : _ + local argTyL : {TyL} + local stackDepthHere : _ + alternative Dbg: + child info : {String} + visit 0: + local whatBelow : _ + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + alternative Hole: + child uid : {UID} + visit 0: + local whatBelow : _ + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopTup : _ + local isTopApp : {Bool} + local stackDepthHere : _ + alternative CoeArg: + visit 0: + local whatBelow : _ + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local stackDepthHere : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopTup : _ + local isTopApp : {Bool} + local stackDepthHere : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local whatBelow : _ + visit 1: + local whatAbove : {WhatExpr} + visit 2: + local creBase : _ + local cre : _ + local creAppArgL : _ + local creAppFun : _ + local creLamArgL : _ + local creLamBody : _ + local crse : _ + local isTopTup : _ + local isTopApp : {Bool} + local stackDepthHere : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 2: + local crse : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( WhatExpr,T_CExpr_1) +type T_CExpr_1 = Int -> + Int -> + Int -> + WhatExpr -> + ( (CR.Nm2RefMp),Int,T_CExpr_2) +type T_CExpr_2 = EvalCtx -> + Bool -> + Bool -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + TailCtx -> + ( AppFunKind,([(HsName, CR.Bind)]),(CR.Exp),([CR.Exp]),(TailCtx -> CR.CRArray CR.Exp -> CR.Exp),([HsName]),(CR.Exp),(CR.SExp),(Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )),(Maybe [HsName]),(Maybe HsName),Int,Int,Int) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (acbrefNm ref_) of + { _nm -> + (case (ExprIsVar _nm) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Var_1 :: T_CExpr_1 + sem_CExpr_Var_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Var_2 :: T_CExpr_2 + sem_CExpr_Var_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.SExp_Var $ fromMaybe (CR.RRef_Dbg _nm) $ Map.lookup _nm _lhsInm2ref) of + { _crse -> + (case (taileval _lhsItailCtx $ CR.Exp_SExp _crse) of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Just _nm) of + { _mbVar -> + (case (_mbVar) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Var_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Var_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (ExprIsInt int_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Int_1 :: T_CExpr_1 + sem_CExpr_Int_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Int_2 :: T_CExpr_2 + sem_CExpr_Int_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.SExp_Int int_) of + { _crse -> + (case (CR.Exp_SExp _crse) of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Int_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Int_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Char_1 :: T_CExpr_1 + sem_CExpr_Char_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Char_2 :: T_CExpr_2 + sem_CExpr_Char_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.SExp_Char char_) of + { _crse -> + (case (CR.Exp_SExp _crse) of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Char_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Char_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_String_1 :: T_CExpr_1 + sem_CExpr_String_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_String_2 :: T_CExpr_2 + sem_CExpr_String_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.SExp_String str_) of + { _crse -> + (case (CR.Exp_SExp _crse) of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_String_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_String_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Integer_1 :: T_CExpr_1 + sem_CExpr_Integer_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Integer_2 :: T_CExpr_2 + sem_CExpr_Integer_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.SExp_Integer integer_) of + { _crse -> + (case (CR.Exp_SExp _crse) of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Integer_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Integer_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (ExprIsTup tag_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Tup_1 :: T_CExpr_1 + sem_CExpr_Tup_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Tup_2 :: T_CExpr_2 + sem_CExpr_Tup_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (CR.Exp_Tup tag_ CR.emptyCRArray) of + { _creBase -> + (case (_creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\_ -> cseCtxWrap TailCtx_Plain . CR.Exp_Tup tag_) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Tup_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Tup_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Let_1 :: T_CExpr_1 + sem_CExpr_Let_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIrefOffset) of + { _bindsOrefOffset -> + (case (_lhsImodNr) of + { _bindsOmodNr -> + (case (_lhsIlev) of + { _bindsOlev -> + (case (_lhsIlev == cLevModule) of + { _isGlobal -> + (case (_isGlobal) of + { _bindsOisGlobal -> + (case (binds_ _bindsOisGlobal _bindsOlev _bindsOmodNr _bindsOrefOffset) of + { ( _bindsInm2refGath,_bindsIrefOffset,binds_1) -> + (case (_bindsIrefOffset) of + { _bodyOrefOffset -> + (case (_lhsImodNr) of + { _bodyOmodNr -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (body_) of + { ( _bodyIwhatBelow,body_1) -> + (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of + { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> + (case (if _isGlobal + then (Map.empty, _bindsInm2refGath `Map.union` _bodyInm2refGath) + else (_bindsInm2refGath, Map.empty)) of + { __tup1 -> + (case (__tup1) of + { (_,_lhsOnm2refGath) -> + (case (_bodyIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Let_2 :: T_CExpr_2 + sem_CExpr_Let_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (_lhsIstackDepth) of + { _bindsOstackDepth -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx -> + (case (_evalCtx) of + { _bindsOevalCtx -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (categ_) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg -> + (case (if _isGlobal + then (_lhsInm2ref, _lhsInm2ref) + else ( case categ_ of + CBindCateg_Rec -> _bindsInm2refGath `Map.union` _lhsInm2ref + _ -> _lhsInm2ref `Map.union` _bindsInm2refGath + , _bindsInm2refGath `Map.union` _lhsInm2ref + )) of + { __tup2 -> + (case (__tup2) of + { (_bindsOnm2ref,_) -> + (case (binds_1 _bindsOevalCtx _bindsOletBindingsCateg _bindsOnm2ref _bindsOopts _bindsOstackDepth) of + { ( _bindsIcrb,_bindsIrefOffsetMax,_bindsIstackDepth,_bindsIstackDepthMax) -> + (case (_bindsIstackDepth) of + { _bodyOstackDepth -> + (case (__tup2) of + { (_,_bodyOnm2ref) -> + (case (_lhsItailCtx) of + { _bodyOtailCtx -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_evalCtx) of + { _bodyOevalCtx -> + (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of + { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax) -> + (case (if _isGlobal + then _bindsIcrb ++ _bodyIcrb + else []) of + { _lhsOcrb -> + (case (__tup1) of + { (_nm2refNew,_) -> + (case (if _isGlobal + then _bodyIcre + else CR.Exp_Let _lhsIlev _lhsIrefOffset (CR.nm2RefMpInverse _nm2refNew) (CR.mkCRArray $ map snd _bindsIcrb) _bodyIcre) of + { _creBase -> + (case (_creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (max _bindsIrefOffsetMax _bodyIrefOffsetMax) of + { _refOffsetMax -> + (case (_refOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_bodyIstackDepth) of + { _lhsOstackDepth -> + (case (max _bindsIstackDepthMax _bodyIstackDepthMax) of + { _stackDepthMax -> + (case (_stackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Let_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Let_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (func_) of + { ( _funcIwhatBelow,func_1) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_App_1 :: T_CExpr_1 + sem_CExpr_App_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (_lhsIrefOffset) of + { _funcOrefOffset -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsImodNr) of + { _funcOmodNr -> + (case (_lhsIlev) of + { _funcOlev -> + (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of + { ( _funcInm2refGath,_funcIrefOffset,func_2) -> + (case (_funcIrefOffset) of + { _argOrefOffset -> + (case (_lhsImodNr) of + { _argOmodNr -> + (case (_lhsIlev) of + { _argOlev -> + (case (False) of + { _isGlobal -> + (case (_isGlobal) of + { _argOisGlobal -> + (case (EvalCtx_Thunk) of + { _argOevalCtx -> + (case (arg_ _argOevalCtx _argOisGlobal _argOlev _argOmodNr _argOrefOffset) of + { ( _argInm2refGath,_argIrefOffset,arg_1) -> + (case (_funcInm2refGath `Map.union` _argInm2refGath) of + { _lhsOnm2refGath -> + (case (_argIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_App_2 :: T_CExpr_2 + sem_CExpr_App_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _funcOtailCtx -> + (case (_lhsIstackDepth) of + { _funcOstackDepth -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsInm2ref) of + { _funcOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (False) of + { _funcOisTopApp -> + (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of + { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax) -> + (case (_funcIappFunKind) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (_lhsInm2ref) of + { _argOnm2ref -> + (case (_funcIcreAppFun) of + { _creAppFun -> + (case (if whatExprIsTup _funcIwhatBelow || whatExprIsFFI _funcIwhatBelow then _lhsIstackDepth else _funcIstackDepth) of + { _stackDepthFunc -> + (case (_stackDepthFunc) of + { _argOstackDepth -> + (case (hsnUnknown) of + { _argOnm -> + (case (_lhsIopts) of + { _argOopts -> + (case (acoreBindcategPlain) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg -> + (case (_isTopTup) of + { _argOisTopTup -> + (case (True) of + { _argOisTopApp -> + (case (arg_1 _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOnm _argOnm2ref _argOopts _argOstackDepth) of + { ( _argIcrb,_argIrefOffsetMax,_argIstackDepth,_argIstackDepthMax) -> + (case ((snd $ head _argIcrb) : _funcIcreAppArgL) of + { _creAppArgL -> + (case (isNothing $ whatExprMbApp _lhsIwhatAbove) of + { _isTopApp' -> + (case (if _isTopApp' + then _creAppFun _lhsItailCtx $ CR.mkCRArray $ reverse _creAppArgL + else dbg "Core.ToCoreRun.CExpr.App.cre") of + { _creBase -> + (case (_creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (_funcImbFFIApp) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_funcIrefOffsetMax `max` _argIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (if _isTopApp' then _lhsIstackDepth + 1 else _argIstackDepth) of + { _lhsOstackDepth -> + (case (max _argIstackDepth _argIstackDepthMax) of + { _stackDepthMax -> + (case (_stackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_App_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_App_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (body_) of + { ( _bodyIwhatBelow,body_1) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Lam_1 :: T_CExpr_1 + sem_CExpr_Lam_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsImodNr) of + { _bodyOmodNr -> + (case (not $ whatExprIsLam _lhsIwhatAbove) of + { _isTopLam -> + (case (if _isTopLam then _lhsIlev + 1 else _lhsIlev) of + { _lev -> + (case (_lev) of + { _bodyOlev -> + (case (if _isTopLam + then (0,1) + else (_lhsIrefOffset, _lhsIrefOffset + 1)) of + { __tup3 -> + (case (__tup3) of + { (_,_refOffsetBody) -> + (case (_refOffsetBody) of + { _bodyOrefOffset -> + (case (__tup3) of + { (_refOffset,_) -> + (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of + { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> + (case (_refOffset) of + { _bindOrefOffset -> + (case (_lhsImodNr) of + { _bindOmodNr -> + (case (_lev) of + { _bindOlev -> + (case (False) of + { _isGlobal -> + (case (_isGlobal) of + { _bindOisGlobal -> + (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of + { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) -> + (case (Map.insert _bindInm (CR.RRef_Loc _lev _refOffset) _bodyInm2refGath) of + { _nm2refNew -> + (case (if _isTopLam + then Map.empty + else _nm2refNew) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Lam_2 :: T_CExpr_2 + sem_CExpr_Lam_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (if _isTopLam + then _nm2refNew `Map.union` _lhsInm2ref + else _lhsInm2ref) of + { _nm2ref -> + (case (_nm2ref) of + { _bodyOnm2ref -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_refOffsetBody) of + { _bodyOstackDepth -> + (case (TailCtx_TailCall) of + { _bodyOtailCtx -> + (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of + { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax) -> + (case (_bindInm : _bodyIcreLamArgL) of + { _creLamArgL -> + (case (max _bodyIstackDepth _bodyIstackDepthMax) of + { _stackDepthMax -> + (case (max _bodyIrefOffset _bodyIrefOffsetMax) of + { _refOffsetMax -> + (case (if _isTopLam + then CR.Exp_Lam _lev (length _creLamArgL) (_refOffsetMax) (_stackDepthMax) (CR.nm2RefMpInverse _nm2refNew) _bodyIcreLamBody + else dbg "Core.ToCoreRun.CExpr.Lam.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_bodyIcreLamBody) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (_bindInm) of + { _argNm -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_refOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_bodyIstackDepth) of + { _lhsOstackDepth -> + (case (_stackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Lam_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Lam_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Case_1 :: T_CExpr_1 + sem_CExpr_Case_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _dfltOwhatAbove -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprIrefOffset) of + { _altsOrefOffset -> + (case (alts_ _altsOrefOffset) of + { ( _altsIrefOffset,alts_1) -> + (case (_altsIrefOffset) of + { _dfltOrefOffset -> + (case (_lhsImodNr) of + { _dfltOmodNr -> + (case (_lhsIlev) of + { _dfltOlev -> + (case (dflt_) of + { ( _dfltIwhatBelow,dflt_1) -> + (case (dflt_1 _dfltOlev _dfltOmodNr _dfltOrefOffset _dfltOwhatAbove) of + { ( _dfltInm2refGath,_dfltIrefOffset,dflt_2) -> + (case (_exprInm2refGath `Map.union` _dfltInm2refGath) of + { _lhsOnm2refGath -> + (case (_dfltIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Case_2 :: T_CExpr_2 + sem_CExpr_Case_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (_lhsItailCtx) of + { _altsOtailCtx -> + (case (_lhsInm2ref) of + { _altsOnm2ref -> + (case (_lhsImodNr) of + { _altsOmodNr -> + (case (_lhsIlev) of + { _altsOlev -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (maybe CR.noRRef (\n -> maybe (CR.RRef_Dbg n) id $ Map.lookup n _lhsInm2ref) $ whatExprMbVar _exprIwhatBelow) of + { _altsOscrutRef -> + (case (_lhsIstackDepth) of + { _altsOstackDepth -> + (case (_lhsIopts) of + { _altsOopts -> + (case (_lhsIevalCtx) of + { _altsOevalCtx -> + (case (alts_1 _altsOevalCtx _altsOlev _altsOmodNr _altsOnm2ref _altsOopts _altsOscrutRef _altsOstackDepth _altsOtailCtx) of + { ( _altsIcra,_altsIrefOffsetMax,_altsIstackDepth,_altsIstackDepthMax) -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsIopts) of + { _exprOopts -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _exprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (TailCtx_Plain) of + { _exprOtailCtx -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (CR.Exp_Case _exprIcrse $ CR.mkCRArray _altsIcra) of + { _creBase -> + (case (_creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _dfltOtailCtx -> + (case (_altsIstackDepth) of + { _dfltOstackDepth -> + (case (_lhsIopts) of + { _dfltOopts -> + (case (_lhsInm2ref) of + { _dfltOnm2ref -> + (case (_isTopTup) of + { _dfltOisTopTup -> + (case (_isTopApp) of + { _dfltOisTopApp -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx -> + (case (dflt_2 _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOnm2ref _dfltOopts _dfltOstackDepth _dfltOtailCtx) of + { ( _dfltIappFunKind,_dfltIcrb,_dfltIcre,_dfltIcreAppArgL,_dfltIcreAppFun,_dfltIcreLamArgL,_dfltIcreLamBody,_dfltIcrse,_dfltImbFFIApp,_dfltImbLam,_dfltImbVar,_dfltIrefOffsetMax,_dfltIstackDepth,_dfltIstackDepthMax) -> + (case (_exprIrefOffsetMax `max` _altsIrefOffsetMax `max` _dfltIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (max _exprIstackDepthMax _altsIstackDepthMax) of + { _stackDepthMax -> + (case (_stackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Case_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Case_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIwhatBelow,errorExpr_1) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1 + sem_CExpr_CaseAltFail_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _errorExprOwhatAbove -> + (case (_lhsIrefOffset) of + { _errorExprOrefOffset -> + (case (_lhsImodNr) of + { _errorExprOmodNr -> + (case (_lhsIlev) of + { _errorExprOlev -> + (case (errorExpr_1 _errorExprOlev _errorExprOmodNr _errorExprOrefOffset _errorExprOwhatAbove) of + { ( _errorExprInm2refGath,_errorExprIrefOffset,errorExpr_2) -> + (case (_errorExprInm2refGath) of + { _lhsOnm2refGath -> + (case (_errorExprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2 + sem_CExpr_CaseAltFail_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (_lhsItailCtx) of + { _errorExprOtailCtx -> + (case (_lhsIstackDepth) of + { _errorExprOstackDepth -> + (case (_lhsIopts) of + { _errorExprOopts -> + (case (_lhsInm2ref) of + { _errorExprOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _errorExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _errorExprOisTopApp -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx -> + (case (errorExpr_2 _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOnm2ref _errorExprOopts _errorExprOstackDepth _errorExprOtailCtx) of + { ( _errorExprIappFunKind,_errorExprIcrb,_errorExprIcre,_errorExprIcreAppArgL,_errorExprIcreAppFun,_errorExprIcreLamArgL,_errorExprIcreLamBody,_errorExprIcrse,_errorExprImbFFIApp,_errorExprImbLam,_errorExprImbVar,_errorExprIrefOffsetMax,_errorExprIstackDepth,_errorExprIstackDepthMax) -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (_errorExprImbLam) of + { _lhsOmbLam -> + (case (_errorExprImbVar) of + { _lhsOmbVar -> + (case (_errorExprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_CaseAltFail_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) })) + in sem_CExpr_CaseAltFail_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1 + sem_CExpr_TupDel_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprIrefOffset) of + { _offsetOrefOffset -> + (case (_lhsImodNr) of + { _offsetOmodNr -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (offset_) of + { ( _offsetIwhatBelow,offset_1) -> + (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of + { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> + (case (_exprInm2refGath `Map.union` _offsetInm2refGath) of + { _lhsOnm2refGath -> + (case (_offsetIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2 + sem_CExpr_TupDel_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _offsetOtailCtx -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsItailCtx) of + { _exprOtailCtx -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (_exprIstackDepth) of + { _offsetOstackDepth -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsInm2ref) of + { _offsetOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of + { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax) -> + (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupDel_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupDel_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1 + sem_CExpr_TupIns_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprIrefOffset) of + { _offsetOrefOffset -> + (case (offset_) of + { ( _offsetIwhatBelow,offset_1) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsImodNr) of + { _offsetOmodNr -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of + { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> + (case (_offsetIrefOffset) of + { _fldExprOrefOffset -> + (case (_lhsImodNr) of + { _fldExprOmodNr -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (fldExpr_) of + { ( _fldExprIwhatBelow,fldExpr_1) -> + (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of + { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) -> + (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of + { _lhsOnm2refGath -> + (case (_fldExprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2 + sem_CExpr_TupIns_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _fldExprOtailCtx -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsItailCtx) of + { _exprOtailCtx -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (_exprIstackDepth) of + { _offsetOstackDepth -> + (case (_lhsItailCtx) of + { _offsetOtailCtx -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsInm2ref) of + { _offsetOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of + { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax) -> + (case (_offsetIstackDepth) of + { _fldExprOstackDepth -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsInm2ref) of + { _fldExprOnm2ref -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of + { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax) -> + (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupIns_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupIns_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1 + sem_CExpr_TupUpd_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIrefOffset) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprIrefOffset) of + { _offsetOrefOffset -> + (case (offset_) of + { ( _offsetIwhatBelow,offset_1) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsImodNr) of + { _offsetOmodNr -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of + { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> + (case (_offsetIrefOffset) of + { _fldExprOrefOffset -> + (case (_lhsImodNr) of + { _fldExprOmodNr -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (fldExpr_) of + { ( _fldExprIwhatBelow,fldExpr_1) -> + (case (fldExpr_1 _fldExprOlev _fldExprOmodNr _fldExprOrefOffset _fldExprOwhatAbove) of + { ( _fldExprInm2refGath,_fldExprIrefOffset,fldExpr_2) -> + (case (_exprInm2refGath `Map.union` _offsetInm2refGath `Map.union` _fldExprInm2refGath) of + { _lhsOnm2refGath -> + (case (_fldExprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2 + sem_CExpr_TupUpd_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _fldExprOtailCtx -> + (case (_lhsIstackDepth) of + { _exprOstackDepth -> + (case (_lhsItailCtx) of + { _exprOtailCtx -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (_exprIstackDepth) of + { _offsetOstackDepth -> + (case (_lhsItailCtx) of + { _offsetOtailCtx -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsInm2ref) of + { _offsetOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of + { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax) -> + (case (_offsetIstackDepth) of + { _fldExprOstackDepth -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsInm2ref) of + { _fldExprOnm2ref -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (fldExpr_2 _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOnm2ref _fldExprOopts _fldExprOstackDepth _fldExprOtailCtx) of + { ( _fldExprIappFunKind,_fldExprIcrb,_fldExprIcre,_fldExprIcreAppArgL,_fldExprIcreAppFun,_fldExprIcreLamArgL,_fldExprIcreLamBody,_fldExprIcrse,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIrefOffsetMax,_fldExprIstackDepth,_fldExprIstackDepthMax) -> + (case (_exprIrefOffsetMax `max` _offsetIrefOffsetMax `max` _fldExprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupUpd_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupUpd_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (ExprIsFFI) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_FFI_1 :: T_CExpr_1 + sem_CExpr_FFI_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_FFI_2 :: T_CExpr_2 + sem_CExpr_FFI_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (foreignEntExtract impEnt_) of + { _foreignEntInfo -> + (case (forextractMbEnt _foreignEntInfo >>= flip Map.lookup CR.allRunPrimMp) of + { _creEntMb -> + (case (\as -> maybe (dbg $ "Core.ToCoreRun.CExpr.FFI.cre: " ++ show _foreignEntInfo) (\ent -> CR.Exp_FFI ent as) _creEntMb) of + { _creMk -> + (case (_creMk CR.emptyCRArray) of + { _creBase -> + (case (_creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\_ -> cseCtxWrap TailCtx_Plain . _creMk) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo) of + { _mbPrimNeedEval -> + (case (maybe False primResNeedEval _mbPrimNeedEval) of + { _primResNeedsEval -> + (case (appUnArr ty_) of + { _argTyLresTy -> + (case (snd _argTyLresTy) of + { _resTy -> + (case (fst _argTyLresTy) of + { _argTyL -> + (case (Just ( _resTy + , _primResNeedsEval + , callconv_ + , impEnt_ + , _argTyL + )) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_FFI_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_FFI_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1 + sem_CExpr_Dbg_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2 + sem_CExpr_Dbg_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Dbg_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Dbg_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Hole_1 :: T_CExpr_1 + sem_CExpr_Hole_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Hole_2 :: T_CExpr_2 + sem_CExpr_Hole_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Hole_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_Hole_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1 + sem_CExpr_HoleLet_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIrefOffset) of + { _bodyOrefOffset -> + (case (_lhsImodNr) of + { _bodyOmodNr -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (body_) of + { ( _bodyIwhatBelow,body_1) -> + (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of + { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> + (case (_bodyInm2refGath) of + { _lhsOnm2refGath -> + (case (_bodyIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2 + sem_CExpr_HoleLet_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _bodyOtailCtx -> + (case (_lhsIstackDepth) of + { _bodyOstackDepth -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsInm2ref) of + { _bodyOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of + { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax) -> + (case (_bodyIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_HoleLet_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_HoleLet_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1 + sem_CExpr_CoeArg_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (Map.empty) of + { _lhsOnm2refGath -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2 + sem_CExpr_CoeArg_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (0) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_CoeArg_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) })) + in sem_CExpr_CoeArg_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1 + sem_CExpr_ImplsApp_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsIrefOffset) of + { _funcOrefOffset -> + (case (_lhsImodNr) of + { _funcOmodNr -> + (case (_lhsIlev) of + { _funcOlev -> + (case (func_) of + { ( _funcIwhatBelow,func_1) -> + (case (func_1 _funcOlev _funcOmodNr _funcOrefOffset _funcOwhatAbove) of + { ( _funcInm2refGath,_funcIrefOffset,func_2) -> + (case (_funcInm2refGath) of + { _lhsOnm2refGath -> + (case (_funcIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2 + sem_CExpr_ImplsApp_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _funcOtailCtx -> + (case (_lhsIstackDepth) of + { _funcOstackDepth -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsInm2ref) of + { _funcOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _funcOisTopApp -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (func_2 _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOnm2ref _funcOopts _funcOstackDepth _funcOtailCtx) of + { ( _funcIappFunKind,_funcIcrb,_funcIcre,_funcIcreAppArgL,_funcIcreAppFun,_funcIcreLamArgL,_funcIcreLamBody,_funcIcrse,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIrefOffsetMax,_funcIstackDepth,_funcIstackDepthMax) -> + (case (_funcIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsApp_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsApp_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1 + sem_CExpr_ImplsLam_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIrefOffset) of + { _bodyOrefOffset -> + (case (_lhsImodNr) of + { _bodyOmodNr -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (body_) of + { ( _bodyIwhatBelow,body_1) -> + (case (body_1 _bodyOlev _bodyOmodNr _bodyOrefOffset _bodyOwhatAbove) of + { ( _bodyInm2refGath,_bodyIrefOffset,body_2) -> + (case (_bodyInm2refGath) of + { _lhsOnm2refGath -> + (case (_bodyIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2 + sem_CExpr_ImplsLam_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case ([]) of + { _lhsOcrb -> + (case (dbg "Core.ToCoreRun.CExpr.cre") of + { _creBase -> + (case (cseCtxWrap _lhsItailCtx _creBase) of + { _cre -> + (case (_cre) of + { _lhsOcre -> + (case ([]) of + { _creAppArgL -> + (case (_creAppArgL) of + { _lhsOcreAppArgL -> + (case (\tailCtx -> cseCtxWrap tailCtx . tailrec tailCtx . mkApp _cre) of + { _creAppFun -> + (case (_creAppFun) of + { _lhsOcreAppFun -> + (case ([]) of + { _creLamArgL -> + (case (_creLamArgL) of + { _lhsOcreLamArgL -> + (case (_cre) of + { _creLamBody -> + (case (_creLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (_lhsItailCtx) of + { _bodyOtailCtx -> + (case (_lhsIstackDepth) of + { _bodyOstackDepth -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsInm2ref) of + { _bodyOnm2ref -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (body_2 _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOnm2ref _bodyOopts _bodyOstackDepth _bodyOtailCtx) of + { ( _bodyIappFunKind,_bodyIcrb,_bodyIcre,_bodyIcreAppArgL,_bodyIcreAppFun,_bodyIcreLamArgL,_bodyIcreLamBody,_bodyIcrse,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIrefOffsetMax,_bodyIstackDepth,_bodyIstackDepthMax) -> + (case (_bodyIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_lhsIstackDepth + 1) of + { _stackDepthHere -> + (case (_stackDepthHere) of + { _lhsOstackDepth -> + (case (_stackDepthHere) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsLam_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsLam_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow -> + (case ((let sem_CExpr_Ann_1 :: T_CExpr_1 + sem_CExpr_Ann_1 = + (\ _lhsIlev + _lhsImodNr + _lhsIrefOffset + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove -> + (case (_lhsIrefOffset) of + { _annOrefOffset -> + (case (ann_ _annOrefOffset) of + { ( _annIrefOffset,ann_1) -> + (case (_annIrefOffset) of + { _exprOrefOffset -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprInm2refGath) of + { _lhsOnm2refGath -> + (case (_exprIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExpr_Ann_2 :: T_CExpr_2 + sem_CExpr_Ann_2 = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsInm2ref + _lhsIopts + _lhsIstackDepth + _lhsItailCtx -> + (case (_lhsItailCtx) of + { _exprOtailCtx -> + (case (_lhsIstackDepth) of + { _annOstackDepth -> + (case (_lhsIopts) of + { _annOopts -> + (case (_lhsInm2ref) of + { _annOnm2ref -> + (case (_lhsImodNr) of + { _annOmodNr -> + (case (_lhsIlev) of + { _annOlev -> + (case (ann_1 _annOlev _annOmodNr _annOnm2ref _annOopts _annOstackDepth) of + { ( _annIstackDepth) -> + (case (_annIstackDepth) of + { _exprOstackDepth -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsInm2ref) of + { _exprOnm2ref -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (_exprIappFunKind) of + { _lhsOappFunKind -> + (case (_exprIcrb) of + { _lhsOcrb -> + (case (_exprIcre) of + { _lhsOcre -> + (case (_exprIcreAppArgL) of + { _lhsOcreAppArgL -> + (case (_exprIcreAppFun) of + { _lhsOcreAppFun -> + (case (_exprIcreLamArgL) of + { _lhsOcreLamArgL -> + (case (_exprIcreLamBody) of + { _lhsOcreLamBody -> + (case (panic "Core.ToCoreRun.CExpr.crse") of + { _crse -> + (case (_crse) of + { _lhsOcrse -> + (case (_exprImbFFIApp) of + { _lhsOmbFFIApp -> + (case (_exprImbLam) of + { _lhsOmbLam -> + (case (_exprImbVar) of + { _lhsOmbVar -> + (case (_exprIrefOffsetMax) of + { _lhsOrefOffsetMax -> + (case (_exprIstackDepth) of + { _lhsOstackDepth -> + (case (_exprIstackDepthMax) of + { _lhsOstackDepthMax -> + ( _lhsOappFunKind,_lhsOcrb,_lhsOcre,_lhsOcreAppArgL,_lhsOcreAppFun,_lhsOcreLamArgL,_lhsOcreLamBody,_lhsOcrse,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOrefOffsetMax,_lhsOstackDepth,_lhsOstackDepthMax) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Ann_2)) of + { ( sem_CExpr_2) -> + ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Ann_1)) of + { ( sem_CExpr_1) -> + ( _lhsOwhatBelow,sem_CExpr_1) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + alternatives: + alternative Ty: + child ty : {Ty} + alternative Coe: + child coe : {RelevCoe} + alternative Debug: + child info : {String} +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + ( Int,T_CExprAnn_1) +type T_CExprAnn_1 = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1 + sem_CExprAnn_Ty_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CExprAnn_Ty_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOrefOffset,sem_CExprAnn_1) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1 + sem_CExprAnn_Coe_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CExprAnn_Coe_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOrefOffset,sem_CExprAnn_1) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1 + sem_CExprAnn_Debug_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CExprAnn_Debug_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOrefOffset,sem_CExprAnn_1) }) })) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + alternatives: + alternative Plain: + alternative Function0: + alternative Function1: + alternative Apply0: +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + ( Int,T_CMetaBind_1) +type T_CMetaBind_1 = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( Int) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaBind_Plain_1 :: T_CMetaBind_1 + sem_CMetaBind_Plain_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaBind_Plain_1)) of + { ( sem_CMetaBind_1) -> + ( _lhsOrefOffset,sem_CMetaBind_1) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaBind_Function0_1 :: T_CMetaBind_1 + sem_CMetaBind_Function0_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaBind_Function0_1)) of + { ( sem_CMetaBind_1) -> + ( _lhsOrefOffset,sem_CMetaBind_1) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaBind_Function1_1 :: T_CMetaBind_1 + sem_CMetaBind_Function1_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaBind_Function1_1)) of + { ( sem_CMetaBind_1) -> + ( _lhsOrefOffset,sem_CMetaBind_1) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaBind_Apply0_1 :: T_CMetaBind_1 + sem_CMetaBind_Apply0_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaBind_Apply0_1)) of + { ( sem_CMetaBind_1) -> + ( _lhsOrefOffset,sem_CMetaBind_1) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + alternatives: + alternative Val: + alternative Dict: + alternative DictClass: + child tracks : {[Track]} + alternative DictInstance: + child tracks : {[Track]} + alternative Track: + child track : {Track} +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + ( Int,T_CMetaVal_1) +type T_CMetaVal_1 = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( Int) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaVal_Val_1 :: T_CMetaVal_1 + sem_CMetaVal_Val_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaVal_Val_1)) of + { ( sem_CMetaVal_1) -> + ( _lhsOrefOffset,sem_CMetaVal_1) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaVal_Dict_1 :: T_CMetaVal_1 + sem_CMetaVal_Dict_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaVal_Dict_1)) of + { ( sem_CMetaVal_1) -> + ( _lhsOrefOffset,sem_CMetaVal_1) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaVal_DictClass_1 :: T_CMetaVal_1 + sem_CMetaVal_DictClass_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaVal_DictClass_1)) of + { ( sem_CMetaVal_1) -> + ( _lhsOrefOffset,sem_CMetaVal_1) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaVal_DictInstance_1 :: T_CMetaVal_1 + sem_CMetaVal_DictInstance_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaVal_DictInstance_1)) of + { ( sem_CMetaVal_1) -> + ( _lhsOrefOffset,sem_CMetaVal_1) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetaVal_Track_1 :: T_CMetaVal_1 + sem_CMetaVal_Track_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) })) + in sem_CMetaVal_Track_1)) of + { ( sem_CMetaVal_1) -> + ( _lhsOrefOffset,sem_CMetaVal_1) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + chained attribute: + refOffset : Int + visit 1: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attribute: + stackDepth : Int + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + ( Int,T_CMetas_1) +type T_CMetas_1 = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + ( Int) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIrefOffset -> + (case (_lhsIrefOffset) of + { _x1OrefOffset -> + (case (x1_ _x1OrefOffset) of + { ( _x1IrefOffset,x1_1) -> + (case (_x1IrefOffset) of + { _x2OrefOffset -> + (case (x2_ _x2OrefOffset) of + { ( _x2IrefOffset,x2_1) -> + (case (_x2IrefOffset) of + { _lhsOrefOffset -> + (case ((let sem_CMetas_Tuple_1 :: T_CMetas_1 + sem_CMetas_Tuple_1 = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _x1OstackDepth -> + (case (_lhsIopts) of + { _x1Oopts -> + (case (_lhsInm2ref) of + { _x1Onm2ref -> + (case (_lhsImodNr) of + { _x1OmodNr -> + (case (_lhsIlev) of + { _x1Olev -> + (case (x1_1 _x1Olev _x1OmodNr _x1Onm2ref _x1Oopts _x1OstackDepth) of + { ( _x1IstackDepth) -> + (case (_x1IstackDepth) of + { _x2OstackDepth -> + (case (_lhsIopts) of + { _x2Oopts -> + (case (_lhsInm2ref) of + { _x2Onm2ref -> + (case (_lhsImodNr) of + { _x2OmodNr -> + (case (_lhsIlev) of + { _x2Olev -> + (case (x2_1 _x2Olev _x2OmodNr _x2Onm2ref _x2Oopts _x2OstackDepth) of + { ( _x2IstackDepth) -> + (case (_x2IstackDepth) of + { _lhsOstackDepth -> + ( _lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CMetas_Tuple_1)) of + { ( sem_CMetas_1) -> + ( _lhsOrefOffset,sem_CMetas_1) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + synthesized attributes: + crm : CR.Mod + nm2refGath : CR.Nm2RefMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local tailCtx : _ + local nm2refNew : _ + local crmBinds : _ + local creMod : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + ( (CR.Mod),(CR.Nm2RefMp)) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _exprOtailCtx -> + (case (_lhsImodNr) of + { _exprOmodNr -> + (case (_lhsIlev) of + { _exprOlev -> + (case (0) of + { _exprOrefOffset -> + (case (expr_) of + { ( _exprIwhatBelow,expr_1) -> + (case (expr_1 _exprOlev _exprOmodNr _exprOrefOffset _exprOwhatAbove) of + { ( _exprInm2refGath,_exprIrefOffset,expr_2) -> + (case (_exprInm2refGath) of + { _nm2refNew -> + (case (_nm2refNew `Map.union` _lhsInm2ref) of + { _exprOnm2ref -> + (case (0) of + { _exprOstackDepth -> + (case (_lhsIopts) of + { _exprOopts -> + (case (EvalCtx_Eval) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOnm2ref _exprOopts _exprOstackDepth _exprOtailCtx) of + { ( _exprIappFunKind,_exprIcrb,_exprIcre,_exprIcreAppArgL,_exprIcreAppFun,_exprIcreLamArgL,_exprIcreLamBody,_exprIcrse,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIrefOffsetMax,_exprIstackDepth,_exprIstackDepthMax) -> + (case (CR.mkCRArray $ map snd _exprIcrb) of + { _crmBinds -> + (case (mkApp _exprIcre $ CR.mkCRArray [CR.unit]) of + { _creMod -> + (case (CR.Mod_Mod (CR.nm2RefMpInverse _nm2refNew) + moduleNm_ _lhsImodNr (_exprIstackDepthMax + 2 ) + _crmBinds (CR.Exp_Force _creMod)) of + { _lhsOcrm -> + (case (_exprInm2refGath) of + { _lhsOnm2refGath -> + ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + synthesized attributes: + crp : CR.Pat + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( (CR.Pat),([HsName]),Int,Int) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (CR.Pat_Con CTagRec) of + { _lhsOcrp -> + (case ([]) of + { _lhsOfldNmL -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (CR.Pat_Con tag_) of + { _lhsOcrp -> + (case (_lhsIstackDepth) of + { _restOstackDepth -> + (case (_lhsIrefOffset) of + { _restOrefOffset -> + (case (_lhsIopts) of + { _restOopts -> + (case (_lhsInm2ref) of + { _restOnm2ref -> + (case (_lhsImodNr) of + { _restOmodNr -> + (case (_lhsIlev) of + { _restOlev -> + (case (rest_ _restOlev _restOmodNr _restOnm2ref _restOopts _restOrefOffset _restOstackDepth) of + { ( _restIrefOffset,_restIstackDepth) -> + (case (_restIstackDepth) of + { _bindsOstackDepth -> + (case (_restIrefOffset) of + { _bindsOrefOffset -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsInm2ref) of + { _bindsOnm2ref -> + (case (_lhsImodNr) of + { _bindsOmodNr -> + (case (_lhsIlev) of + { _bindsOlev -> + (case (binds_ _bindsOlev _bindsOmodNr _bindsOnm2ref _bindsOopts _bindsOrefOffset _bindsOstackDepth) of + { ( _bindsIfldNmL,_bindsIrefOffset,_bindsIstackDepth) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (_bindsIrefOffset) of + { _lhsOrefOffset -> + (case (_bindsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (CR.Pat_Con CTagRec) of + { _lhsOcrp -> + (case ([]) of + { _lhsOfldNmL -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (CR.Pat_Con CTagRec) of + { _lhsOcrp -> + (case ([]) of + { _lhsOfldNmL -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (CR.Pat_Con CTagRec) of + { _lhsOcrp -> + (case ([]) of + { _lhsOfldNmL -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOcrp,_lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + synthesized attribute: + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local fldNm : _ + local tailCtx : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( ([HsName]),Int,Int) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _offsetOrefOffset -> + (case (offset_) of + { ( _offsetIwhatBelow,offset_1) -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsImodNr) of + { _offsetOmodNr -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (offset_1 _offsetOlev _offsetOmodNr _offsetOrefOffset _offsetOwhatAbove) of + { ( _offsetInm2refGath,_offsetIrefOffset,offset_2) -> + (case (_offsetIrefOffset) of + { _bindOrefOffset -> + (case (_lhsImodNr) of + { _bindOmodNr -> + (case (_lhsIlev) of + { _bindOlev -> + (case (False) of + { _bindOisGlobal -> + (case (bind_ _bindOisGlobal _bindOlev _bindOmodNr _bindOrefOffset) of + { ( _bindInm,_bindInm2refGath,_bindIrefOffset,bind_1) -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (_bindIrefOffset) of + { _fldAnnsOrefOffset -> + (case (_lhsIstackDepth) of + { _offsetOstackDepth -> + (case (TailCtx_Plain) of + { _tailCtx -> + (case (_tailCtx) of + { _offsetOtailCtx -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsInm2ref) of + { _offsetOnm2ref -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx -> + (case (True) of + { _offsetOisTopTup -> + (case (True) of + { _offsetOisTopApp -> + (case (offset_2 _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOnm2ref _offsetOopts _offsetOstackDepth _offsetOtailCtx) of + { ( _offsetIappFunKind,_offsetIcrb,_offsetIcre,_offsetIcreAppArgL,_offsetIcreAppFun,_offsetIcreLamArgL,_offsetIcreLamBody,_offsetIcrse,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIrefOffsetMax,_offsetIstackDepth,_offsetIstackDepthMax) -> + (case (_offsetIstackDepth) of + { _bindOstackDepth -> + (case (EvalCtx_None) of + { _bindOevalCtx -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_lhsInm2ref) of + { _bindOnm2ref -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg -> + (case (bind_1 _bindOevalCtx _bindOletBindingsCateg _bindOnm2ref _bindOopts _bindOstackDepth) of + { ( _bindIcrb,_bindIrefOffsetMax,_bindIstackDepth,_bindIstackDepthMax) -> + (case (_bindIstackDepth) of + { _fldAnnsOstackDepth -> + (case (_lhsIopts) of + { _fldAnnsOopts -> + (case (_lhsInm2ref) of + { _fldAnnsOnm2ref -> + (case (_lhsImodNr) of + { _fldAnnsOmodNr -> + (case (_lhsIlev) of + { _fldAnnsOlev -> + (case (fldAnns_ _fldAnnsOlev _fldAnnsOmodNr _fldAnnsOnm2ref _fldAnnsOopts _fldAnnsOrefOffset _fldAnnsOstackDepth) of + { ( _fldAnnsIrefOffset,_fldAnnsIstackDepth) -> + (case (_fldAnnsIrefOffset) of + { _lhsOrefOffset -> + (case (_fldAnnsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + synthesized attribute: + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( ([HsName]),Int,Int) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIstackDepth) of + { _hdOstackDepth -> + (case (_lhsIrefOffset) of + { _hdOrefOffset -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsInm2ref) of + { _hdOnm2ref -> + (case (_lhsImodNr) of + { _hdOmodNr -> + (case (hd_ _hdOlev _hdOmodNr _hdOnm2ref _hdOopts _hdOrefOffset _hdOstackDepth) of + { ( _hdIfldNmL,_hdIrefOffset,_hdIstackDepth) -> + (case (_hdIstackDepth) of + { _tlOstackDepth -> + (case (_hdIrefOffset) of + { _tlOrefOffset -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsInm2ref) of + { _tlOnm2ref -> + (case (_lhsImodNr) of + { _tlOmodNr -> + (case (_lhsIlev) of + { _tlOlev -> + (case (tl_ _tlOlev _tlOmodNr _tlOnm2ref _tlOopts _tlOrefOffset _tlOstackDepth) of + { ( _tlIfldNmL,_tlIrefOffset,_tlIstackDepth) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_tlIrefOffset) of + { _lhsOrefOffset -> + (case (_tlIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case ([]) of + { _lhsOfldNmL -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOfldNmL,_lhsOrefOffset,_lhsOstackDepth) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + chained attributes: + refOffset : Int + stackDepth : Int + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + Int -> + Int -> + ( Int,Int) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOrefOffset,_lhsOstackDepth) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev + _lhsImodNr + _lhsInm2ref + _lhsIopts + _lhsIrefOffset + _lhsIstackDepth -> + (case (_lhsIrefOffset) of + { _lhsOrefOffset -> + (case (_lhsIstackDepth) of + { _lhsOstackDepth -> + ( _lhsOrefOffset,_lhsOstackDepth) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + modNr : Int + nm2ref : CR.Nm2RefMp + opts : EHCOpts + synthesized attributes: + crm : CR.Mod + nm2refGath : CR.Nm2RefMp + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = Int -> + (CR.Nm2RefMp) -> + EHCOpts -> + ( (CR.Mod),(CR.Nm2RefMp)) +data Inh_CodeAGItf = Inh_CodeAGItf {modNr_Inh_CodeAGItf :: !(Int),nm2ref_Inh_CodeAGItf :: !((CR.Nm2RefMp)),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {crm_Syn_CodeAGItf :: !((CR.Mod)),nm2refGath_Syn_CodeAGItf :: !((CR.Nm2RefMp))} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsImodNr _lhsInm2ref _lhsIopts) = + (let ( _lhsOcrm,_lhsOnm2refGath) = sem _lhsImodNr _lhsInm2ref _lhsIopts + in (Syn_CodeAGItf _lhsOcrm _lhsOnm2refGath)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsImodNr + _lhsInm2ref + _lhsIopts -> + (case (_lhsInm2ref) of + { _moduleOnm2ref -> + (case (_lhsImodNr) of + { _moduleOmodNr -> + (case (cLevModule) of + { _moduleOlev -> + (case (_lhsIopts) of + { _moduleOopts -> + (case (module_ _moduleOlev _moduleOmodNr _moduleOnm2ref _moduleOopts) of + { ( _moduleIcrm,_moduleInm2refGath) -> + (case (_moduleIcrm) of + { _lhsOcrm -> + (case (_moduleInm2refGath) of + { _lhsOnm2refGath -> + ( _lhsOcrm,_lhsOnm2refGath) }) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/ToGrin.hs b/src/UHC/Light/Compiler/Core/ToGrin.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/ToGrin.hs @@ -0,0 +1,4471 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/ToGrin.ag) +module UHC.Light.Compiler.Core.ToGrin(Inh_CodeAGItf (..), Syn_CodeAGItf (..), wrap_CodeAGItf, sem_CodeAGItf) where + +import Data.Char +import Data.Maybe +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.Utils +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Core.FFI +import Debug.Trace +import Control.Monad +import Control.Monad.State +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.CodeGen.ImportUsedModules +import UHC.Light.Compiler.CodeGen.BuiltinPrims + + + + + + + + + + + + + + + + + + + + + + +-- CAlt -------------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 1: + local whatAbove : {WhatExpr} + local lev : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = UID -> + ( UID,T_CAlt_1) +type T_CAlt_1 = DataGam -> + EvalCtx -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _patOgUniq -> + (case (pat_ _patOgUniq) of + { ( _patIgUniq,pat_1) -> + (case (_patIgUniq) of + { _exprOgUniq -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CAlt_Alt_1 :: T_CAlt_1 + sem_CAlt_Alt_1 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev + 1) of + { _lev -> + (case (_lev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_lhsIopts) of + { _patOopts -> + (case (_lhsImodNm) of + { _patOmodNm -> + (case (_lev) of + { _patOlev -> + (case (_lhsIlamMp) of + { _patOlamMp -> + (case (_lhsIdataGam) of + { _patOdataGam -> + (case (pat_1 _patOdataGam _patOlamMp _patOlev _patOmodNm _patOopts) of + { ( _patIfldNmL,_patIfvS,_patInmL) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CAlt_Alt_1)) of + { ( sem_CAlt_1) -> + ( _lhsOgUniq,sem_CAlt_1) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = UID -> + ( UID,T_CAltL_1) +type T_CAltL_1 = DataGam -> + EvalCtx -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (hd_ _hdOgUniq) of + { ( _hdIgUniq,hd_1) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (tl_ _tlOgUniq) of + { ( _tlIgUniq,tl_1) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CAltL_Cons_1 :: T_CAltL_1 + sem_CAltL_Cons_1 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImodNm) of + { _tlOmodNm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIlamMp) of + { _tlOlamMp -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_1 _tlOdataGam _tlOevalCtx _tlOlamMp _tlOlev _tlOmodNm _tlOopts) of + { ( _tlIfvS) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImodNm) of + { _hdOmodNm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIlamMp) of + { _hdOlamMp -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_1 _hdOdataGam _hdOevalCtx _hdOlamMp _hdOlev _hdOmodNm _hdOopts) of + { ( _hdIfvS) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CAltL_Cons_1)) of + { ( sem_CAltL_1) -> + ( _lhsOgUniq,sem_CAltL_1) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CAltL_Nil_1 :: T_CAltL_1 + sem_CAltL_Nil_1 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) + in sem_CAltL_Nil_1)) of + { ( sem_CAltL_1) -> + ( _lhsOgUniq,sem_CAltL_1) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + bindLamMp : LamMp + nm : HsName + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ( LamMp,HsName,T_CBind_1) +type T_CBind_1 = UID -> + ( UID,T_CBind_2) +type T_CBind_2 = DataGam -> + EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( FvS,FvSMp,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_ _bindAspectsOnm) of + { ( _bindAspectsIbindLamMp,bindAspects_1) -> + (case (_bindAspectsIbindLamMp) of + { _lhsObindLamMp -> + (case (nm_) of + { _lhsOnm -> + (case ((let sem_CBind_Bind_1 :: T_CBind_1 + sem_CBind_Bind_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _bindAspectsOgUniq -> + (case (bindAspects_1 _bindAspectsOgUniq) of + { ( _bindAspectsIgUniq,bindAspects_2) -> + (case (_bindAspectsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBind_Bind_2 :: T_CBind_2 + sem_CBind_Bind_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts -> + (case (_lhsImodNm) of + { _bindAspectsOmodNm -> + (case (_lhsIlev) of + { _bindAspectsOlev -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg -> + (case (_lhsIlamMp) of + { _bindAspectsOlamMp -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx -> + (case (_lhsIdataGam) of + { _bindAspectsOdataGam -> + (case (bindAspects_2 _bindAspectsOdataGam _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOlamMp _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNm _bindAspectsOopts) of + { ( _bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp -> + (case ([nm_]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBind_Bind_2)) of + { ( sem_CBind_2) -> + ( _lhsOgUniq,sem_CBind_2) }) }) }) })) + in sem_CBind_Bind_1)) of + { ( sem_CBind_1) -> + ( _lhsObindLamMp,_lhsOnm,sem_CBind_1) }) }) }) }) }) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = UID -> + ( UID,T_CBindAnn_1) +type T_CBindAnn_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBindAnn_Coe_1 :: T_CBindAnn_1 + sem_CBindAnn_Coe_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) })) + in sem_CBindAnn_Coe_1)) of + { ( sem_CBindAnn_1) -> + ( _lhsOgUniq,sem_CBindAnn_1) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = UID -> + ( UID,T_CBindAnnL_1) +type T_CBindAnnL_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (hd_ _hdOgUniq) of + { ( _hdIgUniq,hd_1) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (tl_ _tlOgUniq) of + { ( _tlIgUniq,tl_1) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBindAnnL_Cons_1 :: T_CBindAnnL_1 + sem_CBindAnnL_Cons_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImodNm) of + { _tlOmodNm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIlamMp) of + { _tlOlamMp -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_1 _tlOdataGam _tlOlamMp _tlOlev _tlOmodNm _tlOopts) of + { ( _tlIfvS,_tlInmL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImodNm) of + { _hdOmodNm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIlamMp) of + { _hdOlamMp -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_1 _hdOdataGam _hdOlamMp _hdOlev _hdOmodNm _hdOopts) of + { ( _hdIfvS,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBindAnnL_Cons_1)) of + { ( sem_CBindAnnL_1) -> + ( _lhsOgUniq,sem_CBindAnnL_1) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBindAnnL_Nil_1 :: T_CBindAnnL_1 + sem_CBindAnnL_Nil_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) })) + in sem_CBindAnnL_Nil_1)) of + { ( sem_CBindAnnL_1) -> + ( _lhsOgUniq,sem_CBindAnnL_1) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + bindLamMp : LamMp + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ( LamMp,T_CBindL_1) +type T_CBindL_1 = UID -> + ( UID,T_CBindL_2) +type T_CBindL_2 = DataGam -> + EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIbindLamMp,tl_1) -> + (case (hd_) of + { ( _hdIbindLamMp,_hdInm,hd_1) -> + (case (_hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp) of + { _lhsObindLamMp -> + (case ((let sem_CBindL_Cons_1 :: T_CBindL_1 + sem_CBindL_Cons_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBindL_Cons_2 :: T_CBindL_2 + sem_CBindL_Cons_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImodNm) of + { _tlOmodNm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (_lhsIlamMp) of + { _tlOlamMp -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_2 _tlOdataGam _tlOevalCtx _tlOisGlobal _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOmodNm _tlOopts) of + { ( _tlIfvS,_tlIfvSMp,_tlInmL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImodNm) of + { _hdOmodNm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (_lhsIlamMp) of + { _hdOlamMp -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_2 _hdOdataGam _hdOevalCtx _hdOisGlobal _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOmodNm _hdOopts) of + { ( _hdIfvS,_hdIfvSMp,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBindL_Cons_2)) of + { ( sem_CBindL_2) -> + ( _lhsOgUniq,sem_CBindL_2) }) }) }) }) }) })) + in sem_CBindL_Cons_1)) of + { ( sem_CBindL_1) -> + ( _lhsObindLamMp,sem_CBindL_1) }) }) }) }) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBindL_Nil_1 :: T_CBindL_1 + sem_CBindL_Nil_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBindL_Nil_2 :: T_CBindL_2 + sem_CBindL_Nil_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) + in sem_CBindL_Nil_2)) of + { ( sem_CBindL_2) -> + ( _lhsOgUniq,sem_CBindL_2) }) })) + in sem_CBindL_Nil_1)) of + { ( sem_CBindL_1) -> + ( _lhsObindLamMp,sem_CBindL_1) }) }) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attribute: + bindLamMp : LamMp + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 2: + local whatAbove : {WhatExpr} + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 2: + local whatAbove : {WhatExpr} + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 2: + local whatAbove : {WhatExpr} +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = HsName -> + ( LamMp,T_CBound_1) +type T_CBound_1 = UID -> + ( UID,T_CBound_2) +type T_CBound_2 = DataGam -> + EvalCtx -> + Bool -> + Bool -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (Map.singleton _lhsInm + (emptyLamInfo {laminfoArity = length _exprIgrLamArgL})) of + { _lhsObindLamMp -> + (case ((let sem_CBound_Bind_1 :: T_CBound_1 + sem_CBound_Bind_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _exprOgUniq -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_Bind_2 :: T_CBound_2 + sem_CBound_Bind_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_lhsIopts) of + { _bindMetaOopts -> + (case (_lhsImodNm) of + { _bindMetaOmodNm -> + (case (_lhsIlev) of + { _bindMetaOlev -> + (case (_lhsIlamMp) of + { _bindMetaOlamMp -> + (case (_lhsIdataGam) of + { _bindMetaOdataGam -> + (case (bindMeta_ _bindMetaOdataGam _bindMetaOlamMp _bindMetaOlev _bindMetaOmodNm _bindMetaOopts) of + { ( _bindMetaIfvS) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Bind_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) }) }) })) + in sem_CBound_Bind_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBound_Meta_1 :: T_CBound_1 + sem_CBound_Meta_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_Meta_2 :: T_CBound_2 + sem_CBound_Meta_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _cmetasOopts -> + (case (_lhsImodNm) of + { _cmetasOmodNm -> + (case (_lhsIlev) of + { _cmetasOlev -> + (case (_lhsIlamMp) of + { _cmetasOlamMp -> + (case (_lhsIdataGam) of + { _cmetasOdataGam -> + (case (cmetas_ _cmetasOdataGam _cmetasOlamMp _cmetasOlev _cmetasOmodNm _cmetasOopts) of + { ( _cmetasIfvS) -> + (case (_cmetasIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) })) + in sem_CBound_Meta_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) })) + in sem_CBound_Meta_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 + sem_CBound_RelevTy_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_RelevTy_2 :: T_CBound_2 + sem_CBound_RelevTy_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) + in sem_CBound_RelevTy_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) })) + in sem_CBound_RelevTy_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBound_Val_1 :: T_CBound_1 + sem_CBound_Val_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _exprOgUniq -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_Val_2 :: T_CBound_2 + sem_CBound_Val_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (ExprIsBind) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Val_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) }) }) }) })) + in sem_CBound_Val_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBound_Ty_1 :: T_CBound_1 + sem_CBound_Ty_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_Ty_2 :: T_CBound_2 + sem_CBound_Ty_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) + in sem_CBound_Ty_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) })) + in sem_CBound_Ty_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBound_FFE_1 :: T_CBound_1 + sem_CBound_FFE_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _exprOgUniq -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBound_FFE_2 :: T_CBound_2 + sem_CBound_FFE_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (ExprIsLam 0) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_FFE_2)) of + { ( sem_CBound_2) -> + ( _lhsOgUniq,sem_CBound_2) }) }) }) }) })) + in sem_CBound_FFE_1)) of + { ( sem_CBound_1) -> + ( _lhsObindLamMp,sem_CBound_1) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attribute: + bindLamMp : LamMp + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = HsName -> + ( LamMp,T_CBoundL_1) +type T_CBoundL_1 = UID -> + ( UID,T_CBoundL_2) +type T_CBoundL_2 = DataGam -> + EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsInm -> + (case (_lhsInm) of + { _tlOnm -> + (case (_lhsInm) of + { _hdOnm -> + (case (tl_ _tlOnm) of + { ( _tlIbindLamMp,tl_1) -> + (case (hd_ _hdOnm) of + { ( _hdIbindLamMp,hd_1) -> + (case (_hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp) of + { _lhsObindLamMp -> + (case ((let sem_CBoundL_Cons_1 :: T_CBoundL_1 + sem_CBoundL_Cons_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBoundL_Cons_2 :: T_CBoundL_2 + sem_CBoundL_Cons_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImodNm) of + { _tlOmodNm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg -> + (case (_lhsIlamMp) of + { _tlOlamMp -> + (case (_lhsIisGlobal) of + { _tlOisGlobal -> + (case (_lhsIevalCtx) of + { _tlOevalCtx -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_2 _tlOdataGam _tlOevalCtx _tlOisGlobal _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOmodNm _tlOopts) of + { ( _tlIfvS,_tlIfvSMp,_tlInmL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImodNm) of + { _hdOmodNm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg -> + (case (_lhsIlamMp) of + { _hdOlamMp -> + (case (_lhsIisGlobal) of + { _hdOisGlobal -> + (case (_lhsIevalCtx) of + { _hdOevalCtx -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (True) of + { _hdOisTopTup -> + (case (True) of + { _hdOisTopApp -> + (case (hd_2 _hdOdataGam _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOmodNm _hdOopts) of + { ( _hdIfvS,_hdIfvSMp,_hdInmL) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBoundL_Cons_2)) of + { ( sem_CBoundL_2) -> + ( _lhsOgUniq,sem_CBoundL_2) }) }) }) }) }) })) + in sem_CBoundL_Cons_1)) of + { ( sem_CBoundL_1) -> + ( _lhsObindLamMp,sem_CBoundL_1) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsInm -> + (case (Map.empty) of + { _lhsObindLamMp -> + (case ((let sem_CBoundL_Nil_1 :: T_CBoundL_1 + sem_CBoundL_Nil_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CBoundL_Nil_2 :: T_CBoundL_2 + sem_CBoundL_Nil_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Map.empty) of + { _lhsOfvSMp -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) })) + in sem_CBoundL_Nil_2)) of + { ( sem_CBoundL_2) -> + ( _lhsOgUniq,sem_CBoundL_2) }) })) + in sem_CBoundL_Nil_1)) of + { ( sem_CBoundL_1) -> + ( _lhsObindLamMp,sem_CBoundL_1) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + dataConstrTagMp : DataConstrTagMp + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local dti : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( DataConstrTagMp) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (emptyDataTagInfo + { dtiConNm = conNm_ + , dtiCTag = mkOnlyConInfoCTag conNm_ tagNr_ arity_ + }) of + { _dti -> + (case (Map.singleton conNm_ _dti) of + { _lhsOdataConstrTagMp -> + ( _lhsOdataConstrTagMp) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + dataConstrTagMp : DataConstrTagMp + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( DataConstrTagMp) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIdataConstrTagMp) -> + (case (hd_) of + { ( _hdIdataConstrTagMp) -> + (case (_hdIdataConstrTagMp `Map.union` _tlIdataConstrTagMp) of + { _lhsOdataConstrTagMp -> + ( _lhsOdataConstrTagMp) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case (Map.empty) of + { _lhsOdataConstrTagMp -> + ( _lhsOdataConstrTagMp) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + gathDataGam : DataGam + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( DataGam) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIdataConstrTagMp) -> + (case (gamSingleton tyNm_ $ mkDGIForCodegenOnly tyNm_ _dataConsIdataConstrTagMp) of + { _lhsOgathDataGam -> + ( _lhsOgathDataGam) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + gathDataGam : DataGam + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( DataGam) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIgathDataGam) -> + (case (hd_) of + { ( _hdIgathDataGam) -> + (case (_hdIgathDataGam `gamUnion` _tlIgathDataGam) of + { _lhsOgathDataGam -> + ( _lhsOgathDataGam) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case (emptyGam) of + { _lhsOgathDataGam -> + ( _lhsOgathDataGam) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + gathLamMp : LamMp + grLamArgL : [HsName] + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataGam : DataGam + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + whatAbove : WhatExpr + synthesized attributes: + appFunKind : AppFunKind + fvS : FvS + mbFFIApp : Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + ) + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 1: + local _tup1 : _ + visit 2: + local nm : {HsName} + local mbVar : {Maybe HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 1: + local _tup2 : _ + visit 2: + local whatBelow : _ + alternative Char: + child char : {Char} + visit 1: + local _tup3 : _ + visit 2: + local whatBelow : _ + alternative String: + child str : {String} + visit 1: + local _tup4 : _ + visit 2: + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 1: + local _tup5 : _ + visit 2: + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 2: + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local fvS : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 1: + local _tup6 : _ + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local fvS : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + visit 1: + intra argNm : _ + visit 2: + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local isTopApp : {Bool} + local fvS : _ + local whatBelow : _ + intra argNm : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 1: + local _tup7 : _ + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 1: + local _tup8 : _ + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 1: + local _tup9 : _ + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 1: + local _tup10 : _ + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 1: + local _tup11 : _ + visit 2: + local foreignEntInfo : _ + local mbPrimNeedEval : {Maybe PrimitiveNeedsEval} + local primResNeedsEval : {Bool} + local argTyLresTy : {( TyL, Ty )} + local resTy : _ + local argTyL : {TyL} + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 2: + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 2: + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative CoeArg: + visit 2: + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 2: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( LamMp,([HsName]),T_CExpr_1) +type T_CExpr_1 = UID -> + ( UID,T_CExpr_2) +type T_CExpr_2 = DataGam -> + EvalCtx -> + Bool -> + Bool -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + WhatExpr -> + ( AppFunKind,FvS,(Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )),(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Var_1 :: T_CExpr_1 + sem_CExpr_Var_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup1 -> + (case (__tup1) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_Var_2 :: T_CExpr_2 + sem_CExpr_Var_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind -> + (case (acbrefNm ref_) of + { _nm -> + (case (Set.singleton _nm) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Just _nm) of + { _mbVar -> + (case (_mbVar) of + { _lhsOmbVar -> + (case (ExprIsVar _nm) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Var_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_Var_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Int_1 :: T_CExpr_1 + sem_CExpr_Int_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup2 -> + (case (__tup2) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_Int_2 :: T_CExpr_2 + sem_CExpr_Int_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsInt int_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Int_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_Int_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Char_1 :: T_CExpr_1 + sem_CExpr_Char_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup3 -> + (case (__tup3) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_Char_2 :: T_CExpr_2 + sem_CExpr_Char_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Char_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_Char_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_String_1 :: T_CExpr_1 + sem_CExpr_String_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup4 -> + (case (__tup4) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_String_2 :: T_CExpr_2 + sem_CExpr_String_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_String_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_String_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Integer_1 :: T_CExpr_1 + sem_CExpr_Integer_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup5 -> + (case (__tup5) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_Integer_2 :: T_CExpr_2 + sem_CExpr_Integer_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOtherWHNF) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Integer_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_Integer_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Tup_1 :: T_CExpr_1 + sem_CExpr_Tup_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Tup_2 :: T_CExpr_2 + sem_CExpr_Tup_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsTup tag_) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Tup_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) })) + in sem_CExpr_Tup_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIgathLamMp,_bodyIgrLamArgL,body_1) -> + (case (binds_) of + { ( _bindsIbindLamMp,binds_1) -> + (case (_bindsIbindLamMp `Map.union` _bodyIgathLamMp) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Let_1 :: T_CExpr_1 + sem_CExpr_Let_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _bindsOgUniq -> + (case (binds_1 _bindsOgUniq) of + { ( _bindsIgUniq,binds_2) -> + (case (_bindsIgUniq) of + { _bodyOgUniq -> + (case (body_1 _bodyOgUniq) of + { ( _bodyIgUniq,body_2) -> + (case (_bodyIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Let_2 :: T_CExpr_2 + sem_CExpr_Let_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImodNm) of + { _bodyOmodNm -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (_lhsIlamMp) of + { _bodyOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx -> + (case (_evalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_2 _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmodNm _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIfvS,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsImodNm) of + { _bindsOmodNm -> + (case (categ_) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg -> + (case (_lhsIlamMp) of + { _bindsOlamMp -> + (case (_lhsIlev == cLevModule) of + { _isGlobal -> + (case (_isGlobal) of + { _bindsOisGlobal -> + (case (_evalCtx) of + { _bindsOevalCtx -> + (case (_lhsIdataGam) of + { _bindsOdataGam -> + (case (_lhsIlev + 1) of + { _bindsOlev -> + (case (binds_2 _bindsOdataGam _bindsOevalCtx _bindsOisGlobal _bindsOlamMp _bindsOletBindingsCateg _bindsOlev _bindsOmodNm _bindsOopts) of + { ( _bindsIfvS,_bindsIfvSMp,_bindsInmL) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Let_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) })) + in sem_CExpr_Let_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_App_1 :: T_CExpr_1 + sem_CExpr_App_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} )) of + { __tup6 -> + (case (__tup6) of + { (_funcOgUniq,_,_) -> + (case (func_) of + { ( _funcIgathLamMp,_funcIgrLamArgL,func_1) -> + (case (func_1 _funcOgUniq) of + { ( _funcIgUniq,func_2) -> + (case (_funcIgUniq) of + { _argOgUniq -> + (case (hsnUnknown) of + { _argOnm -> + (case (arg_ _argOnm) of + { ( _argIbindLamMp,arg_1) -> + (case (arg_1 _argOgUniq) of + { ( _argIgUniq,arg_2) -> + (case (_argIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_App_2 :: T_CExpr_2 + sem_CExpr_App_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImodNm) of + { _funcOmodNm -> + (case (_lhsIlev) of + { _funcOlev -> + (case (_lhsIlamMp) of + { _funcOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (_lhsIdataGam) of + { _funcOdataGam -> + (case (False) of + { _funcOisTopApp -> + (case (func_2 _funcOdataGam _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlamMp _funcOlev _funcOmodNm _funcOopts _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIfvS,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIwhatBelow) -> + (case (_funcIappFunKind) of + { _lhsOappFunKind -> + (case (_lhsIopts) of + { _argOopts -> + (case (_lhsImodNm) of + { _argOmodNm -> + (case (_lhsIlev) of + { _argOlev -> + (case (acoreBindcategPlain) of + { _letBindingsCateg -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg -> + (case (_lhsIlamMp) of + { _argOlamMp -> + (case (_isTopTup) of + { _argOisTopTup -> + (case (False) of + { _isGlobal -> + (case (_isGlobal) of + { _argOisGlobal -> + (case (_lhsIdataGam) of + { _argOdataGam -> + (case (EvalCtx_Thunk) of + { _argOevalCtx -> + (case (True) of + { _argOisTopApp -> + (case (arg_2 _argOdataGam _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOlamMp _argOletBindingsCateg _argOlev _argOmodNm _argOopts) of + { ( _argIfvS,_argIfvSMp,_argInmL) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (_funcImbFFIApp) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_App_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_App_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case (bind_) of + { ( _bindIbindLamMp,_bindInm,bind_1) -> + (case (_bindInm) of + { _argNm -> + (case (body_) of + { ( _bodyIgathLamMp,_bodyIgrLamArgL,body_1) -> + (case (_argNm : _bodyIgrLamArgL) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Lam_1 :: T_CExpr_1 + sem_CExpr_Lam_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _bindOgUniq -> + (case (bind_1 _bindOgUniq) of + { ( _bindIgUniq,bind_2) -> + (case (_bindIgUniq) of + { _bodyOgUniq -> + (case (body_1 _bodyOgUniq) of + { ( _bodyIgUniq,body_2) -> + (case (_bodyIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Lam_2 :: T_CExpr_2 + sem_CExpr_Lam_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImodNm) of + { _bodyOmodNm -> + (case (_lhsIlev + 1) of + { _lev -> + (case (_lev) of + { _bodyOlev -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (Map.delete _argNm _lhsIlamMp) of + { _bodyOlamMp -> + (case (body_2 _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmodNm _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIfvS,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS -> + (case (_fvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Lam_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) })) + in sem_CExpr_Lam_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Case_1 :: T_CExpr_1 + sem_CExpr_Case_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup7 -> + (case (__tup7) of + { (_exprOgUniq,_) -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _altsOgUniq -> + (case (alts_ _altsOgUniq) of + { ( _altsIgUniq,alts_1) -> + (case (_altsIgUniq) of + { _dfltOgUniq -> + (case (dflt_) of + { ( _dfltIgathLamMp,_dfltIgrLamArgL,dflt_1) -> + (case (dflt_1 _dfltOgUniq) of + { ( _dfltIgUniq,dflt_2) -> + (case (_dfltIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Case_2 :: T_CExpr_2 + sem_CExpr_Case_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _dfltOwhatAbove -> + (case (_lhsIopts) of + { _dfltOopts -> + (case (_lhsImodNm) of + { _dfltOmodNm -> + (case (_lhsIlev) of + { _dfltOlev -> + (case (_lhsIlamMp) of + { _dfltOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _dfltOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _dfltOisTopApp -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx -> + (case (_lhsIdataGam) of + { _dfltOdataGam -> + (case (dflt_2 _dfltOdataGam _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlamMp _dfltOlev _dfltOmodNm _dfltOopts _dfltOwhatAbove) of + { ( _dfltIappFunKind,_dfltIfvS,_dfltImbFFIApp,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) -> + (case (_lhsIopts) of + { _altsOopts -> + (case (_lhsImodNm) of + { _altsOmodNm -> + (case (_lhsIlev) of + { _altsOlev -> + (case (_lhsIlamMp) of + { _altsOlamMp -> + (case (_lhsIevalCtx) of + { _altsOevalCtx -> + (case (_lhsIdataGam) of + { _altsOdataGam -> + (case (alts_1 _altsOdataGam _altsOevalCtx _altsOlamMp _altsOlev _altsOmodNm _altsOopts) of + { ( _altsIfvS) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_isTopTup) of + { _exprOisTopTup -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Case_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Case_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIgathLamMp,_errorExprIgrLamArgL,errorExpr_1) -> + (case (_errorExprIgathLamMp) of + { _lhsOgathLamMp -> + (case (_errorExprIgrLamArgL) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1 + sem_CExpr_CaseAltFail_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _errorExprOgUniq -> + (case (errorExpr_1 _errorExprOgUniq) of + { ( _errorExprIgUniq,errorExpr_2) -> + (case (_errorExprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2 + sem_CExpr_CaseAltFail_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _errorExprOwhatAbove -> + (case (_lhsIopts) of + { _errorExprOopts -> + (case (_lhsImodNm) of + { _errorExprOmodNm -> + (case (_lhsIlev) of + { _errorExprOlev -> + (case (_lhsIlamMp) of + { _errorExprOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _errorExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _errorExprOisTopApp -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx -> + (case (_lhsIdataGam) of + { _errorExprOdataGam -> + (case (errorExpr_2 _errorExprOdataGam _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlamMp _errorExprOlev _errorExprOmodNm _errorExprOopts _errorExprOwhatAbove) of + { ( _errorExprIappFunKind,_errorExprIfvS,_errorExprImbFFIApp,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind -> + (case (_errorExprIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (_errorExprImbLam) of + { _lhsOmbLam -> + (case (_errorExprImbVar) of + { _lhsOmbVar -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_CaseAltFail_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) })) + in sem_CExpr_CaseAltFail_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1 + sem_CExpr_TupDel_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup8 -> + (case (__tup8) of + { (_exprOgUniq,_) -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _offsetOgUniq -> + (case (offset_) of + { ( _offsetIgathLamMp,_offsetIgrLamArgL,offset_1) -> + (case (offset_1 _offsetOgUniq) of + { ( _offsetIgUniq,offset_2) -> + (case (_offsetIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2 + sem_CExpr_TupDel_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImodNm) of + { _offsetOmodNm -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_lhsIlamMp) of + { _offsetOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_2 _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmodNm _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIfvS,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupDel_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupDel_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1 + sem_CExpr_TupIns_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup9 -> + (case (__tup9) of + { (_exprOgUniq,_) -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _offsetOgUniq -> + (case (offset_) of + { ( _offsetIgathLamMp,_offsetIgrLamArgL,offset_1) -> + (case (offset_1 _offsetOgUniq) of + { ( _offsetIgUniq,offset_2) -> + (case (_offsetIgUniq) of + { _fldExprOgUniq -> + (case (fldExpr_) of + { ( _fldExprIgathLamMp,_fldExprIgrLamArgL,fldExpr_1) -> + (case (fldExpr_1 _fldExprOgUniq) of + { ( _fldExprIgUniq,fldExpr_2) -> + (case (_fldExprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2 + sem_CExpr_TupIns_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImodNm) of + { _fldExprOmodNm -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (_lhsIlamMp) of + { _fldExprOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (_lhsIdataGam) of + { _fldExprOdataGam -> + (case (fldExpr_2 _fldExprOdataGam _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamMp _fldExprOlev _fldExprOmodNm _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIfvS,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImodNm) of + { _offsetOmodNm -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_lhsIlamMp) of + { _offsetOlamMp -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_2 _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmodNm _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIfvS,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupIns_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupIns_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1 + sem_CExpr_TupUpd_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup10 -> + (case (__tup10) of + { (_exprOgUniq,_) -> + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _offsetOgUniq -> + (case (offset_) of + { ( _offsetIgathLamMp,_offsetIgrLamArgL,offset_1) -> + (case (offset_1 _offsetOgUniq) of + { ( _offsetIgUniq,offset_2) -> + (case (_offsetIgUniq) of + { _fldExprOgUniq -> + (case (fldExpr_) of + { ( _fldExprIgathLamMp,_fldExprIgrLamArgL,fldExpr_1) -> + (case (fldExpr_1 _fldExprOgUniq) of + { ( _fldExprIgUniq,fldExpr_2) -> + (case (_fldExprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2 + sem_CExpr_TupUpd_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _fldExprOwhatAbove -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImodNm) of + { _fldExprOmodNm -> + (case (_lhsIlev) of + { _fldExprOlev -> + (case (_lhsIlamMp) of + { _fldExprOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _fldExprOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _fldExprOisTopApp -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx -> + (case (_lhsIdataGam) of + { _fldExprOdataGam -> + (case (fldExpr_2 _fldExprOdataGam _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamMp _fldExprOlev _fldExprOmodNm _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIfvS,_fldExprImbFFIApp,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImodNm) of + { _offsetOmodNm -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_lhsIlamMp) of + { _offsetOlamMp -> + (case (_isTopTup) of + { _offsetOisTopTup -> + (case (_isTopApp) of + { _offsetOisTopApp -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (offset_2 _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmodNm _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIfvS,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_isTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (False) of + { _exprOisTopTup -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupUpd_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupUpd_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_FFI_1 :: T_CExpr_1 + sem_CExpr_FFI_1 = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup11 -> + (case (__tup11) of + { (_lhsOgUniq,_) -> + (case ((let sem_CExpr_FFI_2 :: T_CExpr_2 + sem_CExpr_FFI_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (foreignEntExtract impEnt_) of + { _foreignEntInfo -> + (case (maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo) of + { _mbPrimNeedEval -> + (case (maybe False primResNeedEval _mbPrimNeedEval) of + { _primResNeedsEval -> + (case (appUnArr ty_) of + { _argTyLresTy -> + (case (snd _argTyLresTy) of + { _resTy -> + (case (fst _argTyLresTy) of + { _argTyL -> + (case (Just ( _resTy + , _primResNeedsEval + , callconv_ + , impEnt_ + , _argTyL + )) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsFFI) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_FFI_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) })) + in sem_CExpr_FFI_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1 + sem_CExpr_Dbg_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2 + sem_CExpr_Dbg_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Dbg_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) })) + in sem_CExpr_Dbg_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Hole_1 :: T_CExpr_1 + sem_CExpr_Hole_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Hole_2 :: T_CExpr_2 + sem_CExpr_Hole_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_Hole_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) })) + in sem_CExpr_Hole_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1 + sem_CExpr_HoleLet_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _bodyOgUniq -> + (case (body_) of + { ( _bodyIgathLamMp,_bodyIgrLamArgL,body_1) -> + (case (body_1 _bodyOgUniq) of + { ( _bodyIgUniq,body_2) -> + (case (_bodyIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2 + sem_CExpr_HoleLet_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImodNm) of + { _bodyOmodNm -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (_lhsIlamMp) of + { _bodyOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_2 _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmodNm _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIfvS,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) -> + (case (_bodyIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_HoleLet_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) })) + in sem_CExpr_HoleLet_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1 + sem_CExpr_CoeArg_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2 + sem_CExpr_CoeArg_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (Set.empty) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) })) + in sem_CExpr_CoeArg_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) })) + in sem_CExpr_CoeArg_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1 + sem_CExpr_ImplsApp_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _funcOgUniq -> + (case (func_) of + { ( _funcIgathLamMp,_funcIgrLamArgL,func_1) -> + (case (func_1 _funcOgUniq) of + { ( _funcIgUniq,func_2) -> + (case (_funcIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2 + sem_CExpr_ImplsApp_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _funcOwhatAbove -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImodNm) of + { _funcOmodNm -> + (case (_lhsIlev) of + { _funcOlev -> + (case (_lhsIlamMp) of + { _funcOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _funcOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _funcOisTopApp -> + (case (_lhsIevalCtx) of + { _funcOevalCtx -> + (case (_lhsIdataGam) of + { _funcOdataGam -> + (case (func_2 _funcOdataGam _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlamMp _funcOlev _funcOmodNm _funcOopts _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIfvS,_funcImbFFIApp,_funcImbLam,_funcImbVar,_funcIwhatBelow) -> + (case (_funcIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsApp_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) })) + in sem_CExpr_ImplsApp_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (Map.empty) of + { _lhsOgathLamMp -> + (case ([]) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1 + sem_CExpr_ImplsLam_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _bodyOgUniq -> + (case (body_) of + { ( _bodyIgathLamMp,_bodyIgrLamArgL,body_1) -> + (case (body_1 _bodyOgUniq) of + { ( _bodyIgUniq,body_2) -> + (case (_bodyIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2 + sem_CExpr_ImplsLam_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _bodyOwhatAbove -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImodNm) of + { _bodyOmodNm -> + (case (_lhsIlev) of + { _bodyOlev -> + (case (_lhsIlamMp) of + { _bodyOlamMp -> + (case (True) of + { _isTopTup -> + (case (_isTopTup) of + { _bodyOisTopTup -> + (case (True) of + { _isTopApp -> + (case (_isTopApp) of + { _bodyOisTopApp -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx -> + (case (_lhsIdataGam) of + { _bodyOdataGam -> + (case (body_2 _bodyOdataGam _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmodNm _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIfvS,_bodyImbFFIApp,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) -> + (case (_bodyIfvS) of + { _lhsOfvS -> + (case (Nothing) of + { _lhsOmbFFIApp -> + (case (Nothing) of + { _lhsOmbLam -> + (case (Nothing) of + { _lhsOmbVar -> + (case (ExprIsOther) of + { _whatBelow -> + (case (_whatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsLam_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) })) + in sem_CExpr_ImplsLam_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (_exprIgathLamMp) of + { _lhsOgathLamMp -> + (case (_exprIgrLamArgL) of + { _lhsOgrLamArgL -> + (case ((let sem_CExpr_Ann_1 :: T_CExpr_1 + sem_CExpr_Ann_1 = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _annOgUniq -> + (case (ann_ _annOgUniq) of + { ( _annIgUniq,ann_1) -> + (case (_annIgUniq) of + { _exprOgUniq -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExpr_Ann_2 :: T_CExpr_2 + sem_CExpr_Ann_2 = + (\ _lhsIdataGam + _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImodNm) of + { _exprOmodNm -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (_lhsIisTopTup) of + { _exprOisTopTup -> + (case (_lhsIisTopApp) of + { _exprOisTopApp -> + (case (_lhsIevalCtx) of + { _exprOevalCtx -> + (case (_lhsIdataGam) of + { _exprOdataGam -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIappFunKind) of + { _lhsOappFunKind -> + (case (_lhsIopts) of + { _annOopts -> + (case (_lhsImodNm) of + { _annOmodNm -> + (case (_lhsIlev) of + { _annOlev -> + (case (_lhsIlamMp) of + { _annOlamMp -> + (case (_lhsIdataGam) of + { _annOdataGam -> + (case (ann_1 _annOdataGam _annOlamMp _annOlev _annOmodNm _annOopts) of + { ( _annIfvS) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS -> + (case (_exprImbFFIApp) of + { _lhsOmbFFIApp -> + (case (_exprImbLam) of + { _lhsOmbLam -> + (case (_exprImbVar) of + { _lhsOmbVar -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow -> + ( _lhsOappFunKind,_lhsOfvS,_lhsOmbFFIApp,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Ann_2)) of + { ( sem_CExpr_2) -> + ( _lhsOgUniq,sem_CExpr_2) }) }) }) }) }) })) + in sem_CExpr_Ann_1)) of + { ( sem_CExpr_1) -> + ( _lhsOgathLamMp,_lhsOgrLamArgL,sem_CExpr_1) }) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + alternative Coe: + child coe : {RelevCoe} + alternative Debug: + child info : {String} +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = UID -> + ( UID,T_CExprAnn_1) +type T_CExprAnn_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1 + sem_CExprAnn_Ty_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) + in sem_CExprAnn_Ty_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOgUniq,sem_CExprAnn_1) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1 + sem_CExprAnn_Coe_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) + in sem_CExprAnn_Coe_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOgUniq,sem_CExprAnn_1) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1 + sem_CExprAnn_Debug_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) + in sem_CExprAnn_Debug_1)) of + { ( sem_CExprAnn_1) -> + ( _lhsOgUniq,sem_CExprAnn_1) }) })) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Plain: + alternative Function0: + alternative Function1: + alternative Apply0: +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Val: + alternative Dict: + alternative DictClass: + child tracks : {[Track]} + alternative DictInstance: + child tracks : {[Track]} + alternative Track: + child track : {Track} +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + ( _lhsOfvS) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attribute: + fvS : FvS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts -> + (case (_lhsImodNm) of + { _x2OmodNm -> + (case (_lhsIlev) of + { _x2Olev -> + (case (_lhsIlamMp) of + { _x2OlamMp -> + (case (_lhsIdataGam) of + { _x2OdataGam -> + (case (x2_ _x2OdataGam _x2OlamMp _x2Olev _x2OmodNm _x2Oopts) of + { ( _x2IfvS) -> + (case (_lhsIopts) of + { _x1Oopts -> + (case (_lhsImodNm) of + { _x1OmodNm -> + (case (_lhsIlev) of + { _x1Olev -> + (case (_lhsIlamMp) of + { _x1OlamMp -> + (case (_lhsIdataGam) of + { _x1OdataGam -> + (case (x1_ _x1OdataGam _x1OlamMp _x1Olev _x1OmodNm _x1Oopts) of + { ( _x1IfvS) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS -> + ( _lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + gathLamMp : LamMp + visit 1: + inherited attributes: + dataGam : DataGam + importUsedModules : ImportUsedModules + lamMp : LamMp + lev : Int + opts : EHCOpts + chained attribute: + gUniq : UID + synthesized attributes: + fvS : FvS + gathDataGam : DataGam + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 1: + local whatAbove : {WhatExpr} + local dataGam : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( LamMp,T_CModule_1) +type T_CModule_1 = DataGam -> + UID -> + ImportUsedModules -> + LamMp -> + Int -> + EHCOpts -> + ( FvS,UID,DataGam) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (expr_) of + { ( _exprIgathLamMp,_exprIgrLamArgL,expr_1) -> + (case (_exprIgathLamMp) of + { _lhsOgathLamMp -> + (case ((let sem_CModule_Mod_1 :: T_CModule_1 + sem_CModule_Mod_1 = + (\ _lhsIdataGam + _lhsIgUniq + _lhsIimportUsedModules + _lhsIlamMp + _lhsIlev + _lhsIopts -> + (case (_lhsIgUniq) of + { _exprOgUniq -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,expr_2) -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _exprOwhatAbove -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsIlev) of + { _exprOlev -> + (case (_lhsIlamMp) of + { _exprOlamMp -> + (case (declMetas_) of + { ( _declMetasIgathDataGam) -> + (case (_lhsIdataGam `gamUnion` _declMetasIgathDataGam) of + { _dataGam -> + (case (_dataGam) of + { _exprOdataGam -> + (case (moduleNm_) of + { _exprOmodNm -> + (case (EvalCtx_Eval) of + { _exprOevalCtx -> + (case (True) of + { _exprOisTopTup -> + (case (True) of + { _exprOisTopApp -> + (case (expr_2 _exprOdataGam _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmodNm _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIfvS,_exprImbFFIApp,_exprImbLam,_exprImbVar,_exprIwhatBelow) -> + (case (_exprIfvS) of + { _lhsOfvS -> + (case (_exprIgUniq) of + { _lhsOgUniq -> + (case (_declMetasIgathDataGam) of + { _lhsOgathDataGam -> + ( _lhsOfvS,_lhsOgUniq,_lhsOgathDataGam) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CModule_Mod_1)) of + { ( sem_CModule_1) -> + ( _lhsOgathLamMp,sem_CModule_1) }) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local _tup12 : _ + alternative Int: + child int : {Int} + visit 0: + local _tup13 : _ + alternative Char: + child char : {Char} + visit 0: + local _tup14 : _ + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = UID -> + ( UID,T_CPat_1) +type T_CPat_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( ([HsName]),FvS,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPat_Var_1 :: T_CPat_1 + sem_CPat_Var_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([pnm_]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) })) + in sem_CPat_Var_1)) of + { ( sem_CPat_1) -> + ( _lhsOgUniq,sem_CPat_1) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup12 -> + (case (__tup12) of + { (_restOgUniq,_) -> + (case (rest_ _restOgUniq) of + { ( _restIgUniq,rest_1) -> + (case (_restIgUniq) of + { _bindsOgUniq -> + (case (binds_ _bindsOgUniq) of + { ( _bindsIgUniq,binds_1) -> + (case (_bindsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPat_Con_1 :: T_CPat_1 + sem_CPat_Con_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts -> + (case (_lhsImodNm) of + { _bindsOmodNm -> + (case (_lhsIlev) of + { _bindsOlev -> + (case (_lhsIlamMp) of + { _bindsOlamMp -> + (case (_lhsIdataGam) of + { _bindsOdataGam -> + (case (binds_1 _bindsOdataGam _bindsOlamMp _bindsOlev _bindsOmodNm _bindsOopts) of + { ( _bindsIfldNmL,_bindsIfvS,_bindsInmL) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (_lhsIopts) of + { _restOopts -> + (case (_lhsImodNm) of + { _restOmodNm -> + (case (_lhsIlev) of + { _restOlev -> + (case (_lhsIlamMp) of + { _restOlamMp -> + (case (_lhsIdataGam) of + { _restOdataGam -> + (case (rest_1 _restOdataGam _restOlamMp _restOlev _restOmodNm _restOopts) of + { ( _restIfvS,_restInmL) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPat_Con_1)) of + { ( sem_CPat_1) -> + ( _lhsOgUniq,sem_CPat_1) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup13 -> + (case (__tup13) of + { (_lhsOgUniq,_) -> + (case ((let sem_CPat_Int_1 :: T_CPat_1 + sem_CPat_Int_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) })) + in sem_CPat_Int_1)) of + { ( sem_CPat_1) -> + ( _lhsOgUniq,sem_CPat_1) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIgUniq -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup14 -> + (case (__tup14) of + { (_lhsOgUniq,_) -> + (case ((let sem_CPat_Char_1 :: T_CPat_1 + sem_CPat_Char_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) })) + in sem_CPat_Char_1)) of + { ( sem_CPat_1) -> + ( _lhsOgUniq,sem_CPat_1) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPat_BoolExpr_1 :: T_CPat_1 + sem_CPat_BoolExpr_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) })) + in sem_CPat_BoolExpr_1)) of + { ( sem_CPat_1) -> + ( _lhsOgUniq,sem_CPat_1) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 1: + local fldNm : _ + local whatAbove : {WhatExpr} +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = UID -> + ( UID,T_CPatFld_1) +type T_CPatFld_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( ([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _offsetOgUniq -> + (case (offset_) of + { ( _offsetIgathLamMp,_offsetIgrLamArgL,offset_1) -> + (case (offset_1 _offsetOgUniq) of + { ( _offsetIgUniq,offset_2) -> + (case (_offsetIgUniq) of + { _bindOgUniq -> + (case (bind_) of + { ( _bindIbindLamMp,_bindInm,bind_1) -> + (case (bind_1 _bindOgUniq) of + { ( _bindIgUniq,bind_2) -> + (case (_bindIgUniq) of + { _fldAnnsOgUniq -> + (case (fldAnns_ _fldAnnsOgUniq) of + { ( _fldAnnsIgUniq,fldAnns_1) -> + (case (_fldAnnsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPatFld_Fld_1 :: T_CPatFld_1 + sem_CPatFld_Fld_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (_lhsIopts) of + { _fldAnnsOopts -> + (case (_lhsImodNm) of + { _fldAnnsOmodNm -> + (case (_lhsIlev) of + { _fldAnnsOlev -> + (case (_lhsIlamMp) of + { _fldAnnsOlamMp -> + (case (_lhsIdataGam) of + { _fldAnnsOdataGam -> + (case (fldAnns_1 _fldAnnsOdataGam _fldAnnsOlamMp _fldAnnsOlev _fldAnnsOmodNm _fldAnnsOopts) of + { ( _fldAnnsIfvS,_fldAnnsInmL) -> + (case (_lhsIopts) of + { _bindOopts -> + (case (_lhsImodNm) of + { _bindOmodNm -> + (case (_lhsIlev) of + { _bindOlev -> + (case (_lhsIlamMp) of + { _bindOlamMp -> + (case (_lhsIdataGam) of + { _bindOdataGam -> + (case (False) of + { _bindOisGlobal -> + (case (EvalCtx_None) of + { _bindOevalCtx -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg -> + (case (bind_2 _bindOdataGam _bindOevalCtx _bindOisGlobal _bindOlamMp _bindOletBindingsCateg _bindOlev _bindOmodNm _bindOopts) of + { ( _bindIfvS,_bindIfvSMp,_bindInmL) -> + (case (ExprIsOther) of + { _whatAbove -> + (case (_whatAbove) of + { _offsetOwhatAbove -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImodNm) of + { _offsetOmodNm -> + (case (_lhsIlev) of + { _offsetOlev -> + (case (_lhsIlamMp) of + { _offsetOlamMp -> + (case (_lhsIdataGam) of + { _offsetOdataGam -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx -> + (case (True) of + { _offsetOisTopTup -> + (case (True) of + { _offsetOisTopApp -> + (case (offset_2 _offsetOdataGam _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmodNm _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIfvS,_offsetImbFFIApp,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS -> + (case ([_fldNm]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPatFld_Fld_1)) of + { ( sem_CPatFld_1) -> + ( _lhsOgUniq,sem_CPatFld_1) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = UID -> + ( UID,T_CPatFldL_1) +type T_CPatFldL_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( ([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (hd_ _hdOgUniq) of + { ( _hdIgUniq,hd_1) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (tl_ _tlOgUniq) of + { ( _tlIgUniq,tl_1) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPatFldL_Cons_1 :: T_CPatFldL_1 + sem_CPatFldL_Cons_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImodNm) of + { _tlOmodNm -> + (case (_lhsIlev) of + { _tlOlev -> + (case (_lhsIlamMp) of + { _tlOlamMp -> + (case (_lhsIdataGam) of + { _tlOdataGam -> + (case (tl_1 _tlOdataGam _tlOlamMp _tlOlev _tlOmodNm _tlOopts) of + { ( _tlIfldNmL,_tlIfvS,_tlInmL) -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImodNm) of + { _hdOmodNm -> + (case (_lhsIlev) of + { _hdOlev -> + (case (_lhsIlamMp) of + { _hdOlamMp -> + (case (_lhsIdataGam) of + { _hdOdataGam -> + (case (hd_1 _hdOdataGam _hdOlamMp _hdOlev _hdOmodNm _hdOopts) of + { ( _hdIfldNmL,_hdIfvS,_hdInmL) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPatFldL_Cons_1)) of + { ( sem_CPatFldL_1) -> + ( _lhsOgUniq,sem_CPatFldL_1) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPatFldL_Nil_1 :: T_CPatFldL_1 + sem_CPatFldL_Nil_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) })) + in sem_CPatFldL_Nil_1)) of + { ( sem_CPatFldL_1) -> + ( _lhsOgUniq,sem_CPatFldL_1) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + lev : Int + modNm : HsName + opts : EHCOpts + synthesized attributes: + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = UID -> + ( UID,T_CPatRest_1) +type T_CPatRest_1 = DataGam -> + LamMp -> + Int -> + HsName -> + EHCOpts -> + ( FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPatRest_Var_1 :: T_CPatRest_1 + sem_CPatRest_Var_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([nm_]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) })) + in sem_CPatRest_Var_1)) of + { ( sem_CPatRest_1) -> + ( _lhsOgUniq,sem_CPatRest_1) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIgUniq -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case ((let sem_CPatRest_Empty_1 :: T_CPatRest_1 + sem_CPatRest_Empty_1 = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIlev + _lhsImodNm + _lhsIopts -> + (case (Set.empty) of + { _lhsOfvS -> + (case ([]) of + { _lhsOnmL -> + ( _lhsOfvS,_lhsOnmL) }) })) + in sem_CPatRest_Empty_1)) of + { ( sem_CPatRest_1) -> + ( _lhsOgUniq,sem_CPatRest_1) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + gUniq : UID + importUsedModules : ImportUsedModules + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + gathDataGam : DataGam + gathLamMp : LamMp + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local howMergeLamInfo : _ + local gathLamMp : _ + local howUnionGathLamInfo : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = DataGam -> + UID -> + ImportUsedModules -> + LamMp -> + EHCOpts -> + ( DataGam,LamMp) +data Inh_CodeAGItf = Inh_CodeAGItf {dataGam_Inh_CodeAGItf :: !(DataGam),gUniq_Inh_CodeAGItf :: !(UID),importUsedModules_Inh_CodeAGItf :: !(ImportUsedModules),lamMp_Inh_CodeAGItf :: !(LamMp),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {gathDataGam_Syn_CodeAGItf :: !(DataGam),gathLamMp_Syn_CodeAGItf :: !(LamMp)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIdataGam _lhsIgUniq _lhsIimportUsedModules _lhsIlamMp _lhsIopts) = + (let ( _lhsOgathDataGam,_lhsOgathLamMp) = sem _lhsIdataGam _lhsIgUniq _lhsIimportUsedModules _lhsIlamMp _lhsIopts + in (Syn_CodeAGItf _lhsOgathDataGam _lhsOgathLamMp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIdataGam + _lhsIgUniq + _lhsIimportUsedModules + _lhsIlamMp + _lhsIopts -> + (case (module_) of + { ( _moduleIgathLamMp,module_1) -> + (case (_lhsIopts) of + { _moduleOopts -> + (case (_lhsIimportUsedModules) of + { _moduleOimportUsedModules -> + (case (_lhsIgUniq) of + { _moduleOgUniq -> + (case (_lhsIdataGam) of + { _moduleOdataGam -> + (case (cLevModule) of + { _moduleOlev -> + (case ((\(LamInfo {laminfoArity=a}) i -> i {laminfoArity=a})) of + { _howMergeLamInfo -> + (case (lamMpMergeInto _howMergeLamInfo const _moduleIgathLamMp _lhsIlamMp) of + { _gathLamMp -> + (case (Map.union _gathLamMp) of + { _howUnionGathLamInfo -> + (case (_howUnionGathLamInfo _lhsIlamMp) of + { _moduleOlamMp -> + (case (module_1 _moduleOdataGam _moduleOgUniq _moduleOimportUsedModules _moduleOlamMp _moduleOlev _moduleOopts) of + { ( _moduleIfvS,_moduleIgUniq,_moduleIgathDataGam) -> + (case (_moduleIgathDataGam) of + { _lhsOgathDataGam -> + (case (_gathLamMp) of + { _lhsOgathLamMp -> + ( _lhsOgathDataGam,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf.hs b/src/UHC/Light/Compiler/Core/Trf.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf.hs @@ -0,0 +1,233 @@ +module UHC.Light.Compiler.Core.Trf +( TrfCore (..), emptyTrfCore +, TrfCoreExtra (..), emptyTrfCoreExtra +, trfCore ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import Control.Monad.State +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.CodeGen.ValAccess as VA +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Trf.RenUniq +import UHC.Light.Compiler.Core.Trf.ANormal +import UHC.Light.Compiler.Core.Trf.InlineLetAlias +import UHC.Light.Compiler.Core.Trf.LetUnrec +import UHC.Light.Compiler.Core.Trf.LetDefBeforeUse +import UHC.Light.Compiler.Core.Trf.LamGlobalAsArg +import UHC.Light.Compiler.Core.Trf.CAFGlobalAsArg +import UHC.Light.Compiler.Core.Trf.FloatToGlobal +import UHC.Light.Compiler.Core.Trf.ConstProp +import UHC.Light.Compiler.Core.Trf.EtaRed +import UHC.Light.Compiler.Core.Trf.ElimTrivApp +import UHC.Light.Compiler.Core.Trf.AnnBasedSimplify +import UHC.Light.Compiler.Core.Trf.AnaRelevance +import UHC.Light.Compiler.Core.Trf.LetFlattenStrict +import UHC.Light.Compiler.Core.Trf.OptimizeStrictness +import UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore +import UHC.Light.Compiler.Core.Trf.FixAfterParse +import UHC.Light.Compiler.CodeGen.TrfUtils +import UHC.Light.Compiler.Core.Trf.ExplicitStackTrace + + + +{-# LINE 77 "src/ehc/Core/Trf.chs" #-} +type TrfCore = TrfState CModule TrfCoreExtra + +emptyTrfCore :: TrfCore +emptyTrfCore = mkEmptyTrfState emptyCModule emptyTrfCoreExtra + +{-# LINE 84 "src/ehc/Core/Trf.chs" #-} +data TrfCoreExtra + = TrfCoreExtra + { trfcoreInhLamMp :: LamMp -- from context, possibly overridden from gathered one + , trfcoreGathLamMp :: !LamMp -- gathered anew + , trfcoreExpNmOffMp :: !HsName2FldMp + , trfcoreExtraExports :: !FvS -- extra exported names, introduced by transformations + , trfcoreECUState :: !EHCompileUnitState + , trfcoreIsLamLifted :: !Bool + } + +emptyTrfCoreExtra :: TrfCoreExtra +emptyTrfCoreExtra = TrfCoreExtra + Map.empty Map.empty + Map.empty + Set.empty + ECUS_Unknown + False + +{-# LINE 116 "src/ehc/Core/Trf.chs" #-} +-- | Perform Core transformations. +-- The 'optScope' tells at which compilation phase (per module, whole program) the transformations are done, default only per module +trfCore :: EHCOpts -> OptimizationScope -> DataGam -> HsName -> TrfCore -> TrfCore +trfCore opts optimScope dataGam modNm trfcore + -- = execState trf trfcore + = runTrf opts modNm ehcOptDumpCoreStages (optimScope `elem`) trfcore trf + where isFromCoreSrc = ecuStateIsCore $ trfcoreECUState $ trfstExtra trfcore + isLamLifted = trfcoreIsLamLifted $ trfstExtra trfcore + noOptims = ehcOptOptimizationLevel opts <= OptimizationLevel_Off + isCoreTarget = targetIsCore $ ehcOptTarget opts + isUnOptimCoreTarget = isCoreTarget && noOptims + trf + = do { -- initial is just to obtain Core for dumping stages + t_initial + + ; when isFromCoreSrc $ do + { -- fix whatever needs to be fixed when read from Core src + t_fix_postparse + + } + + + ; unless isFromCoreSrc $ do + { unless noOptims $ do + { -- removal of unnecessary constructs: simplifications based on annotations (experimential, temporary) + t_ann_simpl + } + + -- removal of unnecessary constructs: eta expansions + ; t_eta_red + + -- erase type signatures, extract the core + ty combi at this stage + ; unless (ehcOptCoreSysF opts) + t_erase_ty + } + + + ; unless isLamLifted $ do + { + -- make names unique + ; unless isUnOptimCoreTarget $ + t_ren_uniq emptyRenUniqOpts + -- from now on INVARIANT: keep all names globally unique + -- ASSUME : no need to shadow identifiers + + -- removal of unnecessary constructs: mutual recursiveness + ; t_let_unrec + } + + ; when isFromCoreSrc $ do + { -- ensure def before use ordering + t_let_defbefuse + + } + + -- flattening of nested strictness + ; t_let_flatstr + + ; unless noOptims $ do + { + -- removal of unnecessary constructs: aliases + ; t_inl_letali + + -- removal of unnecessary constructs: trival function applications + ; t_elim_trivapp + } + + -- optionally modify to include explicit stack trace + ; when (ehcOptTargetFlavor opts == TargetFlavor_Debug) + (do { t_expl_trace + -- from now on INVARIANT: renaming of identifiers must also rename additional exported names here introduced + + ; t_let_unrec + -- ; t_ren_uniq + }) + + ; unless noOptims $ do + { + -- removal of unnecessary constructs: constants + ; t_const_prop + ; t_inl_letali + ; t_elim_trivapp + } + + ; when (isUnOptimCoreTarget || not isLamLifted) $ do + { + -- put in A-normal form, where args to app only may be identifiers + ; u1 <- freshInfUID + ; t_anormal u1 + } + + + ; when (not isLamLifted && not isUnOptimCoreTarget) $ do + { + -- pass all globals used in lambda explicit as argument + ; t_lam_asarg + + -- pass all globals used in CAF explicit as argument + ; t_caf_asarg + ; t_let_unrec + ; u2 <- freshInfUID + ; t_anormal u2 + + -- float lam/CAF to global level + ; t_float_glob + -- from now on INVARIANT: no local lambdas + -- ASSUME : + } + + ; when (ehcOptOptimizes Optimize_StrictnessAnalysis opts) + (do { t_let_defbefuse + ; t_ana_relev + ; t_opt_strict + }) + ; when (ehcOptIsViaCoreJavaScript opts) + (do { {- t_let_flatstr + ; -} t_ren_uniq (emptyRenUniqOpts {renuniqOptResetOnlyInLam = True}) + }) + ; when (not isCoreTarget) {- isFromCoreSrc -} $ do + { -- ensure def before use ordering + t_let_defbefuse' osmw + + } + } + + lamMpPropagate l s@(TrfState {trfstExtra=e@(TrfCoreExtra{trfcoreGathLamMp=gl, trfcoreInhLamMp=il})}) + = s {trfstExtra = e {trfcoreGathLamMp = gl', trfcoreInhLamMp = Map.union gl' il}} + where gl' = Map.union l gl + + -- actual transformations + t_initial = liftTrfModPlain osmw "initial" $ id + t_fix_postparse = liftTrfModPlain osm "fix-postparse" $ cmodTrfFixAfterParse dataGam + t_eta_red = liftTrfModPlain osm "eta-red" $ cmodTrfEtaRed + t_erase_ty = liftTrfModWithStateExtra osmw "erase-ty" lamMpPropagate + $ \_ -> cmodTrfEraseExtractTysigCore opts + t_ann_simpl = liftTrfModPlain osm "ann-simpl" $ cmodTrfAnnBasedSimplify opts + t_ren_uniq o = liftTrfModPlain osm "ren-uniq" $ cmodTrfRenUniq o + t_let_unrec = liftTrfModPlain osm "let-unrec" $ cmodTrfLetUnrec + t_let_defbefuse' os + = liftTrfModPlain os "let-defbefuse" $ cmodTrfLetDefBeforeUse + t_let_defbefuse = t_let_defbefuse' osm + t_let_flatstr = liftTrfModPlain osm "let-flatstr" $ cmodTrfLetFlattenStrict + t_inl_letali = liftTrfModPlain osm "inl-letali" $ cmodTrfInlineLetAlias + (Map.keysSet $ trfcoreExpNmOffMp $ trfstExtra trfcore) + t_elim_trivapp = liftTrfModPlain osm "elim-trivapp" $ cmodTrfElimTrivApp opts + t_const_prop = liftTrfModPlain osm "const-prop" $ cmodTrfConstProp opts + t_anormal u = liftTrfModPlain osm "anormal" $ cmodTrfANormal modNm u + t_lam_asarg = liftTrfModPlain osm "lam-asarg" $ cmodTrfLamGlobalAsArg + t_caf_asarg = liftTrfModPlain osm "caf-asarg" $ cmodTrfCAFGlobalAsArg + t_float_glob = liftTrfModPlain osm "float-glob" $ cmodTrfFloatToGlobal + t_ana_relev = liftTrfModWithStateExtra osm "ana-relev" lamMpPropagate + $ \s -> cmodTrfAnaRelevance opts dataGam (trfcoreInhLamMp $ trfstExtra s) + t_opt_strict = liftTrfModWithStateExtra osm "optim-strict" lamMpPropagate + $ \s -> cmodTrfOptimizeStrictness opts (trfcoreInhLamMp $ trfstExtra s) + t_expl_trace = liftTrfModWithStateExtra osm "expl-sttrace" + (\m s@(TrfState {trfstExtra=e@(TrfCoreExtra {trfcoreExtraExports=exps})}) + -> (lamMpPropagate m s) + { trfstExtra = + e { trfcoreExtraExports = exps `Set.union` + Set.fromList [ n + | (n,LamInfo {laminfoStackTrace=(StackTraceInfo_IsStackTraceEquiv _)}) <- Map.toList m + ] + } } + ) $ \s -> cmodTrfExplicitStackTrace opts (trfcoreInhLamMp $ trfstExtra s) + -- abbreviations for optimatisation scope + osm = [OptimizationScope_PerModule] + osmw = + [OptimizationScope_WholeCore] ++ + osm + diff --git a/src/UHC/Light/Compiler/Core/Trf/ANormal.hs b/src/UHC/Light/Compiler/Core/Trf/ANormal.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/ANormal.hs @@ -0,0 +1,7384 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANorm) +module UHC.Light.Compiler.Core.Trf.ANormal(cmodTrfANormal) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.HsName.Builtin +import Data.Maybe +import qualified Data.Set as Set +import Data.List as List +import qualified Data.Map as Map +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Base.Debug + + + + + + + + + + + + + +cmodTrfANormal :: HsName -> UID -> CModule -> CModule +cmodTrfANormal modNm uniq cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { gUniq_Inh_CodeAGItf = uniq + , modNm_Inh_CodeAGItf = modNm + }) + in cTrf_Syn_CodeAGItf t + + + +type LevBindSq = Seq.FastSeq (Int,(CBindCateg,CBindL)) + +levBindSplit :: Int -> LevBindSq -> (LevBindSq,LevBindSq) +levBindSplit lev b + = let (b1,b2) = partition (\(l,_) -> l >= lev) $ Seq.toList b + in (Seq.fromList b1,Seq.fromList b2) + + + +data AppTop = AppYesLet | AppNoLet deriving (Eq,Ord) +data LamTop = LamYesLet | LamNoLet deriving (Eq,Ord) + + + +mkTrf :: Bool -> Int -> Int -> HsName -> CExpr -> (CExpr,LevBindSq) +mkTrf cond outerLev hereLev n e + = if cond + then (acoreVar n,Seq.singleton (hereLev,(CBindCateg_Plain,[acoreBind1 n e]))) + else (e,Seq.empty) + + + +mkLetTrf' :: LevBindSq -> CExpr -> (Bool,CExpr) +mkLetTrf' bs ce + = let l = Seq.toList bs + in (not (List.null l),foldr (\(_,(c,b)) e -> acoreLet c b e) ce l) + +mkLetTrf :: LevBindSq -> CExpr -> CExpr +mkLetTrf bs ce = snd (mkLetTrf' bs ce) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CAlt + fvS : FvS + levBindSq : LevBindSq + levOf : Int + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cvi : _ + local fvS : _ + local whatAbove : {WhatExpr} + local lev : _ + local _tup1 : _ + local hereBindSq : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CAlt,FvS,UID,LevBindSq,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _lhsOlevOf :: Int + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOlevBindSq :: LevBindSq + _exprOappTrfIsOk :: AppTop + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _lhsOcTrf :: CAlt + _lhsOfvS :: FvS + _lhsOgUniq :: UID + _patOcvarIntroMp :: CVarIntroMp + _patOgUniq :: UID + _patOintroCVarIntroMp :: CVarIntroMp + _patOlev :: Int + _patOmodNm :: HsName + _exprOevalCtx :: EvalCtx + _exprOgUniq :: UID + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _patIfvS :: FvS + _patIgUniq :: UID + _patIlevBindSq :: LevBindSq + _patIlevOf :: Int + _patInmL :: ([HsName]) + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 15, column 17) + _cvi = + emptyCVarIntro { cviLev = _lev } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 36, column 17) + _exprOcvarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 48, column 17) + _exprOintroCVarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 70, column 17) + _lhsOlevOf = + fvsLev _lhsIcvarIntroMp cLevModule _exprIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 14, column 17) + _fvS = + _exprIfvS `Set.difference` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 87, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 102, column 17) + __tup1 = + (_exprIlevBindSq,Seq.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 102, column 17) + (_hereBindSq,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 102, column 17) + (_,_lhsOlevBindSq) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 133, column 17) + _exprOappTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 159, column 17) + _exprOlamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 185, column 17) + _exprOletTrfIsOk = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 222, column 17) + _lhsOcTrf = + CAlt_Alt _patIcTrf (mkLetTrf _hereBindSq _exprIcTrf) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _patOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _patOgUniq = + _lhsIgUniq + -- copy rule (down) + _patOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOmodNm = + _lhsImodNm + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _exprOgUniq = + _patIgUniq + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _patIcTrf,_patIfldNmL,_patIfvS,_patIgUniq,_patIlevBindSq,_patIlevOf,_patInmL) = + pat_ _patOcvarIntroMp _patOgUniq _patOintroCVarIntroMp _patOlev _patOmodNm + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CAltL + fvS : FvS + levBindSq : LevBindSq + levOf : Int + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CAltL,FvS,UID,LevBindSq,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: UID + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: UID + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOmodNm :: HsName + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: UID + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOmodNm :: HsName + _hdIcTrf :: CAlt + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdIlevBindSq :: LevBindSq + _hdIlevOf :: Int + _tlIcTrf :: CAltL + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlIlevBindSq :: LevBindSq + _tlIlevOf :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _hdIlevBindSq Seq.:++: _tlIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmodNm = + _lhsImodNm + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmodNm = + _lhsImodNm + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevBindSq,_hdIlevOf) = + hd_ _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOlev _hdOmodNm + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevBindSq,_tlIlevOf) = + tl_ _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOlev _tlOmodNm + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + bindL : AssocL Int CBind + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBind + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levBindSq : LevBindSq + levOf : Int + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( (AssocL Int CBind),CVarIntroMp,CBind,CVarIntroMp,FvS,FvSMp,UID,LevBindSq,Int,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm -> + (let _lhsOfvSMp :: FvSMp + _lhsOnmL :: ([HsName]) + _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CBind + _lhsOgUniq :: UID + _bindAspectsOcvarIntroMp :: CVarIntroMp + _bindAspectsOevalCtx :: EvalCtx + _bindAspectsOgUniq :: UID + _bindAspectsOintroCVarIntroMp :: CVarIntroMp + _bindAspectsOisGlobal :: Bool + _bindAspectsOletBindingsCateg :: CBindCateg + _bindAspectsOlev :: Int + _bindAspectsOmodNm :: HsName + _bindAspectsIbindL :: (AssocL Int CBind) + _bindAspectsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIcvarIntroExprMp :: CVarIntroMp + _bindAspectsIfvS :: FvS + _bindAspectsIfvSMp :: FvSMp + _bindAspectsIgUniq :: UID + _bindAspectsIlevBindSq :: LevBindSq + _bindAspectsIlevOf :: Int + _bindAspectsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 11, column 17) + _lhsOfvSMp = + Map.singleton nm_ _bindAspectsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 19, column 17) + _lhsOnmL = + [nm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + _bindAspectsIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _bindAspectsIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _bindAspectsIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindAspectsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _bindAspectsIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindAspectsIlevOf + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindAspectsIgUniq + -- copy rule (down) + _bindAspectsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindAspectsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindAspectsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindAspectsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOmodNm = + _lhsImodNm + ( _bindAspectsIbindL,_bindAspectsIbindsIntroCVarIntroMp,_bindAspectsIcTrf,_bindAspectsIcvarIntroExprMp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsIgUniq,_bindAspectsIlevBindSq,_bindAspectsIlevOf,_bindAspectsInmL) = + bindAspects_ _bindAspectsOcvarIntroMp _bindAspectsOevalCtx _bindAspectsOgUniq _bindAspectsOintroCVarIntroMp _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmodNm _bindAspectsOnm + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnm,_lhsOnmL))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CBindAnn,FvS,UID,LevBindSq,Int,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnn + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CBindAnnL,FvS,UID,LevBindSq,Int,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: UID + _hdOcvarIntroMp :: CVarIntroMp + _hdOgUniq :: UID + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOmodNm :: HsName + _tlOcvarIntroMp :: CVarIntroMp + _tlOgUniq :: UID + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOmodNm :: HsName + _hdIcTrf :: CBindAnn + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdIlevBindSq :: LevBindSq + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CBindAnnL + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlIlevBindSq :: LevBindSq + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _hdIlevBindSq Seq.:++: _tlIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmodNm = + _lhsImodNm + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmodNm = + _lhsImodNm + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevBindSq,_hdIlevOf,_hdInmL) = + hd_ _hdOcvarIntroMp _hdOgUniq _hdOintroCVarIntroMp _hdOlev _hdOmodNm + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevBindSq,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOgUniq _tlOintroCVarIntroMp _tlOlev _tlOmodNm + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + bindL : AssocL Int CBind + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBindL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( (AssocL Int CBind),CVarIntroMp,CBindL,CVarIntroMp,FvS,FvSMp,UID,LevBindSq,Int,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + _lhsOgUniq :: UID + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: UID + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOmodNm :: HsName + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: UID + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOmodNm :: HsName + _hdIbindL :: (AssocL Int CBind) + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBind + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: UID + _hdIlevBindSq :: LevBindSq + _hdIlevOf :: Int + _hdInm :: HsName + _hdInmL :: ([HsName]) + _tlIbindL :: (AssocL Int CBind) + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBindL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: UID + _tlIlevBindSq :: LevBindSq + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + _hdIbindL ++ _tlIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _hdIlevBindSq Seq.:++: _tlIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmodNm = + _lhsImodNm + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmodNm = + _lhsImodNm + ( _hdIbindL,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIlevBindSq,_hdIlevOf,_hdInm,_hdInmL) = + hd_ _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOisGlobal _hdOletBindingsCateg _hdOlev _hdOmodNm + ( _tlIbindL,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIlevBindSq,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNm + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + appTrfIsOk : AppTop + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + lamTrfIsOk : LamTop + letBindingsCateg : CBindCateg + letTrfIsOk : Bool + lev : Int + modNm : HsName + nm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + bindL : AssocL Int CBind + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBound + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cmetaVal : _ + local cvi : _ + local cviExpr : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = AppTop -> + CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Bool -> + Bool -> + Bool -> + LamTop -> + CBindCateg -> + Bool -> + Int -> + HsName -> + HsName -> + ( (AssocL Int CBind),CVarIntroMp,CBound,CVarIntroMp,FvS,FvSMp,UID,LevBindSq,Int,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsObindL :: (AssocL Int CBind) + _exprOappTrfIsOk :: AppTop + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + _bindMetaOcvarIntroMp :: CVarIntroMp + _bindMetaOgUniq :: UID + _bindMetaOintroCVarIntroMp :: CVarIntroMp + _bindMetaOlev :: Int + _bindMetaOmodNm :: HsName + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: UID + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _bindMetaIcTrf :: CMetas + _bindMetaIfvS :: FvS + _bindMetaIgUniq :: UID + _bindMetaIlevBindSq :: LevBindSq + _bindMetaIlevOf :: Int + _bindMetaIself :: CMetas + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cmetaVal = + cmetasVal _bindMetaIself + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cvi = + emptyCVarIntro { cviLev = _lhsIlev , cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cviExpr = + emptyCVarIntro { cviLev = _exprIlevOf, cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 53, column 17) + _lhsObindsIntroCVarIntroMp = + Map.singleton _lhsInm _cvi + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 75, column 17) + _lhsOcvarIntroExprMp = + Map.singleton _lhsInm _cviExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 96, column 17) + _lhsObindL = + [(_exprIlevOf,acoreBind1Asp1 _lhsInm _cTrf)] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 118, column 33) + _exprOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 146, column 33) + _exprOlamTrfIsOk = + LamNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 172, column 33) + _exprOletTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindMetaIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _bindMetaIlevBindSq Seq.:++: _exprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindMetaIlevOf `max` _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _bindMetaOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindMetaOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindMetaOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (down) + _bindMetaOmodNm = + _lhsImodNm + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _exprOgUniq = + _bindMetaIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIgUniq,_bindMetaIlevBindSq,_bindMetaIlevOf,_bindMetaIself) = + bindMeta_ _bindMetaOcvarIntroMp _bindMetaOgUniq _bindMetaOintroCVarIntroMp _bindMetaOlev _bindMetaOmodNm + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + _cmetasOcvarIntroMp :: CVarIntroMp + _cmetasOgUniq :: UID + _cmetasOintroCVarIntroMp :: CVarIntroMp + _cmetasOlev :: Int + _cmetasOmodNm :: HsName + _cmetasIcTrf :: CMetas + _cmetasIfvS :: FvS + _cmetasIgUniq :: UID + _cmetasIlevBindSq :: LevBindSq + _cmetasIlevOf :: Int + _cmetasIself :: CMetas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _cmetasIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _cmetasIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _cmetasIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _cmetasIgUniq + -- copy rule (down) + _cmetasOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _cmetasOgUniq = + _lhsIgUniq + -- copy rule (down) + _cmetasOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOmodNm = + _lhsImodNm + ( _cmetasIcTrf,_cmetasIfvS,_cmetasIgUniq,_cmetasIlevBindSq,_cmetasIlevOf,_cmetasIself) = + cmetas_ _cmetasOcvarIntroMp _cmetasOgUniq _cmetasOintroCVarIntroMp _cmetasOlev _cmetasOmodNm + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _whatAbove :: WhatExpr + _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: UID + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _exprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOappTrfIsOk = + _lhsIappTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _exprOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletBindingsCateg + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsObindL :: (AssocL Int CBind) + _exprOappTrfIsOk :: AppTop + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: UID + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: UID + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 81, column 17) + _whatAbove = + ExprIsLam 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 99, column 17) + _lhsObindL = + [(cLevModule,acoreBind1Asp1 _lhsInm _cTrf)] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 118, column 33) + _exprOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 146, column 33) + _exprOlamTrfIsOk = + LamNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 172, column 33) + _exprOletTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _exprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + modNm : HsName + nm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + bindL : AssocL Int CBind + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBoundL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Bool -> + CBindCateg -> + Int -> + HsName -> + HsName -> + ( (AssocL Int CBind),CVarIntroMp,CBoundL,CVarIntroMp,FvS,FvSMp,UID,LevBindSq,Int,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _hdOisTopApp :: Bool + _hdOisTopTup :: Bool + _hdOappTrfIsOk :: AppTop + _hdOlamTrfIsOk :: LamTop + _hdOletTrfIsOk :: Bool + _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: UID + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: UID + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOmodNm :: HsName + _hdOnm :: HsName + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: UID + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOmodNm :: HsName + _tlOnm :: HsName + _hdIbindL :: (AssocL Int CBind) + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBound + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: UID + _hdIlevBindSq :: LevBindSq + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIbindL :: (AssocL Int CBind) + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBoundL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: UID + _tlIlevBindSq :: LevBindSq + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 136, column 17) + _hdOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 162, column 17) + _hdOlamTrfIsOk = + LamNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 188, column 17) + _hdOletTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + _hdIbindL ++ _tlIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _hdIlevBindSq Seq.:++: _tlIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmodNm = + _lhsImodNm + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmodNm = + _lhsImodNm + -- copy rule (down) + _tlOnm = + _lhsInm + ( _hdIbindL,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIlevBindSq,_hdIlevOf,_hdInmL) = + hd_ _hdOappTrfIsOk _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOlamTrfIsOk _hdOletBindingsCateg _hdOletTrfIsOk _hdOlev _hdOmodNm _hdOnm + ( _tlIbindL,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIlevBindSq,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOmodNm _tlOnm + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsImodNm + _lhsInm -> + (let _lhsObindL :: (AssocL Int CBind) + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 72, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindL,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + appTrfIsOk : AppTop + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isTopApp : Bool + isTopTup : Bool + lamTrfIsOk : LamTop + letTrfIsOk : Bool + lev : Int + modNm : HsName + whatAbove : WhatExpr + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CExpr + fvS : FvS + levBindSq : LevBindSq + levOf : Int + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local nmAsp : {HsName} + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local maxBindLev : _ + local _tup2 : _ + local strLev : _ + local introCVarIntroMp : _ + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLet : _ + local evalCtx : _ + local isGlobal : _ + local _tup3 : _ + local lUniq : _ + local _tup4 : _ + local hereBindSq : _ + local remBindSq : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup5 : _ + local levBindSq : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopApp' : _ + local isGlobal : _ + local _tup6 : _ + local lUniq : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup7 : _ + local levBindSq : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cvi : _ + local levOf : _ + local fvS : _ + local argNm : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLam : _ + local lev : _ + local isGlobal : _ + local _tup8 : _ + local lUniq : _ + local lUniq2 : _ + local _tup9 : _ + local hereBindSq : _ + local remBindSq : _ + local letTrfIsOk : _ + local trNm : _ + local trNm2 : _ + local trfIsOk : _ + local _tup10 : _ + local levBindSq : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local _tup11 : _ + local lUniq : _ + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup12 : _ + local levBindSq : _ + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local _tup13 : _ + local lUniq : _ + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup14 : _ + local levBindSq : _ + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local _tup15 : _ + local lUniq : _ + local appTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup16 : _ + local levBindSq : _ + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local _tup17 : _ + local lUniq : _ + local appTrfIsOk : _ + local trNm : _ + local trfIsOk : _ + local _tup18 : _ + local levBindSq : _ + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative CoeArg: + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local appTrfIsOk : _ + local lamTrfIsOk : _ + local letTrfIsOk : _ + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = AppTop -> + CVarIntroMp -> + EvalCtx -> + UID -> + CVarIntroMp -> + Bool -> + Bool -> + LamTop -> + Bool -> + Int -> + HsName -> + WhatExpr -> + ( CExpr,FvS,UID,LevBindSq,Int,WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _lhsOlevOf :: Int + _lhsOfvS :: FvS + _nm :: HsName + _nmAsp :: HsName + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOlevBindSq :: LevBindSq + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 59, column 17) + _lhsOlevOf = + fvLev _nm _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 7, column 17) + _lhsOfvS = + Set.singleton _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 52, column 17) + _whatBelow = + ExprIsVar _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- self rule + _cTrf = + CExpr_Var ref_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 53, column 17) + _whatBelow = + ExprIsInt int_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 67, column 17) + _levOf = + cLevIntern + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 55, column 25) + _whatBelow = + ExprIsTup tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _bindsOcvarIntroMp :: CVarIntroMp + _bodyOcvarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _bindsOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _bodyOappTrfIsOk :: AppTop + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _bindsOevalCtx :: EvalCtx + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOisGlobal :: Bool + _bindsOletBindingsCateg :: CBindCateg + _bindsOlev :: Int + _bindsOmodNm :: HsName + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: UID + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamTrfIsOk :: LamTop + _bodyOletTrfIsOk :: Bool + _bodyOlev :: Int + _bodyOmodNm :: HsName + _bodyOwhatAbove :: WhatExpr + _bindsIbindL :: (AssocL Int CBind) + _bindsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindsIcTrf :: CBindL + _bindsIcvarIntroExprMp :: CVarIntroMp + _bindsIfvS :: FvS + _bindsIfvSMp :: FvSMp + _bindsIgUniq :: UID + _bindsIlevBindSq :: LevBindSq + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIlevBindSq :: LevBindSq + _bodyIlevOf :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 24, column 17) + _maxBindLev = + fvsLev _lhsIcvarIntroMp cLevModule _bindsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + __tup2 = + case categ_ of + CBindCateg_Strict -> (const _lhsIlev,_lhsIcvarIntroMp) + CBindCateg_Rec -> ( const _maxBindLev + , Map.map (\cvi -> cvi {cviLev = _maxBindLev}) _bindsIcvarIntroExprMp + `Map.union` _lhsIcvarIntroMp + ) + _ -> (id,_lhsIcvarIntroMp) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_strLev,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_,_bindsOcvarIntroMp) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 33, column 17) + _bodyOcvarIntroMp = + Map.map (\cvi -> cvi {cviLev = _strLev $ cviLev cvi}) _bindsIcvarIntroExprMp `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 45, column 17) + _introCVarIntroMp = + Map.map (\cvi -> cvi {cviLev = _lhsIlev}) _bindsIbindsIntroCVarIntroMp `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 66, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _fvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 6, column 17) + _fvS = + (_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 4, column 17) + _letBindingsCateg = + categ_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 75, column 17) + _isTopLet = + _lhsIwhatAbove == ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, column 17) + _evalCtx = + if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 58, column 17) + __tup3 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 58, column 17) + (_bindsOgUniq,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 58, column 17) + (_,_lUniq) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 80, column 17) + __tup4 = + let ((hl,_):_) = _bindsIbindL + b1 = _bindsIlevBindSq + b2 = Seq.singleton (_strLev hl,(categ_,assocLElts _bindsIbindL)) + b12 = Seq.singleton (_maxBindLev,(CBindCateg_Rec,concat $ List.map (\(_,(_,b)) -> b) $ Seq.toList $ (b1 Seq.:++: b2))) + b3 = _bodyIlevBindSq + b = case categ_ of + CBindCateg_Rec -> b12 Seq.:++: b3 + _ -> b1 Seq.:++: b2 Seq.:++: b3 + in (b,Seq.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 80, column 17) + (_hereBindSq,_) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 80, column 17) + (_,_remBindSq) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 90, column 17) + _lhsOlevBindSq = + _remBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 128, column 17) + _bodyOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 229, column 17) + _trfIsOk = + _lhsIletTrfIsOk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 241, column 17) + __tup5 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm $ mkLetTrf _hereBindSq _bodyIcTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 241, column 17) + (_lhsOcTrf,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 241, column 17) + (_,_levBindSq) = + __tup5 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _bindsOevalCtx = + _evalCtx + -- copy rule (from local) + _bindsOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (from local) + _bindsOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOmodNm = + _lhsImodNm + -- copy rule (from local) + _bodyOevalCtx = + _evalCtx + -- copy rule (chain) + _bodyOgUniq = + _bindsIgUniq + -- copy rule (from local) + _bodyOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _bodyOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmodNm = + _lhsImodNm + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindsIbindL,_bindsIbindsIntroCVarIntroMp,_bindsIcTrf,_bindsIcvarIntroExprMp,_bindsIfvS,_bindsIfvSMp,_bindsIgUniq,_bindsIlevBindSq,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOcvarIntroMp _bindsOevalCtx _bindsOgUniq _bindsOintroCVarIntroMp _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev _bindsOmodNm + ( _bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIlevBindSq,_bodyIlevOf,_bodyIwhatBelow) = + body_ _bodyOappTrfIsOk _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamTrfIsOk _bodyOletTrfIsOk _bodyOlev _bodyOmodNm _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _argOnm :: HsName + _funcOisTopApp :: Bool + _argOisTopApp :: Bool + _whatAbove :: WhatExpr + _argOevalCtx :: EvalCtx + _funcOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _funcOappTrfIsOk :: AppTop + _argOappTrfIsOk :: AppTop + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisTopTup :: Bool + _funcOlamTrfIsOk :: LamTop + _funcOletTrfIsOk :: Bool + _funcOlev :: Int + _funcOmodNm :: HsName + _funcOwhatAbove :: WhatExpr + _argOcvarIntroMp :: CVarIntroMp + _argOgUniq :: UID + _argOintroCVarIntroMp :: CVarIntroMp + _argOisGlobal :: Bool + _argOisTopTup :: Bool + _argOlamTrfIsOk :: LamTop + _argOletBindingsCateg :: CBindCateg + _argOletTrfIsOk :: Bool + _argOlev :: Int + _argOmodNm :: HsName + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIgUniq :: UID + _funcIlevBindSq :: LevBindSq + _funcIlevOf :: Int + _funcIwhatBelow :: WhatExpr + _argIbindL :: (AssocL Int CBind) + _argIbindsIntroCVarIntroMp :: CVarIntroMp + _argIcTrf :: CBound + _argIcvarIntroExprMp :: CVarIntroMp + _argIfvS :: FvS + _argIfvSMp :: FvSMp + _argIgUniq :: UID + _argIlevBindSq :: LevBindSq + _argIlevOf :: Int + _argInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 60, column 17) + _levOf = + _funcIlevOf `max` _argIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 8, column 17) + _fvS = + _funcIfvS `Set.union` _argIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 14, column 17) + _funcOisTopApp = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 15, column 17) + _argOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 54, column 17) + _whatBelow = + maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 70, column 17) + _whatAbove = + maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 77, column 17) + _isTopApp' = + isNothing $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 112, column 17) + _argOevalCtx = + EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 55, column 17) + __tup6 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 55, column 17) + (_funcOgUniq,_) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 55, column 17) + (_,_lUniq) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 75, column 17) + _lhsOlevBindSq = + _argIlevBindSq Seq.:++: _funcIlevBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 124, column 17) + _funcOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 125, column 17) + _argOappTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 180, column 17) + _letTrfIsOk = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 227, column 17) + _trfIsOk = + _lhsIappTrfIsOk == AppYesLet && _lhsIisTopApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + __tup7 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + (_lhsOcTrf,_) = + __tup7 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + (_,_levBindSq) = + __tup7 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- copy rule (up) + _lhsOgUniq = + _argIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (from local) + _funcOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _funcOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmodNm = + _lhsImodNm + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (down) + _argOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _argOgUniq = + _funcIgUniq + -- copy rule (down) + _argOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (from local) + _argOisTopTup = + _isTopTup + -- copy rule (from local) + _argOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _argOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _argOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOmodNm = + _lhsImodNm + ( _funcIcTrf,_funcIfvS,_funcIgUniq,_funcIlevBindSq,_funcIlevOf,_funcIwhatBelow) = + func_ _funcOappTrfIsOk _funcOcvarIntroMp _funcOevalCtx _funcOgUniq _funcOintroCVarIntroMp _funcOisTopApp _funcOisTopTup _funcOlamTrfIsOk _funcOletTrfIsOk _funcOlev _funcOmodNm _funcOwhatAbove + ( _argIbindL,_argIbindsIntroCVarIntroMp,_argIcTrf,_argIcvarIntroExprMp,_argIfvS,_argIfvSMp,_argIgUniq,_argIlevBindSq,_argIlevOf,_argInmL) = + arg_ _argOappTrfIsOk _argOcvarIntroMp _argOevalCtx _argOgUniq _argOintroCVarIntroMp _argOisGlobal _argOisTopApp _argOisTopTup _argOlamTrfIsOk _argOletBindingsCateg _argOletTrfIsOk _argOlev _argOmodNm _argOnm + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _bodyOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _bodyOappTrfIsOk :: AppTop + _bodyOlamTrfIsOk :: LamTop + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _bindOcvarIntroMp :: CVarIntroMp + _bindOevalCtx :: EvalCtx + _bindOgUniq :: UID + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOisGlobal :: Bool + _bindOletBindingsCateg :: CBindCateg + _bindOlev :: Int + _bindOmodNm :: HsName + _bodyOevalCtx :: EvalCtx + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOletTrfIsOk :: Bool + _bodyOlev :: Int + _bodyOmodNm :: HsName + _bodyOwhatAbove :: WhatExpr + _bindIbindL :: (AssocL Int CBind) + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: UID + _bindIlevBindSq :: LevBindSq + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIlevBindSq :: LevBindSq + _bodyIlevOf :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 4, column 17) + _cvi = + CVarIntro + { cviLev = _lev + , cviMeta = CMetaVal_Val + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 23, column 17) + _bodyOcvarIntroMp = + Map.insert _argNm _cvi _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 44, column 17) + _bodyOintroCVarIntroMp = + Map.insert _argNm _cvi _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 65, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 5, column 17) + _fvS = + _argNm `Set.delete` _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 51, column 17) + _whatBelow = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) + _whatAbove = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 76, column 17) + _isTopLam = + not $ whatExprIsLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 56, column 17) + __tup8 = + mkNewLevUID2 _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 56, column 17) + (_bodyOgUniq,_,_) = + __tup8 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 56, column 17) + (_,_lUniq,_) = + __tup8 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 56, column 17) + (_,_,_lUniq2) = + __tup8 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 91, column 33) + __tup9 = + (_bodyIlevBindSq,Seq.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 91, column 33) + (_hereBindSq,_) = + __tup9 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 91, column 33) + (_,_remBindSq) = + __tup9 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 93, column 17) + _lhsOlevBindSq = + _remBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 128, column 17) + _bodyOappTrfIsOk = + AppNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 154, column 17) + _bodyOlamTrfIsOk = + LamNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 195, column 17) + _trNm2 = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 228, column 17) + _trfIsOk = + _lhsIlamTrfIsOk == LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 235, column 17) + __tup10 = + let mkTLB = mkTrf _trfIsOk _lhsIlev _levOf _trNm + . acoreLam1 _argNm + . mkLetTrf _hereBindSq + in if cexprIsLam _bodyIcTrf && not (List.null (Seq.toList _hereBindSq)) + then mkTLB (CExpr_Let CBindCateg_Plain [acoreBind1Cat CBindCateg_Plain _trNm2 _bodyIcTrf] (acoreVar _trNm2)) + else mkTLB _bodyIcTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 235, column 17) + (_lhsOcTrf,_) = + __tup10 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 235, column 17) + (_,_levBindSq) = + __tup10 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (from local) + _bindOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (down) + _bindOmodNm = + _lhsImodNm + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOletTrfIsOk = + _letTrfIsOk + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (down) + _bodyOmodNm = + _lhsImodNm + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindIbindL,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlevBindSq,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOcvarIntroMp _bindOevalCtx _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOmodNm + ( _bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIlevBindSq,_bodyIlevOf,_bodyIwhatBelow) = + body_ _bodyOappTrfIsOk _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamTrfIsOk _bodyOletTrfIsOk _bodyOlev _bodyOmodNm _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _altsOcvarIntroMp :: CVarIntroMp + _altsOevalCtx :: EvalCtx + _altsOgUniq :: UID + _altsOintroCVarIntroMp :: CVarIntroMp + _altsOlev :: Int + _altsOmodNm :: HsName + _dfltOappTrfIsOk :: AppTop + _dfltOcvarIntroMp :: CVarIntroMp + _dfltOevalCtx :: EvalCtx + _dfltOgUniq :: UID + _dfltOintroCVarIntroMp :: CVarIntroMp + _dfltOisTopApp :: Bool + _dfltOisTopTup :: Bool + _dfltOlamTrfIsOk :: LamTop + _dfltOletTrfIsOk :: Bool + _dfltOlev :: Int + _dfltOmodNm :: HsName + _dfltOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + _altsIcTrf :: CAltL + _altsIfvS :: FvS + _altsIgUniq :: UID + _altsIlevBindSq :: LevBindSq + _altsIlevOf :: Int + _dfltIcTrf :: CExpr + _dfltIfvS :: FvS + _dfltIgUniq :: UID + _dfltIlevBindSq :: LevBindSq + _dfltIlevOf :: Int + _dfltIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 61, column 17) + _levOf = + _exprIlevOf `max` _altsIlevOf `max` _dfltIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + __tup11 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_exprOgUniq,_) = + __tup11 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_,_lUniq) = + __tup11 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 76, column 17) + _lhsOlevBindSq = + _exprIlevBindSq Seq.:++: _altsIlevBindSq Seq.:++: _dfltIlevBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 227, column 17) + _trfIsOk = + _lhsIappTrfIsOk == AppYesLet && _lhsIisTopApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + __tup12 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + (_lhsOcTrf,_) = + __tup12 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 234, column 17) + (_,_levBindSq) = + __tup12 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- copy rule (up) + _lhsOgUniq = + _dfltIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _exprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOisTopTup = + _isTopTup + -- copy rule (from local) + _exprOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _exprOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _altsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _altsOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _altsOgUniq = + _exprIgUniq + -- copy rule (down) + _altsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOmodNm = + _lhsImodNm + -- copy rule (from local) + _dfltOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _dfltOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _dfltOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _dfltOgUniq = + _altsIgUniq + -- copy rule (down) + _dfltOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _dfltOisTopApp = + _isTopApp + -- copy rule (from local) + _dfltOisTopTup = + _isTopTup + -- copy rule (from local) + _dfltOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _dfltOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOmodNm = + _lhsImodNm + -- copy rule (from local) + _dfltOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + ( _altsIcTrf,_altsIfvS,_altsIgUniq,_altsIlevBindSq,_altsIlevOf) = + alts_ _altsOcvarIntroMp _altsOevalCtx _altsOgUniq _altsOintroCVarIntroMp _altsOlev _altsOmodNm + ( _dfltIcTrf,_dfltIfvS,_dfltIgUniq,_dfltIlevBindSq,_dfltIlevOf,_dfltIwhatBelow) = + dflt_ _dfltOappTrfIsOk _dfltOcvarIntroMp _dfltOevalCtx _dfltOgUniq _dfltOintroCVarIntroMp _dfltOisTopApp _dfltOisTopTup _dfltOlamTrfIsOk _dfltOletTrfIsOk _dfltOlev _dfltOmodNm _dfltOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _errorExprOappTrfIsOk :: AppTop + _errorExprOcvarIntroMp :: CVarIntroMp + _errorExprOevalCtx :: EvalCtx + _errorExprOgUniq :: UID + _errorExprOintroCVarIntroMp :: CVarIntroMp + _errorExprOisTopApp :: Bool + _errorExprOisTopTup :: Bool + _errorExprOlamTrfIsOk :: LamTop + _errorExprOletTrfIsOk :: Bool + _errorExprOlev :: Int + _errorExprOmodNm :: HsName + _errorExprOwhatAbove :: WhatExpr + _errorExprIcTrf :: CExpr + _errorExprIfvS :: FvS + _errorExprIgUniq :: UID + _errorExprIlevBindSq :: LevBindSq + _errorExprIlevOf :: Int + _errorExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _errorExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _errorExprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _errorExprIlevOf + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _errorExprIgUniq + -- copy rule (up) + _lhsOwhatBelow = + _errorExprIwhatBelow + -- copy rule (down) + _errorExprOappTrfIsOk = + _lhsIappTrfIsOk + -- copy rule (down) + _errorExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _errorExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _errorExprOgUniq = + _lhsIgUniq + -- copy rule (down) + _errorExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _errorExprOisTopApp = + _isTopApp + -- copy rule (from local) + _errorExprOisTopTup = + _isTopTup + -- copy rule (down) + _errorExprOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _errorExprOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOmodNm = + _lhsImodNm + -- copy rule (from local) + _errorExprOwhatAbove = + _whatAbove + ( _errorExprIcTrf,_errorExprIfvS,_errorExprIgUniq,_errorExprIlevBindSq,_errorExprIlevOf,_errorExprIwhatBelow) = + errorExpr_ _errorExprOappTrfIsOk _errorExprOcvarIntroMp _errorExprOevalCtx _errorExprOgUniq _errorExprOintroCVarIntroMp _errorExprOisTopApp _errorExprOisTopTup _errorExprOlamTrfIsOk _errorExprOletTrfIsOk _errorExprOlev _errorExprOmodNm _errorExprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _offsetOappTrfIsOk :: AppTop + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: UID + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamTrfIsOk :: LamTop + _offsetOletTrfIsOk :: Bool + _offsetOlev :: Int + _offsetOmodNm :: HsName + _offsetOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIlevBindSq :: LevBindSq + _offsetIlevOf :: Int + _offsetIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 62, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + __tup13 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_exprOgUniq,_) = + __tup13 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_,_lUniq) = + __tup13 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 77, column 17) + _lhsOlevBindSq = + _exprIlevBindSq Seq.:++: _offsetIlevBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 127, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 226, column 17) + _trfIsOk = + _lhsIappTrfIsOk == AppYesLet && _lhsIisTopTup + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + __tup14 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_lhsOcTrf,_) = + __tup14 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_,_levBindSq) = + __tup14 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- copy rule (up) + _lhsOgUniq = + _offsetIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _exprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _exprOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (from local) + _offsetOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (from local) + _offsetOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _offsetOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmodNm = + _lhsImodNm + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + ( _offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIlevBindSq,_offsetIlevOf,_offsetIwhatBelow) = + offset_ _offsetOappTrfIsOk _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamTrfIsOk _offsetOletTrfIsOk _offsetOlev _offsetOmodNm _offsetOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _fldExprOlamTrfIsOk :: LamTop + _fldExprOletTrfIsOk :: Bool + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _offsetOappTrfIsOk :: AppTop + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: UID + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamTrfIsOk :: LamTop + _offsetOletTrfIsOk :: Bool + _offsetOlev :: Int + _offsetOmodNm :: HsName + _offsetOwhatAbove :: WhatExpr + _fldExprOappTrfIsOk :: AppTop + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOgUniq :: UID + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlev :: Int + _fldExprOmodNm :: HsName + _fldExprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIlevBindSq :: LevBindSq + _offsetIlevOf :: Int + _offsetIwhatBelow :: WhatExpr + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIgUniq :: UID + _fldExprIlevBindSq :: LevBindSq + _fldExprIlevOf :: Int + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + __tup15 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_exprOgUniq,_) = + __tup15 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_,_lUniq) = + __tup15 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 79, column 17) + _lhsOlevBindSq = + _exprIlevBindSq Seq.:++: _offsetIlevBindSq Seq.:++: _fldExprIlevBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 127, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 153, column 17) + _fldExprOlamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 179, column 17) + _fldExprOletTrfIsOk = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 226, column 17) + _trfIsOk = + _lhsIappTrfIsOk == AppYesLet && _lhsIisTopTup + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + __tup16 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_lhsOcTrf,_) = + __tup16 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_,_levBindSq) = + __tup16 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _exprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _exprOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (from local) + _offsetOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _offsetOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmodNm = + _lhsImodNm + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (from local) + _fldExprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmodNm = + _lhsImodNm + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + ( _offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIlevBindSq,_offsetIlevOf,_offsetIwhatBelow) = + offset_ _offsetOappTrfIsOk _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamTrfIsOk _offsetOletTrfIsOk _offsetOlev _offsetOmodNm _offsetOwhatAbove + ( _fldExprIcTrf,_fldExprIfvS,_fldExprIgUniq,_fldExprIlevBindSq,_fldExprIlevOf,_fldExprIwhatBelow) = + fldExpr_ _fldExprOappTrfIsOk _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamTrfIsOk _fldExprOletTrfIsOk _fldExprOlev _fldExprOmodNm _fldExprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: UID + _lhsOlevBindSq :: LevBindSq + _fldExprOlamTrfIsOk :: LamTop + _fldExprOletTrfIsOk :: Bool + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _offsetOappTrfIsOk :: AppTop + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: UID + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamTrfIsOk :: LamTop + _offsetOletTrfIsOk :: Bool + _offsetOlev :: Int + _offsetOmodNm :: HsName + _offsetOwhatAbove :: WhatExpr + _fldExprOappTrfIsOk :: AppTop + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOgUniq :: UID + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlev :: Int + _fldExprOmodNm :: HsName + _fldExprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIlevBindSq :: LevBindSq + _offsetIlevOf :: Int + _offsetIwhatBelow :: WhatExpr + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIgUniq :: UID + _fldExprIlevBindSq :: LevBindSq + _fldExprIlevOf :: Int + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + __tup17 = + mkNewUID _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_exprOgUniq,_) = + __tup17 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 60, column 17) + (_,_lUniq) = + __tup17 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 79, column 17) + _lhsOlevBindSq = + _exprIlevBindSq Seq.:++: _offsetIlevBindSq Seq.:++: _fldExprIlevBindSq Seq.:++: _levBindSq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 127, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 153, column 17) + _fldExprOlamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 179, column 17) + _fldExprOletTrfIsOk = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 192, column 17) + _trNm = + hsnQualUniqify _lhsImodNm $ + uidHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 226, column 17) + _trfIsOk = + _lhsIappTrfIsOk == AppYesLet && _lhsIisTopTup + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + __tup18 = + mkTrf _trfIsOk _lhsIlev _levOf _trNm _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_lhsOcTrf,_) = + __tup18 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 233, column 17) + (_,_levBindSq) = + __tup18 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _exprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _exprOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (from local) + _offsetOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _offsetOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmodNm = + _lhsImodNm + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (from local) + _fldExprOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmodNm = + _lhsImodNm + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + ( _offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIlevBindSq,_offsetIlevOf,_offsetIwhatBelow) = + offset_ _offsetOappTrfIsOk _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamTrfIsOk _offsetOletTrfIsOk _offsetOlev _offsetOmodNm _offsetOwhatAbove + ( _fldExprIcTrf,_fldExprIfvS,_fldExprIgUniq,_fldExprIlevBindSq,_fldExprIlevOf,_fldExprIwhatBelow) = + fldExpr_ _fldExprOappTrfIsOk _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamTrfIsOk _fldExprOletTrfIsOk _fldExprOlev _fldExprOmodNm _fldExprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 56, column 25) + _whatBelow = + ExprIsFFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _bodyOappTrfIsOk :: AppTop + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: UID + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamTrfIsOk :: LamTop + _bodyOletTrfIsOk :: Bool + _bodyOlev :: Int + _bodyOmodNm :: HsName + _bodyOwhatAbove :: WhatExpr + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIlevBindSq :: LevBindSq + _bodyIlevOf :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _bodyIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _bodyOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _bodyOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmodNm = + _lhsImodNm + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIlevBindSq,_bodyIlevOf,_bodyIwhatBelow) = + body_ _bodyOappTrfIsOk _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamTrfIsOk _bodyOletTrfIsOk _bodyOlev _bodyOmodNm _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _funcOappTrfIsOk :: AppTop + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOgUniq :: UID + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisTopApp :: Bool + _funcOisTopTup :: Bool + _funcOlamTrfIsOk :: LamTop + _funcOletTrfIsOk :: Bool + _funcOlev :: Int + _funcOmodNm :: HsName + _funcOwhatAbove :: WhatExpr + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIgUniq :: UID + _funcIlevBindSq :: LevBindSq + _funcIlevOf :: Int + _funcIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _funcIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _funcIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _funcIlevOf + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _funcIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _funcOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _funcOisTopApp = + _isTopApp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (from local) + _funcOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _funcOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmodNm = + _lhsImodNm + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + ( _funcIcTrf,_funcIfvS,_funcIgUniq,_funcIlevBindSq,_funcIlevOf,_funcIwhatBelow) = + func_ _funcOappTrfIsOk _funcOcvarIntroMp _funcOevalCtx _funcOgUniq _funcOintroCVarIntroMp _funcOisTopApp _funcOisTopTup _funcOlamTrfIsOk _funcOletTrfIsOk _funcOlev _funcOmodNm _funcOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _bodyOappTrfIsOk :: AppTop + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: UID + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamTrfIsOk :: LamTop + _bodyOletTrfIsOk :: Bool + _bodyOlev :: Int + _bodyOmodNm :: HsName + _bodyOwhatAbove :: WhatExpr + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIlevBindSq :: LevBindSq + _bodyIlevOf :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 130, column 17) + _appTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 156, column 17) + _lamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 182, column 17) + _letTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _bodyIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _bodyOappTrfIsOk = + _appTrfIsOk + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlamTrfIsOk = + _lamTrfIsOk + -- copy rule (from local) + _bodyOletTrfIsOk = + _letTrfIsOk + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmodNm = + _lhsImodNm + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIlevBindSq,_bodyIlevOf,_bodyIwhatBelow) = + body_ _bodyOappTrfIsOk _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamTrfIsOk _bodyOletTrfIsOk _bodyOlev _bodyOmodNm _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIappTrfIsOk + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamTrfIsOk + _lhsIletTrfIsOk + _lhsIlev + _lhsImodNm + _lhsIwhatAbove -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _annOcvarIntroMp :: CVarIntroMp + _annOgUniq :: UID + _annOintroCVarIntroMp :: CVarIntroMp + _annOlev :: Int + _annOmodNm :: HsName + _exprOappTrfIsOk :: AppTop + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: UID + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _annIcTrf :: CExprAnn + _annIfvS :: FvS + _annIgUniq :: UID + _annIlevBindSq :: LevBindSq + _annIlevOf :: Int + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _annIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _annIlevBindSq Seq.:++: _exprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _annIlevOf `max` _exprIlevOf + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOwhatBelow = + _exprIwhatBelow + -- copy rule (down) + _annOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _annOgUniq = + _lhsIgUniq + -- copy rule (down) + _annOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOmodNm = + _lhsImodNm + -- copy rule (down) + _exprOappTrfIsOk = + _lhsIappTrfIsOk + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _exprOgUniq = + _annIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamTrfIsOk = + _lhsIlamTrfIsOk + -- copy rule (down) + _exprOletTrfIsOk = + _lhsIletTrfIsOk + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (down) + _exprOwhatAbove = + _lhsIwhatAbove + ( _annIcTrf,_annIfvS,_annIgUniq,_annIlevBindSq,_annIlevOf) = + ann_ _annOcvarIntroMp _annOgUniq _annOintroCVarIntroMp _annOlev _annOmodNm + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOwhatBelow))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + levBindSq : LevBindSq + levOf : Int + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CExprAnn,FvS,UID,LevBindSq,Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + levBindSq : LevBindSq + levOf : Int + self : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + local self : _ + alternative Function0: + visit 0: + local cTrf : _ + local self : _ + alternative Function1: + visit 0: + local cTrf : _ + local self : _ + alternative Apply0: + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CMetaBind,FvS,UID,LevBindSq,Int,CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _self = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _self = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _self = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _self = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + levBindSq : LevBindSq + levOf : Int + self : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + local self : _ + alternative Dict: + visit 0: + local cTrf : _ + local self : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CMetaVal,FvS,UID,LevBindSq,Int,CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _self = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _self = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _self = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _self = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _self = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CMetas + fvS : FvS + levBindSq : LevBindSq + levOf : Int + self : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CMetas,FvS,UID,LevBindSq,Int,CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CMetas + _lhsOself :: CMetas + _lhsOgUniq :: UID + _x1OcvarIntroMp :: CVarIntroMp + _x1OgUniq :: UID + _x1OintroCVarIntroMp :: CVarIntroMp + _x1Olev :: Int + _x1OmodNm :: HsName + _x2OcvarIntroMp :: CVarIntroMp + _x2OgUniq :: UID + _x2OintroCVarIntroMp :: CVarIntroMp + _x2Olev :: Int + _x2OmodNm :: HsName + _x1IcTrf :: CMetaBind + _x1IfvS :: FvS + _x1IgUniq :: UID + _x1IlevBindSq :: LevBindSq + _x1IlevOf :: Int + _x1Iself :: CMetaBind + _x2IcTrf :: CMetaVal + _x2IfvS :: FvS + _x2IgUniq :: UID + _x2IlevBindSq :: LevBindSq + _x2IlevOf :: Int + _x2Iself :: CMetaVal + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _x1IfvS `Set.union` _x2IfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _x1IlevBindSq Seq.:++: _x2IlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _x1IlevOf `max` _x2IlevOf + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _self = + (_x1Iself,_x2Iself) + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOgUniq = + _x2IgUniq + -- copy rule (down) + _x1OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x1OgUniq = + _lhsIgUniq + -- copy rule (down) + _x1OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1OmodNm = + _lhsImodNm + -- copy rule (down) + _x2OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _x2OgUniq = + _x1IgUniq + -- copy rule (down) + _x2OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2OmodNm = + _lhsImodNm + ( _x1IcTrf,_x1IfvS,_x1IgUniq,_x1IlevBindSq,_x1IlevOf,_x1Iself) = + x1_ _x1OcvarIntroMp _x1OgUniq _x1OintroCVarIntroMp _x1Olev _x1OmodNm + ( _x2IcTrf,_x2IfvS,_x2IgUniq,_x2IlevBindSq,_x2IlevOf,_x2Iself) = + x2_ _x2OcvarIntroMp _x2OgUniq _x2OintroCVarIntroMp _x2Olev _x2OmodNm + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOself))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CModule + fvS : FvS + levBindSq : LevBindSq + levOf : Int + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CModule,FvS,UID,LevBindSq,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOappTrfIsOk :: AppTop + _exprOlamTrfIsOk :: LamTop + _exprOletTrfIsOk :: Bool + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CModule + _lhsOgUniq :: UID + _exprOcvarIntroMp :: CVarIntroMp + _exprOgUniq :: UID + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOmodNm :: HsName + _exprOwhatAbove :: WhatExpr + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIlevBindSq :: LevBindSq + _exprIlevOf :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 90, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 99, column 17) + _exprOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 113, column 17) + _exprOappTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 141, column 17) + _exprOlamTrfIsOk = + LamYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 167, column 17) + _exprOletTrfIsOk = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _exprIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmodNm = + _lhsImodNm + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIcTrf,_exprIfvS,_exprIgUniq,_exprIlevBindSq,_exprIlevOf,_exprIwhatBelow) = + expr_ _exprOappTrfIsOk _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamTrfIsOk _exprOletTrfIsOk _exprOlev _exprOmodNm _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CPat,([HsName]),FvS,UID,LevBindSq,Int,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: UID + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 28, column 17) + _lhsOnmL = + [pnm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: UID + _restOcvarIntroMp :: CVarIntroMp + _restOgUniq :: UID + _restOintroCVarIntroMp :: CVarIntroMp + _restOlev :: Int + _restOmodNm :: HsName + _bindsOcvarIntroMp :: CVarIntroMp + _bindsOgUniq :: UID + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOlev :: Int + _bindsOmodNm :: HsName + _restIcTrf :: CPatRest + _restIfvS :: FvS + _restIgUniq :: UID + _restIlevBindSq :: LevBindSq + _restIlevOf :: Int + _restInmL :: ([HsName]) + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + _bindsIfvS :: FvS + _bindsIgUniq :: UID + _bindsIlevBindSq :: LevBindSq + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 29, column 17) + _lhsOnmL = + _restInmL ++ _bindsInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _restIfvS `Set.union` _bindsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _restIlevBindSq Seq.:++: _bindsIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _restIlevOf `max` _bindsIlevOf + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindsIgUniq + -- copy rule (down) + _restOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _restOgUniq = + _lhsIgUniq + -- copy rule (down) + _restOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOmodNm = + _lhsImodNm + -- copy rule (down) + _bindsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _bindsOgUniq = + _restIgUniq + -- copy rule (down) + _bindsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOmodNm = + _lhsImodNm + ( _restIcTrf,_restIfvS,_restIgUniq,_restIlevBindSq,_restIlevOf,_restInmL) = + rest_ _restOcvarIntroMp _restOgUniq _restOintroCVarIntroMp _restOlev _restOmodNm + ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsIgUniq,_bindsIlevBindSq,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOcvarIntroMp _bindsOgUniq _bindsOintroCVarIntroMp _bindsOlev _bindsOmodNm + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CPatFld,([HsName]),FvS,UID,LevBindSq,Int,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _bindOletBindingsCateg :: CBindCateg + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _whatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _bindOevalCtx :: EvalCtx + _bindOisGlobal :: Bool + _offsetOappTrfIsOk :: AppTop + _offsetOlamTrfIsOk :: LamTop + _offsetOletTrfIsOk :: Bool + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CPatFld + _lhsOgUniq :: UID + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOgUniq :: UID + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlev :: Int + _offsetOmodNm :: HsName + _offsetOwhatAbove :: WhatExpr + _bindOcvarIntroMp :: CVarIntroMp + _bindOgUniq :: UID + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOlev :: Int + _bindOmodNm :: HsName + _fldAnnsOcvarIntroMp :: CVarIntroMp + _fldAnnsOgUniq :: UID + _fldAnnsOintroCVarIntroMp :: CVarIntroMp + _fldAnnsOlev :: Int + _fldAnnsOmodNm :: HsName + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIlevBindSq :: LevBindSq + _offsetIlevOf :: Int + _offsetIwhatBelow :: WhatExpr + _bindIbindL :: (AssocL Int CBind) + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: UID + _bindIlevBindSq :: LevBindSq + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIfvS :: FvS + _fldAnnsIgUniq :: UID + _fldAnnsIlevBindSq :: LevBindSq + _fldAnnsIlevOf :: Int + _fldAnnsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 22, column 17) + _lhsOnmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 9, column 17) + _bindOletBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 84, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) + _offsetOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 103, column 33) + _bindOevalCtx = + EvalCtx_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 121, column 17) + _offsetOappTrfIsOk = + AppYesLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 149, column 17) + _offsetOlamTrfIsOk = + LamNoLet + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 175, column 17) + _offsetOletTrfIsOk = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _offsetIlevBindSq Seq.:++: _bindIlevBindSq Seq.:++: _fldAnnsIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _offsetIlevOf `max` _bindIlevOf `max` _fldAnnsIlevOf + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldAnnsIgUniq + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOgUniq = + _lhsIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmodNm = + _lhsImodNm + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _bindOgUniq = + _offsetIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOmodNm = + _lhsImodNm + -- copy rule (down) + _fldAnnsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _fldAnnsOgUniq = + _bindIgUniq + -- copy rule (down) + _fldAnnsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOmodNm = + _lhsImodNm + ( _offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIlevBindSq,_offsetIlevOf,_offsetIwhatBelow) = + offset_ _offsetOappTrfIsOk _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamTrfIsOk _offsetOletTrfIsOk _offsetOlev _offsetOmodNm _offsetOwhatAbove + ( _bindIbindL,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlevBindSq,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOcvarIntroMp _bindOevalCtx _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOmodNm + ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsIgUniq,_fldAnnsIlevBindSq,_fldAnnsIlevOf,_fldAnnsInmL) = + fldAnns_ _fldAnnsOcvarIntroMp _fldAnnsOgUniq _fldAnnsOintroCVarIntroMp _fldAnnsOlev _fldAnnsOmodNm + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CPatFldL,([HsName]),FvS,UID,LevBindSq,Int,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: UID + _hdOcvarIntroMp :: CVarIntroMp + _hdOgUniq :: UID + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOmodNm :: HsName + _tlOcvarIntroMp :: CVarIntroMp + _tlOgUniq :: UID + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOmodNm :: HsName + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdIlevBindSq :: LevBindSq + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlIlevBindSq :: LevBindSq + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + _hdIlevBindSq Seq.:++: _tlIlevBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmodNm = + _lhsImodNm + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmodNm = + _lhsImodNm + ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdIgUniq,_hdIlevBindSq,_hdIlevOf,_hdInmL) = + hd_ _hdOcvarIntroMp _hdOgUniq _hdOintroCVarIntroMp _hdOlev _hdOmodNm + ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlIgUniq,_tlIlevBindSq,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOgUniq _tlOintroCVarIntroMp _tlOlev _tlOmodNm + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + modNm : HsName + chained attribute: + gUniq : UID + synthesized attributes: + cTrf : CPatRest + fvS : FvS + levBindSq : LevBindSq + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = CVarIntroMp -> + UID -> + CVarIntroMp -> + Int -> + HsName -> + ( CPatRest,FvS,UID,LevBindSq,Int,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOnmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOcTrf :: CPatRest + _lhsOgUniq :: UID + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 25, column 17) + _lhsOnmL = + [nm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlev + _lhsImodNm -> + (let _lhsOfvS :: FvS + _lhsOlevBindSq :: LevBindSq + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatRest + _lhsOgUniq :: UID + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ANormal.ag"(line 71, column 32) + _lhsOlevBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevBindSq,_lhsOlevOf,_lhsOnmL))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + gUniq : UID + modNm : HsName + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = UID -> + HsName -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {gUniq_Inh_CodeAGItf :: !(UID),modNm_Inh_CodeAGItf :: !(HsName)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIgUniq _lhsImodNm) = + (let ( _lhsOcTrf) = sem _lhsIgUniq _lhsImodNm + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIgUniq + _lhsImodNm -> + (let _moduleOcvarIntroMp :: CVarIntroMp + _moduleOintroCVarIntroMp :: CVarIntroMp + _moduleOlev :: Int + _lhsOcTrf :: CModule + _moduleOgUniq :: UID + _moduleOmodNm :: HsName + _moduleIcTrf :: CModule + _moduleIfvS :: FvS + _moduleIgUniq :: UID + _moduleIlevBindSq :: LevBindSq + _moduleIlevOf :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 20, column 17) + _moduleOcvarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 41, column 17) + _moduleOintroCVarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + -- copy rule (down) + _moduleOgUniq = + _lhsIgUniq + -- copy rule (down) + _moduleOmodNm = + _lhsImodNm + ( _moduleIcTrf,_moduleIfvS,_moduleIgUniq,_moduleIlevBindSq,_moduleIlevOf) = + module_ _moduleOcvarIntroMp _moduleOgUniq _moduleOintroCVarIntroMp _moduleOlev _moduleOmodNm + in ( _lhsOcTrf))) diff --git a/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs b/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs @@ -0,0 +1,11617 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRe) +module UHC.Light.Compiler.Core.Trf.AnaRelevance(cmodTrfAnaRelevance) where + +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Applicative +import UHC.Util.Utils +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AnaDomain +import UHC.Light.Compiler.AnaDomain.Utils +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.AnaDomain.Trf.Instantiate +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import UHC.Light.Compiler.AnaDomain.Pretty +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign + + + + + + + + + + + + + + + + + + + + + + +cmodTrfAnaRelevance + :: EHCOpts + -> DataGam + -> LamMp + -> CModule + -> ( CModule + , LamMp + ) +cmodTrfAnaRelevance + opts dataGam + lamMp + cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + , dataGam_Inh_CodeAGItf = dataGam + , lamMp_Inh_CodeAGItf = lamMp + }) + in ( cTrf_Syn_CodeAGItf t + , gathLamMp_Syn_CodeAGItf t + ) + + + +data WhatToRelevInfer + = WhatToRelevInfer_InstToBot -- specialize/instantiate types to bot (strict) + | WhatToRelevInfer_Quant -- quantify + deriving Eq + + + +type REnv = Gam HsName RelevTy + +-- | lookup in REnv first, then global LamMp +renvLookup :: HsName -> REnv -> LamMp -> Maybe RelevTy +renvLookup n renv lammp = gamLookup n renv <|> (fmap libindaspRelevTy $ lamMpLookupAsp n acbaspkeyDefaultRelevTy lammp) + + + +dbg opts t1 t2 amso ams = CExpr_Ann (CExprAnn_Debug $ showPP $ "?:" >#< t1 >#< "<=" >#< t2 >-< "ams:" >#< ams >-< "amso:" >#< amso) +dbgApp opts a f f2 = CExpr_Ann (CExprAnn_Debug $ showPP $ "argTy:" >#< a >#< "funTy:" >#< f >#< "func.ty:" >#< f2) +dbgBind opts m env = CExpr_Ann (CExprAnn_Debug $ showPP $ "env:" >#< (m `varUpd` env)) +dbgCase opts bnd as asslv asinter = CExpr_Ann (CExprAnn_Debug $ showPP $ "bnd:" >#< pp1 bnd >-< "altQualSL:" >#< ppl as >-< "altQualSLSlv:" >#< ppl asslv >-< "altQualSLInt:" >#< pp1 asinter) + where pp1 s = ppParensCommas $ Set.toList s + ppl l = ppCurlysCommasBlock (map pp1 l) + + + +annCoe :: RelevCoe -> CExpr -> CExpr +annCoe RelevCoe_Id e = e +annCoe c e = CExpr_Ann (CExprAnn_Coe c) e + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CAlt + coe : RelevCoe + fvS : FvS + mbCTag : Maybe CTag + oTrf : CAlt + qualS : RelevQualS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local fvS : _ + local whatAbove : {WhatExpr} + local lev : _ + local mbCTagEnv : _ + local patFldGivenTyL : _ + local patFldUsedTyL : {[RelevTy]} + local patEnv : _ + local altMbScrutTy : _ + local _tup1 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local lUniq3 : {UID} + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CAlt,RelevCoe,FvS,UID,(Maybe CTag),CAlt,RelevQualS,RVarMp) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _patFldUsedTyL :: ([RelevTy]) + _patOpatFldTyL :: ([(RelevTy,RelevTy)]) + _exprOenv :: REnv + _patOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lUniq3 :: UID + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CAlt + _lhsOoTrf :: CAlt + _lhsOcoe :: RelevCoe + _lhsOgUniq :: UID + _lhsOmbCTag :: (Maybe CTag) + _lhsOrvarMp :: RVarMp + _patOboundRelevTyVarS :: UIDS + _patOdataGam :: DataGam + _patOenv :: REnv + _patOfinalRVarMp :: RVarMp + _patOknTy :: RelevTy + _patOknTyCase :: RelevTy + _patOlamMp :: LamMp + _patOlev :: Int + _patOopts :: EHCOpts + _patOrvarMp :: RVarMp + _patOwhatTo :: ([WhatToRelevInfer]) + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _patIfvS :: FvS + _patIgUniq :: UID + _patImbCTag :: (Maybe CTag) + _patInmL :: ([HsName]) + _patIoTrf :: CPat + _patIpatFldTyL :: ([(RelevTy,RelevTy)]) + _patIqualS :: RelevQualS + _patIrvarMp :: RVarMp + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 14, column 17) + _fvS = + _exprIfvS `Set.difference` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 87, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 168, column 17) + _mbCTagEnv = + do { ct <- _patImbCTag + ; (argTyL,_) <- relevTyArgsFromCTag True ct Nothing (length _patIfldNmL) _lhsIdataGam _lUniq + ; return (gamFromAssocL $ zip _patIfldNmL argTyL, argTyL) + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 172, column 17) + _patFldGivenTyL = + maybe (map freshLazy $ mkNewLevUIDL (length _patIfldNmL) _lUniq3) + snd _mbCTagEnv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 172, column 17) + _patFldUsedTyL = + map fresh $ mkNewLevUIDL (length _patIfldNmL) _lUniq2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 172, column 17) + _patEnv = + gamFromAssocL $ zip _patIfldNmL _patFldUsedTyL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 178, column 17) + _patOpatFldTyL = + zip _patFldGivenTyL _patFldUsedTyL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 179, column 17) + _exprOenv = + gamAddGam _patEnv _lhsIenv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- -- generated by the unique rule mechanism. + __tup1 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} ) + -- -- generated by the unique rule mechanism. + (_patOgUniq,_,_,_) = + __tup1 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_,_) = + __tup1 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2,_) = + __tup1 + -- -- generated by the unique rule mechanism. + (_,_,_,_lUniq3) = + __tup1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _patIqualS `Set.union` _exprIqualS + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _oTrf = + CAlt_Alt _patIoTrf _exprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOcoe = + _exprIcoe + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOmbCTag = + _patImbCTag + -- copy rule (up) + _lhsOrvarMp = + _exprIrvarMp + -- copy rule (down) + _patOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _patOdataGam = + _lhsIdataGam + -- copy rule (down) + _patOenv = + _lhsIenv + -- copy rule (down) + _patOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _patOknTy = + _lhsIknTy + -- copy rule (down) + _patOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _patOlamMp = + _lhsIlamMp + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOopts = + _lhsIopts + -- copy rule (down) + _patOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _patOwhatTo = + _lhsIwhatTo + -- copy rule (from local) + _exprOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _exprOgUniq = + _patIgUniq + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (chain) + _exprOrvarMp = + _patIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _patIcTrf,_patIfldNmL,_patIfvS,_patIgUniq,_patImbCTag,_patInmL,_patIoTrf,_patIpatFldTyL,_patIqualS,_patIrvarMp) = + pat_ _patOboundRelevTyVarS _patOdataGam _patOenv _patOfinalRVarMp _patOgUniq _patOknTy _patOknTyCase _patOlamMp _patOlev _patOopts _patOpatFldTyL _patOrvarMp _patOwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOcTrf,_lhsOcoe,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + altId : UID + altMbScrutTy : MbRelevTy + altNrMax : Int + altSolveLVarMp : [RVarMp] + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + altNr : Int + altQualSL : [RelevQualS] + cTrf : CAltL + fvS : FvS + oTrf : CAltL + qualS : RelevQualS + ty : RelevTy + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local _tup2 : _ + local amsoDw : {AMSOut RelevTy} + local amsDw : {AnaMatchState} + local rvarMpDw : _ + local rvarMpUp : _ + local altNr : {Int} + local altKnUpTy : {RelevTy} + local altKnDwTy : {RelevTy} + local hereAltCoe : _ + local hdFinalRVarMp : _ + local _tup3 : _ + local altSolveVarMp : _ + local _tup4 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local cTrf : _ + local oTrf : _ + alternative Nil: + visit 0: + local altNr : {Int} + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = UID -> + MbRelevTy -> + Int -> + ([RVarMp]) -> + UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( Int,([RelevQualS]),CAltL,FvS,UID,CAltL,RelevQualS,RVarMp,RelevTy) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIaltId + _lhsIaltMbScrutTy + _lhsIaltNrMax + _lhsIaltSolveLVarMp + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _hdOknTy :: RelevTy + _amsoDw :: (AMSOut RelevTy) + _amsDw :: AnaMatchState + _altNr :: Int + _altKnUpTy :: RelevTy + _altKnDwTy :: RelevTy + _lhsOty :: RelevTy + _hdOrvarMp :: RVarMp + _hdOfinalRVarMp :: RVarMp + _lhsOaltQualSL :: ([RelevQualS]) + _tlOaltSolveLVarMp :: ([RVarMp]) + _lhsOcTrf :: CAltL + _hdOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOoTrf :: CAltL + _lhsOaltNr :: Int + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _hdOboundRelevTyVarS :: UIDS + _hdOdataGam :: DataGam + _hdOenv :: REnv + _hdOevalCtx :: EvalCtx + _hdOknTyCase :: RelevTy + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOopts :: EHCOpts + _hdOwhatTo :: ([WhatToRelevInfer]) + _tlOaltId :: UID + _tlOaltMbScrutTy :: MbRelevTy + _tlOaltNrMax :: Int + _tlOboundRelevTyVarS :: UIDS + _tlOdataGam :: DataGam + _tlOenv :: REnv + _tlOevalCtx :: EvalCtx + _tlOfinalRVarMp :: RVarMp + _tlOgUniq :: UID + _tlOknTy :: RelevTy + _tlOknTyCase :: RelevTy + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOopts :: EHCOpts + _tlOrvarMp :: RVarMp + _tlOwhatTo :: ([WhatToRelevInfer]) + _hdIcTrf :: CAlt + _hdIcoe :: RelevCoe + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdImbCTag :: (Maybe CTag) + _hdIoTrf :: CAlt + _hdIqualS :: RelevQualS + _hdIrvarMp :: RVarMp + _tlIaltNr :: Int + _tlIaltQualSL :: ([RelevQualS]) + _tlIcTrf :: CAltL + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlIoTrf :: CAltL + _tlIqualS :: RelevQualS + _tlIrvarMp :: RVarMp + _tlIty :: RelevTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 228, column 17) + _hdOknTy = + _altKnDwTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 280, column 33) + __tup2 = + amsLE _lhsIrvarMp _altKnDwTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 280, column 33) + (_amsoDw,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 280, column 33) + (_,_amsDw) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 280, column 17) + _rvarMpDw = + amsLocalVarMp _amsDw |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 280, column 17) + _rvarMpUp = + _rvarMpDw + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 289, column 17) + _altNr = + _tlIaltNr + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 298, column 17) + _altKnUpTy = + fresh _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 300, column 17) + _altKnDwTy = + fresh _lUniq2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 340, column 17) + _hereAltCoe = + _hdIcoe <.> (_hdFinalRVarMp `varUpd` amsoCoe _amsoDw) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 369, column 17) + _lhsOty = + _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 387, column 17) + _hdOrvarMp = + _rvarMpUp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 408, column 17) + _hdFinalRVarMp = + _altSolveVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 409, column 17) + _hdOfinalRVarMp = + _hdFinalRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 433, column 17) + _lhsOaltQualSL = + Set.unions [_hdIqualS, amsGathQual _amsDw] : _tlIaltQualSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 463, column 17) + __tup3 = + hdAndTl' (panic "altSolveLVarMp") _lhsIaltSolveLVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 463, column 17) + (_altSolveVarMp,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 463, column 17) + (_,_tlOaltSolveLVarMp) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 624, column 17) + _lhsOcTrf = + case _hdIcTrf of + CAlt_Alt p e -> CAlt_Alt p (annCoe _hereAltCoe e) : _tlIcTrf + -- -- generated by the unique rule mechanism. + __tup4 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} ) + -- -- generated by the unique rule mechanism. + (_hdOgUniq,_,_) = + __tup4 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_) = + __tup4 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2) = + __tup4 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _hdIqualS `Set.union` _tlIqualS + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _oTrf = + (:) _hdIoTrf _tlIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOaltNr = + _altNr + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOrvarMp = + _tlIrvarMp + -- copy rule (down) + _hdOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _hdOdataGam = + _lhsIdataGam + -- copy rule (down) + _hdOenv = + _lhsIenv + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _tlOaltId = + _lhsIaltId + -- copy rule (down) + _tlOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _tlOaltNrMax = + _lhsIaltNrMax + -- copy rule (down) + _tlOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _tlOdataGam = + _lhsIdataGam + -- copy rule (down) + _tlOenv = + _lhsIenv + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOknTy = + _lhsIknTy + -- copy rule (down) + _tlOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOrvarMp = + _hdIrvarMp + -- copy rule (down) + _tlOwhatTo = + _lhsIwhatTo + ( _hdIcTrf,_hdIcoe,_hdIfvS,_hdIgUniq,_hdImbCTag,_hdIoTrf,_hdIqualS,_hdIrvarMp) = + hd_ _hdOboundRelevTyVarS _hdOdataGam _hdOenv _hdOevalCtx _hdOfinalRVarMp _hdOgUniq _hdOknTy _hdOknTyCase _hdOlamMp _hdOlev _hdOopts _hdOrvarMp _hdOwhatTo + ( _tlIaltNr,_tlIaltQualSL,_tlIcTrf,_tlIfvS,_tlIgUniq,_tlIoTrf,_tlIqualS,_tlIrvarMp,_tlIty) = + tl_ _tlOaltId _tlOaltMbScrutTy _tlOaltNrMax _tlOaltSolveLVarMp _tlOboundRelevTyVarS _tlOdataGam _tlOenv _tlOevalCtx _tlOfinalRVarMp _tlOgUniq _tlOknTy _tlOknTyCase _tlOlamMp _tlOlev _tlOopts _tlOrvarMp _tlOwhatTo + in ( _lhsOaltNr,_lhsOaltQualSL,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIaltId + _lhsIaltMbScrutTy + _lhsIaltNrMax + _lhsIaltSolveLVarMp + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _altNr :: Int + _lhsOty :: RelevTy + _lhsOaltQualSL :: ([RelevQualS]) + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CAltL + _lhsOoTrf :: CAltL + _lhsOaltNr :: Int + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 288, column 17) + _altNr = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 369, column 17) + _lhsOty = + _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 434, column 17) + _lhsOaltQualSL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + [] + -- self rule + _oTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOaltNr = + _altNr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOaltNr,_lhsOaltQualSL,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + forQuantRVarMp : RVarMp + isGlobal : Bool + knTy : RelevTy + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + altMbScrutTy : MbRelevTy + bindLamMp : LamMp + cTrf : CBind + extraBindRVarMp : RVarMp + fvS : FvS + fvSMp : FvSMp + gathEnv : REnv + gathRecEnv : REnv + nm : HsName + nmL : [HsName] + oTrf : CBind + qualS : RelevQualS + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + RVarMp -> + UID -> + Bool -> + RelevTy -> + LamMp -> + CBindCateg -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( MbRelevTy,LamMp,CBind,RVarMp,FvS,FvSMp,UID,REnv,REnv,HsName,([HsName]),CBind,RelevQualS,RVarMp) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvSMp :: FvSMp + _lhsOnmL :: ([HsName]) + _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBind + _lhsOoTrf :: CBind + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _bindAspectsOboundRelevTyVarS :: UIDS + _bindAspectsOdataGam :: DataGam + _bindAspectsOenv :: REnv + _bindAspectsOevalCtx :: EvalCtx + _bindAspectsOfinalRVarMp :: RVarMp + _bindAspectsOforQuantRVarMp :: RVarMp + _bindAspectsOgUniq :: UID + _bindAspectsOisGlobal :: Bool + _bindAspectsOknTy :: RelevTy + _bindAspectsOlamMp :: LamMp + _bindAspectsOletBindingsCateg :: CBindCateg + _bindAspectsOlev :: Int + _bindAspectsOopts :: EHCOpts + _bindAspectsOrvarMp :: RVarMp + _bindAspectsOwhatTo :: ([WhatToRelevInfer]) + _bindAspectsIaltMbScrutTy :: MbRelevTy + _bindAspectsIbindLamMp :: LamMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIextraBindRVarMp :: RVarMp + _bindAspectsIfvS :: FvS + _bindAspectsIfvSMp :: FvSMp + _bindAspectsIgUniq :: UID + _bindAspectsIgathEnv :: REnv + _bindAspectsIgathRecEnv :: REnv + _bindAspectsInmL :: ([HsName]) + _bindAspectsIoTrf :: CBoundL + _bindAspectsIqualS :: RelevQualS + _bindAspectsIrvarMp :: RVarMp + _bindAspectsItyAspectL :: ([CBound]) + _bindAspectsIvalAspectL :: ([CBound]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 11, column 17) + _lhsOfvSMp = + Map.singleton nm_ _bindAspectsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 19, column 17) + _lhsOnmL = + [nm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 609, column 17) + _cTrf = + CBind_Bind nm_ (_bindAspectsItyAspectL ++ _bindAspectsIvalAspectL ++ _bindAspectsIcTrf) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _bindAspectsIaltMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _bindAspectsIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + _bindAspectsIextraBindRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindAspectsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + _bindAspectsIgathEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + _bindAspectsIgathRecEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _bindAspectsIqualS + -- self rule + _oTrf = + CBind_Bind nm_ _bindAspectsIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _bindAspectsIgUniq + -- copy rule (up) + _lhsOrvarMp = + _bindAspectsIrvarMp + -- copy rule (down) + _bindAspectsOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindAspectsOdataGam = + _lhsIdataGam + -- copy rule (down) + _bindAspectsOenv = + _lhsIenv + -- copy rule (down) + _bindAspectsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindAspectsOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _bindAspectsOforQuantRVarMp = + _lhsIforQuantRVarMp + -- copy rule (down) + _bindAspectsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOknTy = + _lhsIknTy + -- copy rule (down) + _bindAspectsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindAspectsOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOopts = + _lhsIopts + -- copy rule (down) + _bindAspectsOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _bindAspectsOwhatTo = + _lhsIwhatTo + ( _bindAspectsIaltMbScrutTy,_bindAspectsIbindLamMp,_bindAspectsIcTrf,_bindAspectsIextraBindRVarMp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsIgUniq,_bindAspectsIgathEnv,_bindAspectsIgathRecEnv,_bindAspectsInmL,_bindAspectsIoTrf,_bindAspectsIqualS,_bindAspectsIrvarMp,_bindAspectsItyAspectL,_bindAspectsIvalAspectL) = + bindAspects_ _bindAspectsOboundRelevTyVarS _bindAspectsOdataGam _bindAspectsOenv _bindAspectsOevalCtx _bindAspectsOfinalRVarMp _bindAspectsOforQuantRVarMp _bindAspectsOgUniq _bindAspectsOisGlobal _bindAspectsOknTy _bindAspectsOlamMp _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOopts _bindAspectsOrvarMp _bindAspectsOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnm,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + nmL : [HsName] + oTrf : CBindAnn + qualS : RelevQualS + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CBindAnn,FvS,UID,([HsName]),CBindAnn,RelevQualS,RVarMp) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBindAnn + _lhsOoTrf :: CBindAnn + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _oTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + nmL : [HsName] + oTrf : CBindAnnL + qualS : RelevQualS + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + local oTrf : _ + alternative Nil: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CBindAnnL,FvS,UID,([HsName]),CBindAnnL,RelevQualS,RVarMp) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBindAnnL + _lhsOoTrf :: CBindAnnL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _hdOboundRelevTyVarS :: UIDS + _hdOdataGam :: DataGam + _hdOenv :: REnv + _hdOfinalRVarMp :: RVarMp + _hdOgUniq :: UID + _hdOknTy :: RelevTy + _hdOknTyCase :: RelevTy + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOopts :: EHCOpts + _hdOrvarMp :: RVarMp + _hdOwhatTo :: ([WhatToRelevInfer]) + _tlOboundRelevTyVarS :: UIDS + _tlOdataGam :: DataGam + _tlOenv :: REnv + _tlOfinalRVarMp :: RVarMp + _tlOgUniq :: UID + _tlOknTy :: RelevTy + _tlOknTyCase :: RelevTy + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOopts :: EHCOpts + _tlOrvarMp :: RVarMp + _tlOwhatTo :: ([WhatToRelevInfer]) + _hdIcTrf :: CBindAnn + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdInmL :: ([HsName]) + _hdIoTrf :: CBindAnn + _hdIqualS :: RelevQualS + _hdIrvarMp :: RVarMp + _tlIcTrf :: CBindAnnL + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlInmL :: ([HsName]) + _tlIoTrf :: CBindAnnL + _tlIqualS :: RelevQualS + _tlIrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _hdIqualS `Set.union` _tlIqualS + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _oTrf = + (:) _hdIoTrf _tlIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOrvarMp = + _tlIrvarMp + -- copy rule (down) + _hdOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _hdOdataGam = + _lhsIdataGam + -- copy rule (down) + _hdOenv = + _lhsIenv + -- copy rule (down) + _hdOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOknTy = + _lhsIknTy + -- copy rule (down) + _hdOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _hdOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _tlOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _tlOdataGam = + _lhsIdataGam + -- copy rule (down) + _tlOenv = + _lhsIenv + -- copy rule (down) + _tlOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOknTy = + _lhsIknTy + -- copy rule (down) + _tlOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOrvarMp = + _hdIrvarMp + -- copy rule (down) + _tlOwhatTo = + _lhsIwhatTo + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdInmL,_hdIoTrf,_hdIqualS,_hdIrvarMp) = + hd_ _hdOboundRelevTyVarS _hdOdataGam _hdOenv _hdOfinalRVarMp _hdOgUniq _hdOknTy _hdOknTyCase _hdOlamMp _hdOlev _hdOopts _hdOrvarMp _hdOwhatTo + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlInmL,_tlIoTrf,_tlIqualS,_tlIrvarMp) = + tl_ _tlOboundRelevTyVarS _tlOdataGam _tlOenv _tlOfinalRVarMp _tlOgUniq _tlOknTy _tlOknTyCase _tlOlamMp _tlOlev _tlOopts _tlOrvarMp _tlOwhatTo + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBindAnnL + _lhsOoTrf :: CBindAnnL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + [] + -- self rule + _oTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + forQuantRVarMp : RVarMp + isGlobal : Bool + knTy : RelevTy + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + altMbScrutTy : MbRelevTy + bindLamMp : LamMp + cTrf : CBindL + extraBindRVarMp : RVarMp + fvS : FvS + fvSMp : FvSMp + gathEnv : REnv + gathRecEnv : REnv + nmL : [HsName] + oTrf : CBindL + qualS : RelevQualS + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + local oTrf : _ + alternative Nil: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + RVarMp -> + UID -> + Bool -> + RelevTy -> + LamMp -> + CBindCateg -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( MbRelevTy,LamMp,CBindL,RVarMp,FvS,FvSMp,UID,REnv,REnv,([HsName]),CBindL,RelevQualS,RVarMp) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBindL + _lhsOoTrf :: CBindL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _hdOboundRelevTyVarS :: UIDS + _hdOdataGam :: DataGam + _hdOenv :: REnv + _hdOevalCtx :: EvalCtx + _hdOfinalRVarMp :: RVarMp + _hdOforQuantRVarMp :: RVarMp + _hdOgUniq :: UID + _hdOisGlobal :: Bool + _hdOknTy :: RelevTy + _hdOlamMp :: LamMp + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOopts :: EHCOpts + _hdOrvarMp :: RVarMp + _hdOwhatTo :: ([WhatToRelevInfer]) + _tlOboundRelevTyVarS :: UIDS + _tlOdataGam :: DataGam + _tlOenv :: REnv + _tlOevalCtx :: EvalCtx + _tlOfinalRVarMp :: RVarMp + _tlOforQuantRVarMp :: RVarMp + _tlOgUniq :: UID + _tlOisGlobal :: Bool + _tlOknTy :: RelevTy + _tlOlamMp :: LamMp + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOopts :: EHCOpts + _tlOrvarMp :: RVarMp + _tlOwhatTo :: ([WhatToRelevInfer]) + _hdIaltMbScrutTy :: MbRelevTy + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBind + _hdIextraBindRVarMp :: RVarMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: UID + _hdIgathEnv :: REnv + _hdIgathRecEnv :: REnv + _hdInm :: HsName + _hdInmL :: ([HsName]) + _hdIoTrf :: CBind + _hdIqualS :: RelevQualS + _hdIrvarMp :: RVarMp + _tlIaltMbScrutTy :: MbRelevTy + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBindL + _tlIextraBindRVarMp :: RVarMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: UID + _tlIgathEnv :: REnv + _tlIgathRecEnv :: REnv + _tlInmL :: ([HsName]) + _tlIoTrf :: CBindL + _tlIqualS :: RelevQualS + _tlIrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _hdIaltMbScrutTy <|> _tlIaltMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + _hdIextraBindRVarMp |+> _tlIextraBindRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + _hdIgathEnv `gamUnion` _tlIgathEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + _hdIgathRecEnv `gamUnion` _tlIgathRecEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _hdIqualS `Set.union` _tlIqualS + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _oTrf = + (:) _hdIoTrf _tlIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOrvarMp = + _tlIrvarMp + -- copy rule (down) + _hdOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _hdOdataGam = + _lhsIdataGam + -- copy rule (down) + _hdOenv = + _lhsIenv + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _hdOforQuantRVarMp = + _lhsIforQuantRVarMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOknTy = + _lhsIknTy + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _hdOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _tlOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _tlOdataGam = + _lhsIdataGam + -- copy rule (down) + _tlOenv = + _lhsIenv + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _tlOforQuantRVarMp = + _lhsIforQuantRVarMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOknTy = + _lhsIknTy + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOrvarMp = + _hdIrvarMp + -- copy rule (down) + _tlOwhatTo = + _lhsIwhatTo + ( _hdIaltMbScrutTy,_hdIbindLamMp,_hdIcTrf,_hdIextraBindRVarMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIgathEnv,_hdIgathRecEnv,_hdInm,_hdInmL,_hdIoTrf,_hdIqualS,_hdIrvarMp) = + hd_ _hdOboundRelevTyVarS _hdOdataGam _hdOenv _hdOevalCtx _hdOfinalRVarMp _hdOforQuantRVarMp _hdOgUniq _hdOisGlobal _hdOknTy _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOopts _hdOrvarMp _hdOwhatTo + ( _tlIaltMbScrutTy,_tlIbindLamMp,_tlIcTrf,_tlIextraBindRVarMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIgathEnv,_tlIgathRecEnv,_tlInmL,_tlIoTrf,_tlIqualS,_tlIrvarMp) = + tl_ _tlOboundRelevTyVarS _tlOdataGam _tlOenv _tlOevalCtx _tlOfinalRVarMp _tlOforQuantRVarMp _tlOgUniq _tlOisGlobal _tlOknTy _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOopts _tlOrvarMp _tlOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CBindL + _lhsOoTrf :: CBindL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + [] + -- self rule + _oTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + forQuantRVarMp : RVarMp + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + knTy : RelevTy + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + altMbScrutTy : MbRelevTy + bindLamMp : LamMp + cTrf : CBound + coe : RelevCoe + extraBindRVarMp : RVarMp + fvS : FvS + fvSMp : FvSMp + gathEnv : REnv + gathRecEnv : REnv + nmL : [HsName] + oTrf : CBound + qualS : RelevQualS + tyAspectL : [CBound] + valAspectL : [CBound] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local doBindStrict : {Bool} + local gathEnv : _ + local gathRecEnv : _ + local altMbScrutTy : _ + local hereBindCoe : _ + local finalRVarMp : _ + local extraBindRVarMp : _ + local _tup5 : _ + local ty : {RelevTy} + local exprKnTy : {RelevTy} + local exprEnv : {REnv} + local exprBoundS : {UIDS} + local bindConstrain : {RVarMp -> RelevTy -> RelevTy -> (AnaMatchState,Maybe RelevCoe)} + local _tup6 : _ + local amsBind : {AnaMatchState} + local mbBindCoe : {Maybe RelevCoe} + local rvarMpExpr : _ + local _tup7 : _ + local quantTy : {RelevTy} + local quantVarMp : {RVarMp} + local quantRemQualS : {RelevQualS} + local bindTy : {RelevTy} + local _tup8 : _ + local strictTy : {RelevTy} + local strictVarMp : {RVarMp} + local debugTy1 : _ + local debugTy2 : _ + local strictTy2 : {RelevTy} + local tyAspectL : _ + local valAspectL : _ + local _tup9 : _ + local lUniq : {UID} + local cTrf : _ + local oTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local altMbScrutTy : _ + local cTrf : _ + local oTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local altMbScrutTy : _ + local cTrf : _ + local oTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local altMbScrutTy : _ + local cTrf : _ + local oTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local altMbScrutTy : _ + local cTrf : _ + local oTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local argTyLresTy : _ + local argTyL : _ + local resTy : _ + local foreignEntInfo : _ + local expEntNm : _ + local altMbScrutTy : _ + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + RVarMp -> + UID -> + Bool -> + Bool -> + Bool -> + RelevTy -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( MbRelevTy,LamMp,CBound,RelevCoe,RVarMp,FvS,FvSMp,UID,REnv,REnv,([HsName]),CBound,RelevQualS,RVarMp,([CBound]),([CBound])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _doBindStrict :: Bool + _lhsObindLamMp :: LamMp + _exprOenv :: REnv + _exprOknTy :: RelevTy + _lhsOaltMbScrutTy :: MbRelevTy + _lhsOcoe :: RelevCoe + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _exprOboundRelevTyVarS :: UIDS + _ty :: RelevTy + _exprKnTy :: RelevTy + _exprEnv :: REnv + _exprBoundS :: UIDS + _bindConstrain :: (RVarMp -> RelevTy -> RelevTy -> (AnaMatchState,Maybe RelevCoe)) + _amsBind :: AnaMatchState + _mbBindCoe :: (Maybe RelevCoe) + _quantTy :: RelevTy + _quantVarMp :: RVarMp + _quantRemQualS :: RelevQualS + _bindTy :: RelevTy + _strictTy :: RelevTy + _strictVarMp :: RVarMp + _strictTy2 :: RelevTy + _lhsOcTrf :: CBound + _bindMetaOgUniq :: UID + _lUniq :: UID + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOoTrf :: CBound + _lhsOgUniq :: UID + _bindMetaOboundRelevTyVarS :: UIDS + _bindMetaOdataGam :: DataGam + _bindMetaOenv :: REnv + _bindMetaOfinalRVarMp :: RVarMp + _bindMetaOknTy :: RelevTy + _bindMetaOlamMp :: LamMp + _bindMetaOlev :: Int + _bindMetaOopts :: EHCOpts + _bindMetaOrvarMp :: RVarMp + _bindMetaOwhatTo :: ([WhatToRelevInfer]) + _exprOaltMbScrutTy :: MbRelevTy + _exprOdataGam :: DataGam + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _bindMetaIcTrf :: CMetas + _bindMetaIfvS :: FvS + _bindMetaIgUniq :: UID + _bindMetaIoTrf :: CMetas + _bindMetaIqualS :: RelevQualS + _bindMetaIrvarMp :: RVarMp + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 117, column 17) + _doBindStrict = + WhatToRelevInfer_InstToBot `elem` _lhsIwhatTo + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 118, column 17) + _lhsObindLamMp = + let l = [ (acbaspkeyDefaultRelevTy, LamInfoBindAsp_RelevTy _bindTy) ] + in Map.singleton _lhsInm (emptyLamInfo {laminfoBindAspMp = Map.fromList l}) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 156, column 17) + _exprOenv = + gamAddGam _exprEnv _lhsIenv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 198, column 17) + _gathEnv = + gamSingleton _lhsInm _quantTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 198, column 17) + _gathRecEnv = + gamSingleton _lhsInm $ tup123to1 $ relevtyQuant [RelevTyQuantHow_Rec] emptyRVarMp Set.empty _ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 207, column 17) + _exprOknTy = + _exprKnTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 309, column 17) + _lhsOaltMbScrutTy = + do v <- _exprImbVar + renvLookup v _lhsIenv Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 336, column 17) + _hereBindCoe = + _exprIcoe <.> maybe RelevCoe_Id (_finalRVarMp `varUpd`) _mbBindCoe + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 25) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 378, column 17) + _lhsOrvarMp = + _quantVarMp |+> _rvarMpExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 405, column 17) + _finalRVarMp = + _lhsIfinalRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 415, column 17) + _extraBindRVarMp = + if _doBindStrict then _strictVarMp else emptyRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 428, column 17) + _lhsOqualS = + Set.unions [amsGathQual _amsBind, _exprIqualS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 489, column 17) + _exprOboundRelevTyVarS = + _exprBoundS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + __tup5 = + let noConstrain _ _ _ = (emptyAnaMatchState, Nothing) + strictConstrain m t knTy = (ams, Just $ amsoCoe amso) + where (amso,ams) = amsLE m t knTy + in case _exprImbLam of + Just nmL + -> (ty, r', exprEnv, varFreeSet ty, noConstrain) + where us@(r:as) = mkNewLevUIDL (1 + length nmL) _lUniq + r' = fresh r + as' = map fresh as + exprEnv = gamFromAssocL (zip nmL as') + ty = RelevTy_Fun RQuant_None [] [] as' r' + _ | isStrict -> (bTy, bTy, emptyGam, Set.empty, strictConstrain) + | otherwise -> (bTy, bTy, emptyGam, Set.empty, noConstrain) + where isStrict = _lhsIletBindingsCateg == CBindCateg_Strict + (_,u1,u2) = mkNewLevUID2 _lUniq + eTy@(RelevTy_Ana eAna) = fresh u1 + bTy@(RelevTy_Ana bAna) = fresh u2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + (_ty,_,_,_,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + (_,_exprKnTy,_,_,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + (_,_,_exprEnv,_,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + (_,_,_,_exprBoundS,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 33) + (_,_,_,_,_bindConstrain) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, column 33) + __tup6 = + _bindConstrain _exprIrvarMp _exprKnTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, column 33) + (_amsBind,_) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, column 33) + (_,_mbBindCoe) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _rvarMpExpr = + amsLocalVarMp _amsBind |+> _exprIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 517, column 33) + __tup7 = + case _ty of + t@(RelevTy_Fun _ _ _ _ _) + -> relevtyQuant ([RelevTyQuantHow_Solve] ++ how) + _rvarMpExpr _exprIqualS t + where how | WhatToRelevInfer_Quant `elem` _lhsIwhatTo = [RelevTyQuantHow_RemoveAmbig,RelevTyQuantHow_Quant] + | otherwise = [] + t -> (m `varUpd` t, m, q) + where (q,m) = assSolve _lhsIboundRelevTyVarS (Set.map (_rvarMpExpr `varUpd`) _exprIqualS) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 517, column 33) + (_quantTy,_,_) = + __tup7 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 517, column 33) + (_,_quantVarMp,_) = + __tup7 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 517, column 33) + (_,_,_quantRemQualS) = + __tup7 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _bindTy = + _lhsIforQuantRVarMp `varUpd` _quantTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 527, column 33) + __tup8 = + case _bindTy of + t@(RelevTy_Fun _ _ qs a r@(RelevTy_Ana (AnaEval_Var rv))) + -> (sty, smp2 |+> smpAssume2 |+> smp1 |+> smpAssume1) + where smpAssume1 = rvarmpEvalUnit rv bot + (RelevTy_Fun _ vs' qs' a' r',smp1,rem1) + = relevtyQuant [RelevTyQuantHow_Solve,RelevTyQuantHow_RemoveAmbig,RelevTyQuantHow_Quant] + smpAssume1 (Set.fromList qs `Set.union` _quantRemQualS) (RelevTy_Fun RQuant_None [] [] a (smpAssume1 `varUpd` r)) + smpAssume2 = rvarmpUnions [ rvarmpEvalUnit v top | v <- vs' ] + (sty,smp2,_) + = relevtyQuant [RelevTyQuantHow_Solve,RelevTyQuantHow_RemoveAmbig,RelevTyQuantHow_Quant] + smpAssume2 (Set.fromList qs' `Set.union` rem1) (RelevTy_Fun RQuant_None [] [] (smpAssume2 `varUpd` a') r') + t -> (m `varUpd` t, m) + where (q,m) = assSolve Set.empty (Set.map (_lhsIforQuantRVarMp `varUpd`) _quantRemQualS) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 527, column 33) + (_strictTy,_) = + __tup8 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 527, column 33) + (_,_strictVarMp) = + __tup8 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _debugTy1 = + case _rvarMpExpr `varUpd` _ty of + RelevTy_Fun _ _ _ a r + -> RelevTy_Fun RQuant_None v q a r + where q = _rvarMpExpr `varUpd` Set.toList _exprIqualS + v = Set.toList $ Set.unions [varFreeSet q, varFreeSet a, varFreeSet r] + t -> t + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _debugTy2 = + case _lhsIfinalRVarMp `varUpd` _ty of + RelevTy_Fun _ _ _ a r + -> RelevTy_Fun RQuant_None [] q a r + where q = _lhsIfinalRVarMp `varUpd` Set.toList _exprIqualS + t -> t + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _strictTy2 = + _lhsIfinalRVarMp `varUpd` _strictTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 495, column 17) + _tyAspectL = + [ CBound_RelevTy acbaspkeyDefault _bindTy + ] + ++ (if _doBindStrict + then [CBound_RelevTy acbaspkeyStrict _strictTy2] + else [] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 604, column 17) + _lhsOcTrf = + CBound_Bind _bindMetaIcTrf $ + dbgBind _lhsIopts _lhsIfinalRVarMp _gathEnv $ + annCoe _hereBindCoe _exprIcTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 633, column 17) + _valAspectL = + [ + ] + -- -- generated by the unique rule mechanism. + __tup9 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- -- generated by the unique rule mechanism. + (_bindMetaOgUniq,_) = + __tup9 + -- -- generated by the unique rule mechanism. + (_,_lUniq) = + __tup9 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + _extraBindRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindMetaIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + _gathEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + _gathRecEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + _tyAspectL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + _valAspectL + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _oTrf = + CBound_Bind _bindMetaIoTrf _exprIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _bindMetaOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindMetaOdataGam = + _lhsIdataGam + -- copy rule (down) + _bindMetaOenv = + _lhsIenv + -- copy rule (from local) + _bindMetaOfinalRVarMp = + _finalRVarMp + -- copy rule (down) + _bindMetaOknTy = + _lhsIknTy + -- copy rule (down) + _bindMetaOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (down) + _bindMetaOopts = + _lhsIopts + -- copy rule (down) + _bindMetaOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _bindMetaOwhatTo = + _lhsIwhatTo + -- copy rule (from local) + _exprOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _exprOfinalRVarMp = + _finalRVarMp + -- copy rule (chain) + _exprOgUniq = + _bindMetaIgUniq + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (chain) + _exprOrvarMp = + _bindMetaIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIgUniq,_bindMetaIoTrf,_bindMetaIqualS,_bindMetaIrvarMp) = + bindMeta_ _bindMetaOboundRelevTyVarS _bindMetaOdataGam _bindMetaOenv _bindMetaOfinalRVarMp _bindMetaOgUniq _bindMetaOknTy _bindMetaOlamMp _bindMetaOlev _bindMetaOopts _bindMetaOrvarMp _bindMetaOwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOcoe :: RelevCoe + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBound + _lhsOoTrf :: CBound + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _cmetasOboundRelevTyVarS :: UIDS + _cmetasOdataGam :: DataGam + _cmetasOenv :: REnv + _cmetasOfinalRVarMp :: RVarMp + _cmetasOgUniq :: UID + _cmetasOknTy :: RelevTy + _cmetasOlamMp :: LamMp + _cmetasOlev :: Int + _cmetasOopts :: EHCOpts + _cmetasOrvarMp :: RVarMp + _cmetasOwhatTo :: ([WhatToRelevInfer]) + _cmetasIcTrf :: CMetas + _cmetasIfvS :: FvS + _cmetasIgUniq :: UID + _cmetasIoTrf :: CMetas + _cmetasIqualS :: RelevQualS + _cmetasIrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 25) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _altMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _cmetasIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _cmetasIqualS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _oTrf = + CBound_Meta aspectKeyS_ _cmetasIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _cmetasIgUniq + -- copy rule (up) + _lhsOrvarMp = + _cmetasIrvarMp + -- copy rule (down) + _cmetasOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _cmetasOdataGam = + _lhsIdataGam + -- copy rule (down) + _cmetasOenv = + _lhsIenv + -- copy rule (down) + _cmetasOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _cmetasOgUniq = + _lhsIgUniq + -- copy rule (down) + _cmetasOknTy = + _lhsIknTy + -- copy rule (down) + _cmetasOlamMp = + _lhsIlamMp + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOopts = + _lhsIopts + -- copy rule (down) + _cmetasOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _cmetasOwhatTo = + _lhsIwhatTo + ( _cmetasIcTrf,_cmetasIfvS,_cmetasIgUniq,_cmetasIoTrf,_cmetasIqualS,_cmetasIrvarMp) = + cmetas_ _cmetasOboundRelevTyVarS _cmetasOdataGam _cmetasOenv _cmetasOfinalRVarMp _cmetasOgUniq _cmetasOknTy _cmetasOlamMp _cmetasOlev _cmetasOopts _cmetasOrvarMp _cmetasOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOcoe :: RelevCoe + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBound + _lhsOoTrf :: CBound + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 25) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _altMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _oTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _whatAbove :: WhatExpr + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBound + _lhsOoTrf :: CBound + _lhsOcoe :: RelevCoe + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _altMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _oTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOcoe = + _exprIcoe + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _exprOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOcoe :: RelevCoe + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBound + _lhsOoTrf :: CBound + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 25) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _altMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _oTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOcoe :: RelevCoe + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBound + _lhsOoTrf :: CBound + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 81, column 17) + _whatAbove = + ExprIsLam 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 21, column 17) + _argTyLresTy = + appUnArr ty_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 21, column 17) + _argTyL = + fst _argTyLresTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 21, column 17) + _resTy = + snd _argTyLresTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 21, column 17) + _foreignEntInfo = + foreignEntExtract expEnt_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 21, column 17) + _expEntNm = + forextractEnt _foreignEntInfo + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 25) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _altMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _oTrf = + CBound_FFE callconv_ expEnt_ _exprIoTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _exprOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOcoe,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + forQuantRVarMp : RVarMp + isGlobal : Bool + knTy : RelevTy + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + altMbScrutTy : MbRelevTy + bindLamMp : LamMp + cTrf : CBoundL + extraBindRVarMp : RVarMp + fvS : FvS + fvSMp : FvSMp + gathEnv : REnv + gathRecEnv : REnv + nmL : [HsName] + oTrf : CBoundL + qualS : RelevQualS + tyAspectL : [CBound] + valAspectL : [CBound] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + local oTrf : _ + alternative Nil: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + RVarMp -> + UID -> + Bool -> + RelevTy -> + LamMp -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( MbRelevTy,LamMp,CBoundL,RVarMp,FvS,FvSMp,UID,REnv,REnv,([HsName]),CBoundL,RelevQualS,RVarMp,([CBound]),([CBound])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _hdOisTopApp :: Bool + _hdOisTopTup :: Bool + _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBoundL + _lhsOoTrf :: CBoundL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _hdOboundRelevTyVarS :: UIDS + _hdOdataGam :: DataGam + _hdOenv :: REnv + _hdOevalCtx :: EvalCtx + _hdOfinalRVarMp :: RVarMp + _hdOforQuantRVarMp :: RVarMp + _hdOgUniq :: UID + _hdOisGlobal :: Bool + _hdOknTy :: RelevTy + _hdOlamMp :: LamMp + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOnm :: HsName + _hdOopts :: EHCOpts + _hdOrvarMp :: RVarMp + _hdOwhatTo :: ([WhatToRelevInfer]) + _tlOboundRelevTyVarS :: UIDS + _tlOdataGam :: DataGam + _tlOenv :: REnv + _tlOevalCtx :: EvalCtx + _tlOfinalRVarMp :: RVarMp + _tlOforQuantRVarMp :: RVarMp + _tlOgUniq :: UID + _tlOisGlobal :: Bool + _tlOknTy :: RelevTy + _tlOlamMp :: LamMp + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOnm :: HsName + _tlOopts :: EHCOpts + _tlOrvarMp :: RVarMp + _tlOwhatTo :: ([WhatToRelevInfer]) + _hdIaltMbScrutTy :: MbRelevTy + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBound + _hdIcoe :: RelevCoe + _hdIextraBindRVarMp :: RVarMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: UID + _hdIgathEnv :: REnv + _hdIgathRecEnv :: REnv + _hdInmL :: ([HsName]) + _hdIoTrf :: CBound + _hdIqualS :: RelevQualS + _hdIrvarMp :: RVarMp + _hdItyAspectL :: ([CBound]) + _hdIvalAspectL :: ([CBound]) + _tlIaltMbScrutTy :: MbRelevTy + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBoundL + _tlIextraBindRVarMp :: RVarMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: UID + _tlIgathEnv :: REnv + _tlIgathRecEnv :: REnv + _tlInmL :: ([HsName]) + _tlIoTrf :: CBoundL + _tlIqualS :: RelevQualS + _tlIrvarMp :: RVarMp + _tlItyAspectL :: ([CBound]) + _tlIvalAspectL :: ([CBound]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopTup = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + _hdIaltMbScrutTy <|> _tlIaltMbScrutTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + _hdIextraBindRVarMp |+> _tlIextraBindRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + _hdIgathEnv `gamUnion` _tlIgathEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + _hdIgathRecEnv `gamUnion` _tlIgathRecEnv + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _hdIqualS `Set.union` _tlIqualS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + _hdItyAspectL ++ _tlItyAspectL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + _hdIvalAspectL ++ _tlIvalAspectL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _oTrf = + (:) _hdIoTrf _tlIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOrvarMp = + _tlIrvarMp + -- copy rule (down) + _hdOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _hdOdataGam = + _lhsIdataGam + -- copy rule (down) + _hdOenv = + _lhsIenv + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _hdOforQuantRVarMp = + _lhsIforQuantRVarMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOknTy = + _lhsIknTy + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _hdOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _tlOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _tlOdataGam = + _lhsIdataGam + -- copy rule (down) + _tlOenv = + _lhsIenv + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _tlOforQuantRVarMp = + _lhsIforQuantRVarMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOknTy = + _lhsIknTy + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOrvarMp = + _hdIrvarMp + -- copy rule (down) + _tlOwhatTo = + _lhsIwhatTo + ( _hdIaltMbScrutTy,_hdIbindLamMp,_hdIcTrf,_hdIcoe,_hdIextraBindRVarMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIgathEnv,_hdIgathRecEnv,_hdInmL,_hdIoTrf,_hdIqualS,_hdIrvarMp,_hdItyAspectL,_hdIvalAspectL) = + hd_ _hdOboundRelevTyVarS _hdOdataGam _hdOenv _hdOevalCtx _hdOfinalRVarMp _hdOforQuantRVarMp _hdOgUniq _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOknTy _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOnm _hdOopts _hdOrvarMp _hdOwhatTo + ( _tlIaltMbScrutTy,_tlIbindLamMp,_tlIcTrf,_tlIextraBindRVarMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIgathEnv,_tlIgathRecEnv,_tlInmL,_tlIoTrf,_tlIqualS,_tlIrvarMp,_tlItyAspectL,_tlIvalAspectL) = + tl_ _tlOboundRelevTyVarS _tlOdataGam _tlOenv _tlOevalCtx _tlOfinalRVarMp _tlOforQuantRVarMp _tlOgUniq _tlOisGlobal _tlOknTy _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOnm _tlOopts _tlOrvarMp _tlOwhatTo + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIforQuantRVarMp + _lhsIgUniq + _lhsIisGlobal + _lhsIknTy + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOaltMbScrutTy :: MbRelevTy + _lhsObindLamMp :: LamMp + _lhsOextraBindRVarMp :: RVarMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathEnv :: REnv + _lhsOgathRecEnv :: REnv + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOtyAspectL :: ([CBound]) + _lhsOvalAspectL :: ([CBound]) + _lhsOcTrf :: CBoundL + _lhsOoTrf :: CBoundL + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 33) + _lhsOaltMbScrutTy = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 36) + _lhsOextraBindRVarMp = + emptyRVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 194, column 32) + _lhsOgathEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 32) + _lhsOgathRecEnv = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 575, column 32) + _lhsOtyAspectL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 576, column 32) + _lhsOvalAspectL = + [] + -- self rule + _cTrf = + [] + -- self rule + _oTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOaltMbScrutTy,_lhsObindLamMp,_lhsOcTrf,_lhsOextraBindRVarMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathEnv,_lhsOgathRecEnv,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOtyAspectL,_lhsOvalAspectL))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + altMbScrutTy : MbRelevTy + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + evalCtx : EvalCtx + finalRVarMp : RVarMp + isTopApp : Bool + isTopTup : Bool + knTy : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatAbove : WhatExpr + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + appFunKind : AppFunKind + argL : [CBound] + cTrf : CExpr + coe : RelevCoe + funCoe : RelevCoe + fvS : FvS + gathLamMp : LamMp + mbFFIApp : Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + ) + mbFunVar : Maybe HsName + mbLam : Maybe [HsName] + mbVar : Maybe HsName + oTrf : CExpr + qualS : RelevQualS + ty : RelevTy + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local mbVar : {Maybe HsName} + local nm : {HsName} + local nmAsp : {HsName} + local mbEnvTy : _ + local _tup10 : _ + local envTy : {RelevTy} + local envQualS : {RelevQualS} + local _tup11 : _ + local amso : {AMSOut RelevTy} + local ams : {AnaMatchState} + local dbg : _ + local _tup12 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local lUniq3 : {UID} + local cTrf : _ + local oTrf : _ + alternative Int: + child int : {Int} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local litTy : {RelevTy} + local _tup13 : _ + local amso : {AMSOut RelevTy} + local ams : {AnaMatchState} + local dbg : _ + local cTrf : _ + local oTrf : _ + alternative Char: + child char : {Char} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local litTy : {RelevTy} + local _tup14 : _ + local amso : {AMSOut RelevTy} + local ams : {AnaMatchState} + local dbg : _ + local cTrf : _ + local oTrf : _ + alternative String: + child str : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local _tup15 : _ + local tupTy : {RelevTy} + local tupQualS : _ + local _tup16 : _ + local amso : {AMSOut RelevTy} + local ams : {AnaMatchState} + local dbg : _ + local _tup17 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local cTrf : _ + local oTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local fvS : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLet : _ + local evalCtx : _ + local isGlobal : _ + local bindsCanParticpateInOuterSolving : {Bool} + local bindsQualSSubs : _ + local bindsQualSOuter : _ + local bindsQualSSolv1 : _ + local bindsQualSSolv2 : _ + local bindsSolveVarMp : _ + local cTrf : _ + local oTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local fvS : _ + local letBindingsCateg : _ + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopApp' : _ + local argL : _ + local isGlobal : _ + local funTy : {RelevTy} + local _tup18 : _ + local argTy : {RelevTy} + local resTy : _ + local resFunTy : _ + local hereArgCoe : _ + local hereFunCoe : _ + local _tup19 : _ + local argCoe : _ + local resCoe : _ + local forQuantRVarMp : _ + local _tup20 : _ + local lUniq : {UID} + local cTrf : _ + local oTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local fvS : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLam : _ + local argNm : _ + local lev : _ + local isGlobal : _ + local hereBodyCoe : _ + local forQuantRVarMp : _ + local cTrf : _ + local oTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local altQualSLSubs : {[RelevQualS]} + local altQualSLSolv1 : {[(RelevQualS,RVarMp)]} + local altQualSLSolv : {[RelevQualS]} + local altQualSIntersect : {RelevQualS} + local altQualSLSolv2 : _ + local altSolveLVarMp : {[RVarMp]} + local dbg : _ + local _tup21 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local cTrf : _ + local oTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local argTyLresTy : {( TyL, Ty )} + local argTyL : {TyL} + local resTy : _ + local foreignEntInfo : _ + local mbPrimNeedEval : {Maybe PrimitiveNeedsEval} + local primArgNeedsEvalL : _ + local primResNeedsEval : {Bool} + local argMbConL : _ + local resMbCon : _ + local _tup22 : _ + local ffiTy : {RelevTy} + local ffiQualS : _ + local _tup23 : _ + local amso : {AMSOut RelevTy} + local ams : {AnaMatchState} + local dbg : _ + local _tup24 : _ + local lUniq : {UID} + local lUniq2 : {UID} + local cTrf : _ + local oTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative CoeArg: + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local oTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = MbRelevTy -> + UIDS -> + DataGam -> + REnv -> + EvalCtx -> + RVarMp -> + UID -> + Bool -> + Bool -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + WhatExpr -> + ([WhatToRelevInfer]) -> + ( AppFunKind,([CBound]),CExpr,RelevCoe,RelevCoe,FvS,UID,LamMp,(Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )),(Maybe HsName),(Maybe [HsName]),(Maybe HsName),CExpr,RelevQualS,RVarMp,RelevTy,WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _lhsOfvS :: FvS + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _mbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _nm :: HsName + _nmAsp :: HsName + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _envTy :: RelevTy + _envQualS :: RelevQualS + _amso :: (AMSOut RelevTy) + _ams :: AnaMatchState + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lUniq3 :: UID + _lhsOoTrf :: CExpr + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 7, column 17) + _lhsOfvS = + Set.singleton _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 52, column 17) + _whatBelow = + ExprIsVar _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 13, column 17) + _lhsOappFunKind = + AppFunKind_Fun ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 21, column 17) + _mbVar = + Just _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 5, column 17) + _lhsOmbFunVar = + _mbVar + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 159, column 17) + _mbEnvTy = + fmap (relevtyInst _lUniq) (renvLookup _nm _lhsIenv _lhsIlamMp) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 160, column 33) + __tup10 = + maybe (top, Set.empty) id _mbEnvTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 160, column 33) + (_envTy,_) = + __tup10 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 160, column 33) + (_,_envQualS) = + __tup10 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 234, column 33) + __tup11 = + let mk envTy knTy + = case (envTy,knTy) of + (RelevTy_Ana ana,t@(RelevTy_Fun _ _ _ a r@(RelevTy_Ana rAna))) + -> ( amso' {amsoCoe = RelevCoe_Eval ana rAna <.> RelevCoe_CastTy envTy envTy' <.> amsoCoe amso'} + , ams' {amsGathQual = Set.insert (RelevQual_SubEval ana rAna) $ amsGathQual ams'} + ) + where (amso',ams') = amsLE _lhsIrvarMp envTy' t + envTy' = anaMkBotFun $ length a + ty'@(RelevTy_Ana ana') = fresh _lUniq2 + (t1,t2) + -> ( amsoMkOk t1 t2 (RelevCoe_CastTy t1 t2) + , emptyAnaMatchState + ) + in case _mbEnvTy of + Just (envTy,_) + | amsoIsOk amso -> o + | otherwise -> mk envTy _lhsIknTy + where o@(amso,ams) = amsLE _lhsIrvarMp envTy _lhsIknTy + _ -> mk (fresh _lUniq3) _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 234, column 33) + (_amso,_) = + __tup11 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 234, column 33) + (_,_ams) = + __tup11 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 319, column 17) + _lhsOcoe = + _lhsIfinalRVarMp `varUpd` amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 350, column 17) + _lhsOfunCoe = + last $ relevCoeToComposeList $ amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 362, column 17) + _lhsOty = + amsoHi _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 382, column 17) + _lhsOrvarMp = + amsLocalVarMp _ams |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 421, column 17) + _lhsOqualS = + Set.union _envQualS (amsGathQual _ams) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 594, column 17) + _dbg = + dbg _lhsIopts _envTy _lhsIknTy _amso _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, column 17) + _lhsOcTrf = + _cTrf + -- -- generated by the unique rule mechanism. + __tup12 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} ) + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_,_,_) = + __tup12 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_,_) = + __tup12 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2,_) = + __tup12 + -- -- generated by the unique rule mechanism. + (_,_,_,_lUniq3) = + __tup12 + -- self rule + _cTrf = + CExpr_Var ref_ + -- self rule + _oTrf = + CExpr_Var ref_ + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOmbVar = + _mbVar + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _litTy :: RelevTy + _amso :: (AMSOut RelevTy) + _ams :: AnaMatchState + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 53, column 17) + _whatBelow = + ExprIsInt int_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 231, column 17) + _litTy = + bot + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + __tup13 = + amsLE _lhsIrvarMp _litTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + (_amso,_) = + __tup13 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + (_,_ams) = + __tup13 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 319, column 17) + _lhsOcoe = + _lhsIfinalRVarMp `varUpd` amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 350, column 17) + _lhsOfunCoe = + last $ relevCoeToComposeList $ amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 362, column 17) + _lhsOty = + amsoHi _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 382, column 17) + _lhsOrvarMp = + amsLocalVarMp _ams |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 424, column 17) + _lhsOqualS = + amsGathQual _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 595, column 17) + _dbg = + dbg _lhsIopts _litTy _lhsIknTy _amso _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, column 17) + _lhsOcTrf = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _oTrf = + CExpr_Int int_ + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _litTy :: RelevTy + _amso :: (AMSOut RelevTy) + _ams :: AnaMatchState + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 231, column 17) + _litTy = + bot + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + __tup14 = + amsLE _lhsIrvarMp _litTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + (_amso,_) = + __tup14 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 232, column 33) + (_,_ams) = + __tup14 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 319, column 17) + _lhsOcoe = + _lhsIfinalRVarMp `varUpd` amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 350, column 17) + _lhsOfunCoe = + last $ relevCoeToComposeList $ amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 362, column 17) + _lhsOty = + amsoHi _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 382, column 17) + _lhsOrvarMp = + amsLocalVarMp _ams |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 424, column 17) + _lhsOqualS = + amsGathQual _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 595, column 17) + _dbg = + dbg _lhsIopts _litTy _lhsIknTy _amso _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, column 17) + _lhsOcTrf = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _oTrf = + CExpr_Char char_ + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _oTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _oTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _tupTy :: RelevTy + _amso :: (AMSOut RelevTy) + _ams :: AnaMatchState + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lhsOfvS :: FvS + _lhsOoTrf :: CExpr + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 55, column 25) + _whatBelow = + ExprIsTup tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 11, column 17) + _lhsOappFunKind = + AppFunKind_Tag tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 255, column 33) + __tup15 = + let r = fresh _lUniq2 + arity = whatExprAppArity _lhsIwhatAbove + in maybe (RelevTy_Err "CExpr.Tup.tupTy", Set.empty) (\(a,qs) -> (RelevTy_Fun RQuant_None [] [] a r, qs)) + $ relevTyArgsFromCTag False tag_ (Just r) arity _lhsIdataGam _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 255, column 33) + (_tupTy,_) = + __tup15 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 255, column 33) + (_,_tupQualS) = + __tup15 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 259, column 33) + __tup16 = + amsLE _lhsIrvarMp _tupTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 259, column 33) + (_amso,_) = + __tup16 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 259, column 33) + (_,_ams) = + __tup16 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 319, column 17) + _lhsOcoe = + _lhsIfinalRVarMp `varUpd` amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 350, column 17) + _lhsOfunCoe = + last $ relevCoeToComposeList $ amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 362, column 17) + _lhsOty = + amsoHi _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 382, column 17) + _lhsOrvarMp = + amsLocalVarMp _ams |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 423, column 17) + _lhsOqualS = + Set.union _tupQualS (amsGathQual _ams) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 596, column 17) + _dbg = + dbg _lhsIopts _tupTy _lhsIknTy _amso _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, column 17) + _lhsOcTrf = + _cTrf + -- -- generated by the unique rule mechanism. + __tup17 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} ) + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_,_) = + __tup17 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_) = + __tup17 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2) = + __tup17 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _oTrf = + CExpr_Tup tag_ + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _bindsOenv :: REnv + _bodyOenv :: REnv + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _bodyOrvarMp :: RVarMp + _bindsOforQuantRVarMp :: RVarMp + _bindsCanParticpateInOuterSolving :: Bool + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOcoe :: RelevCoe + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _bindsOboundRelevTyVarS :: UIDS + _bindsOdataGam :: DataGam + _bindsOevalCtx :: EvalCtx + _bindsOfinalRVarMp :: RVarMp + _bindsOgUniq :: UID + _bindsOisGlobal :: Bool + _bindsOknTy :: RelevTy + _bindsOlamMp :: LamMp + _bindsOletBindingsCateg :: CBindCateg + _bindsOlev :: Int + _bindsOopts :: EHCOpts + _bindsOrvarMp :: RVarMp + _bindsOwhatTo :: ([WhatToRelevInfer]) + _bodyOaltMbScrutTy :: MbRelevTy + _bodyOboundRelevTyVarS :: UIDS + _bodyOdataGam :: DataGam + _bodyOevalCtx :: EvalCtx + _bodyOfinalRVarMp :: RVarMp + _bodyOgUniq :: UID + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOknTy :: RelevTy + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOopts :: EHCOpts + _bodyOwhatAbove :: WhatExpr + _bodyOwhatTo :: ([WhatToRelevInfer]) + _bindsIaltMbScrutTy :: MbRelevTy + _bindsIbindLamMp :: LamMp + _bindsIcTrf :: CBindL + _bindsIextraBindRVarMp :: RVarMp + _bindsIfvS :: FvS + _bindsIfvSMp :: FvSMp + _bindsIgUniq :: UID + _bindsIgathEnv :: REnv + _bindsIgathRecEnv :: REnv + _bindsInmL :: ([HsName]) + _bindsIoTrf :: CBindL + _bindsIqualS :: RelevQualS + _bindsIrvarMp :: RVarMp + _bodyIappFunKind :: AppFunKind + _bodyIargL :: ([CBound]) + _bodyIcTrf :: CExpr + _bodyIcoe :: RelevCoe + _bodyIfunCoe :: RelevCoe + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIgathLamMp :: LamMp + _bodyImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _bodyImbFunVar :: (Maybe HsName) + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIoTrf :: CExpr + _bodyIqualS :: RelevQualS + _bodyIrvarMp :: RVarMp + _bodyIty :: RelevTy + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 7, column 17) + _lhsOgathLamMp = + _bindsIbindLamMp `Map.union` _bodyIgathLamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 6, column 17) + _fvS = + (_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 4, column 17) + _letBindingsCateg = + categ_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 75, column 17) + _isTopLet = + _lhsIwhatAbove == ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, column 17) + _evalCtx = + if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 164, column 17) + _bindsOenv = + gamAddGam _bindsIgathRecEnv _lhsIenv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 165, column 17) + _bodyOenv = + gamAddGam _bindsIgathEnv _lhsIenv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 384, column 17) + _bodyOrvarMp = + _bindsIextraBindRVarMp |+> _bindsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 392, column 17) + _bindsOforQuantRVarMp = + _bindsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 467, column 17) + _bindsCanParticpateInOuterSolving = + categ_ == CBindCateg_Strict + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 467, column 17) + _bindsQualSSubs = + Set.map (_bindsIrvarMp `varUpd`) _bindsIqualS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 467, column 17) + _bindsQualSOuter = + if _bindsCanParticpateInOuterSolving then _bindsQualSSubs else Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 467, column 17) + _bindsQualSSolv1 = + if _bindsCanParticpateInOuterSolving + then (Set.empty, emptyRVarMp) + else let (q,m) = assSolve _lhsIboundRelevTyVarS _bindsQualSSubs + in (Set.map (m `varUpd`) q, m) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 480, column 17) + _bindsQualSSolv2 = + let (q,m) = _bindsQualSSolv1 + m2 = m |+> _lhsIfinalRVarMp + (q',m3) = assSolve Set.empty (Set.map (m2 `varUpd`) q) + in (Set.map (m3 `varUpd`) q', m3 |+> m2) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 480, column 17) + _bindsSolveVarMp = + snd _bindsQualSSolv2 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _bindsIqualS `Set.union` _bodyIqualS + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- self rule + _oTrf = + CExpr_Let categ_ _bindsIoTrf _bodyIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOcoe = + _bodyIcoe + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (up) + _lhsOrvarMp = + _bodyIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindsOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindsOdataGam = + _lhsIdataGam + -- copy rule (from local) + _bindsOevalCtx = + _evalCtx + -- copy rule (down) + _bindsOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _bindsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (down) + _bindsOknTy = + _lhsIknTy + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (from local) + _bindsOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOopts = + _lhsIopts + -- copy rule (down) + _bindsOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _bindsOwhatTo = + _lhsIwhatTo + -- copy rule (chain) + _bodyOaltMbScrutTy = + _bindsIaltMbScrutTy + -- copy rule (down) + _bodyOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bodyOdataGam = + _lhsIdataGam + -- copy rule (from local) + _bodyOevalCtx = + _evalCtx + -- copy rule (down) + _bodyOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _bodyOgUniq = + _bindsIgUniq + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOknTy = + _lhsIknTy + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + -- copy rule (down) + _bodyOwhatTo = + _lhsIwhatTo + ( _bindsIaltMbScrutTy,_bindsIbindLamMp,_bindsIcTrf,_bindsIextraBindRVarMp,_bindsIfvS,_bindsIfvSMp,_bindsIgUniq,_bindsIgathEnv,_bindsIgathRecEnv,_bindsInmL,_bindsIoTrf,_bindsIqualS,_bindsIrvarMp) = + binds_ _bindsOboundRelevTyVarS _bindsOdataGam _bindsOenv _bindsOevalCtx _bindsOfinalRVarMp _bindsOforQuantRVarMp _bindsOgUniq _bindsOisGlobal _bindsOknTy _bindsOlamMp _bindsOletBindingsCateg _bindsOlev _bindsOopts _bindsOrvarMp _bindsOwhatTo + ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIcoe,_bodyIfunCoe,_bodyIfvS,_bodyIgUniq,_bodyIgathLamMp,_bodyImbFFIApp,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIoTrf,_bodyIqualS,_bodyIrvarMp,_bodyIty,_bodyIwhatBelow) = + body_ _bodyOaltMbScrutTy _bodyOboundRelevTyVarS _bodyOdataGam _bodyOenv _bodyOevalCtx _bodyOfinalRVarMp _bodyOgUniq _bodyOisTopApp _bodyOisTopTup _bodyOknTy _bodyOlamMp _bodyOlev _bodyOopts _bodyOrvarMp _bodyOwhatAbove _bodyOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _funcOisTopApp :: Bool + _argOisTopApp :: Bool + _whatAbove :: WhatExpr + _argOevalCtx :: EvalCtx + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _argOnm :: HsName + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _argOknTy :: RelevTy + _funcOknTy :: RelevTy + _funTy :: RelevTy + _argTy :: RelevTy + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOcTrf :: CExpr + _funcOgUniq :: UID + _lUniq :: UID + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOoTrf :: CExpr + _lhsOargL :: ([CBound]) + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _funcOaltMbScrutTy :: MbRelevTy + _funcOboundRelevTyVarS :: UIDS + _funcOdataGam :: DataGam + _funcOenv :: REnv + _funcOevalCtx :: EvalCtx + _funcOfinalRVarMp :: RVarMp + _funcOisTopTup :: Bool + _funcOlamMp :: LamMp + _funcOlev :: Int + _funcOopts :: EHCOpts + _funcOrvarMp :: RVarMp + _funcOwhatAbove :: WhatExpr + _funcOwhatTo :: ([WhatToRelevInfer]) + _argOboundRelevTyVarS :: UIDS + _argOdataGam :: DataGam + _argOenv :: REnv + _argOfinalRVarMp :: RVarMp + _argOforQuantRVarMp :: RVarMp + _argOgUniq :: UID + _argOisGlobal :: Bool + _argOisTopTup :: Bool + _argOlamMp :: LamMp + _argOletBindingsCateg :: CBindCateg + _argOlev :: Int + _argOopts :: EHCOpts + _argOrvarMp :: RVarMp + _argOwhatTo :: ([WhatToRelevInfer]) + _funcIappFunKind :: AppFunKind + _funcIargL :: ([CBound]) + _funcIcTrf :: CExpr + _funcIcoe :: RelevCoe + _funcIfunCoe :: RelevCoe + _funcIfvS :: FvS + _funcIgUniq :: UID + _funcIgathLamMp :: LamMp + _funcImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _funcImbFunVar :: (Maybe HsName) + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIoTrf :: CExpr + _funcIqualS :: RelevQualS + _funcIrvarMp :: RVarMp + _funcIty :: RelevTy + _funcIwhatBelow :: WhatExpr + _argIaltMbScrutTy :: MbRelevTy + _argIbindLamMp :: LamMp + _argIcTrf :: CBound + _argIcoe :: RelevCoe + _argIextraBindRVarMp :: RVarMp + _argIfvS :: FvS + _argIfvSMp :: FvSMp + _argIgUniq :: UID + _argIgathEnv :: REnv + _argIgathRecEnv :: REnv + _argInmL :: ([HsName]) + _argIoTrf :: CBound + _argIqualS :: RelevQualS + _argIrvarMp :: RVarMp + _argItyAspectL :: ([CBound]) + _argIvalAspectL :: ([CBound]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 8, column 17) + _fvS = + _funcIfvS `Set.union` _argIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 14, column 17) + _funcOisTopApp = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 15, column 17) + _argOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 54, column 17) + _whatBelow = + maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 70, column 17) + _whatAbove = + maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 77, column 17) + _isTopApp' = + isNothing $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 112, column 17) + _argOevalCtx = + EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 14, column 17) + _lhsOappFunKind = + _funcIappFunKind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 6, column 17) + _lhsOmbFunVar = + _funcImbFunVar + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 13, column 17) + _argL = + _argIcTrf : _funcIargL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 41, column 17) + _lhsOmbFFIApp = + _funcImbFFIApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 210, column 17) + _argOknTy = + _argTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 211, column 17) + _funcOknTy = + case _lhsIknTy of + RelevTy_Fun q v qs as r -> RelevTy_Fun q v qs (fresh _lUniq : as) r + t -> RelevTy_Fun RQuant_None [] [] [fresh _lUniq ] t + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 270, column 17) + _funTy = + case _funcIty of + t@(RelevTy_Fun _ _ _ (_:_) _) -> t + _ -> anaMkBotFun 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 273, column 33) + __tup18 = + case _funTy of + RelevTy_Fun q v qs (a:as) r -> (a,r,RelevTy_Fun q v qs as r) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 273, column 33) + (_argTy,_,_) = + __tup18 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 273, column 33) + (_,_resTy,_) = + __tup18 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 273, column 33) + (_,_,_resFunTy) = + __tup18 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 320, column 17) + _lhsOcoe = + if _lhsIisTopApp + then _lhsIfinalRVarMp `varUpd` _resCoe + else RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 327, column 17) + _hereArgCoe = + _argIcoe <.> (_lhsIfinalRVarMp `varUpd` _argCoe) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 327, column 17) + _hereFunCoe = + case _funcIwhatBelow of + ExprIsApp _ _ -> RelevCoe_Id + _ -> _funcIcoe + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 351, column 17) + __tup19 = + case _funcIfunCoe of + RelevCoe_Fun (a:as) r -> (a,r,RelevCoe_Fun as r) + _ -> (RelevCoe_Err "CExpr.App.a", RelevCoe_Err "CExpr.App.r", RelevCoe_Err "CExpr.App.f") + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 351, column 17) + (_argCoe,_,_) = + __tup19 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 351, column 17) + (_,_resCoe,_) = + __tup19 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 351, column 17) + (_,_,_lhsOfunCoe) = + __tup19 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, column 17) + _lhsOty = + if _lhsIisTopApp then _resTy else _resFunTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 394, column 33) + _forQuantRVarMp = + emptyRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 616, column 17) + _lhsOcTrf = + let a = + maybe _argIcTrf (\((a,_,_),e) -> acoreBound1AspkeyVal a (annCoe _hereArgCoe e)) $ acoreBoundMbVal _argIcTrf + app = acore1AppBound (annCoe _hereFunCoe _funcIcTrf) a + in app + -- -- generated by the unique rule mechanism. + __tup20 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- -- generated by the unique rule mechanism. + (_funcOgUniq,_) = + __tup20 + -- -- generated by the unique rule mechanism. + (_,_lUniq) = + __tup20 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _funcIqualS `Set.union` _argIqualS + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _oTrf = + CExpr_App _funcIoTrf _argIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOargL = + _argL + -- copy rule (up) + _lhsOgUniq = + _argIgUniq + -- copy rule (up) + _lhsOrvarMp = + _argIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _funcOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _funcOdataGam = + _lhsIdataGam + -- copy rule (down) + _funcOenv = + _lhsIenv + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOopts = + _lhsIopts + -- copy rule (down) + _funcOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (down) + _funcOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _argOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _argOdataGam = + _lhsIdataGam + -- copy rule (down) + _argOenv = + _lhsIenv + -- copy rule (down) + _argOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (from local) + _argOforQuantRVarMp = + _forQuantRVarMp + -- copy rule (chain) + _argOgUniq = + _funcIgUniq + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (from local) + _argOisTopTup = + _isTopTup + -- copy rule (down) + _argOlamMp = + _lhsIlamMp + -- copy rule (from local) + _argOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOopts = + _lhsIopts + -- copy rule (chain) + _argOrvarMp = + _funcIrvarMp + -- copy rule (down) + _argOwhatTo = + _lhsIwhatTo + ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcIcoe,_funcIfunCoe,_funcIfvS,_funcIgUniq,_funcIgathLamMp,_funcImbFFIApp,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIoTrf,_funcIqualS,_funcIrvarMp,_funcIty,_funcIwhatBelow) = + func_ _funcOaltMbScrutTy _funcOboundRelevTyVarS _funcOdataGam _funcOenv _funcOevalCtx _funcOfinalRVarMp _funcOgUniq _funcOisTopApp _funcOisTopTup _funcOknTy _funcOlamMp _funcOlev _funcOopts _funcOrvarMp _funcOwhatAbove _funcOwhatTo + ( _argIaltMbScrutTy,_argIbindLamMp,_argIcTrf,_argIcoe,_argIextraBindRVarMp,_argIfvS,_argIfvSMp,_argIgUniq,_argIgathEnv,_argIgathRecEnv,_argInmL,_argIoTrf,_argIqualS,_argIrvarMp,_argItyAspectL,_argIvalAspectL) = + arg_ _argOboundRelevTyVarS _argOdataGam _argOenv _argOevalCtx _argOfinalRVarMp _argOforQuantRVarMp _argOgUniq _argOisGlobal _argOisTopApp _argOisTopTup _argOknTy _argOlamMp _argOletBindingsCateg _argOlev _argOnm _argOopts _argOrvarMp _argOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _bodyOlamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _bindOboundRelevTyVarS :: UIDS + _bindOdataGam :: DataGam + _bindOenv :: REnv + _bindOevalCtx :: EvalCtx + _bindOfinalRVarMp :: RVarMp + _bindOforQuantRVarMp :: RVarMp + _bindOgUniq :: UID + _bindOisGlobal :: Bool + _bindOknTy :: RelevTy + _bindOlamMp :: LamMp + _bindOletBindingsCateg :: CBindCateg + _bindOlev :: Int + _bindOopts :: EHCOpts + _bindOrvarMp :: RVarMp + _bindOwhatTo :: ([WhatToRelevInfer]) + _bodyOaltMbScrutTy :: MbRelevTy + _bodyOboundRelevTyVarS :: UIDS + _bodyOdataGam :: DataGam + _bodyOenv :: REnv + _bodyOevalCtx :: EvalCtx + _bodyOfinalRVarMp :: RVarMp + _bodyOgUniq :: UID + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOknTy :: RelevTy + _bodyOlev :: Int + _bodyOopts :: EHCOpts + _bodyOrvarMp :: RVarMp + _bodyOwhatAbove :: WhatExpr + _bodyOwhatTo :: ([WhatToRelevInfer]) + _bindIaltMbScrutTy :: MbRelevTy + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindIextraBindRVarMp :: RVarMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: UID + _bindIgathEnv :: REnv + _bindIgathRecEnv :: REnv + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bindIoTrf :: CBind + _bindIqualS :: RelevQualS + _bindIrvarMp :: RVarMp + _bodyIappFunKind :: AppFunKind + _bodyIargL :: ([CBound]) + _bodyIcTrf :: CExpr + _bodyIcoe :: RelevCoe + _bodyIfunCoe :: RelevCoe + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIgathLamMp :: LamMp + _bodyImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _bodyImbFunVar :: (Maybe HsName) + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIoTrf :: CExpr + _bodyIqualS :: RelevQualS + _bodyIrvarMp :: RVarMp + _bodyIty :: RelevTy + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLamInfo.ag"(line 7, column 17) + _bodyOlamMp = + Map.delete _argNm _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 5, column 17) + _fvS = + _argNm `Set.delete` _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 51, column 17) + _whatBelow = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) + _whatAbove = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 76, column 17) + _isTopLam = + not $ whatExprIsLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 4, column 17) + _lhsOmbLam = + Just $ maybe [_argNm] (_argNm:) _bodyImbLam + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 331, column 17) + _hereBodyCoe = + case _bodyIwhatBelow of + ExprIsLam _ -> RelevCoe_Id + _ -> _bodyIcoe + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 394, column 33) + _forQuantRVarMp = + emptyRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 615, column 17) + _lhsOcTrf = + acoreLam1 _argNm $ annCoe _hereBodyCoe _bodyIcTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _bindIqualS `Set.union` _bodyIqualS + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _oTrf = + CExpr_Lam _bindIoTrf _bodyIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (up) + _lhsOrvarMp = + _bodyIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindOdataGam = + _lhsIdataGam + -- copy rule (down) + _bindOenv = + _lhsIenv + -- copy rule (down) + _bindOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (from local) + _bindOforQuantRVarMp = + _forQuantRVarMp + -- copy rule (down) + _bindOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (down) + _bindOknTy = + _lhsIknTy + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (from local) + _bindOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (down) + _bindOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _bindOwhatTo = + _lhsIwhatTo + -- copy rule (chain) + _bodyOaltMbScrutTy = + _bindIaltMbScrutTy + -- copy rule (down) + _bodyOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bodyOdataGam = + _lhsIdataGam + -- copy rule (down) + _bodyOenv = + _lhsIenv + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _bodyOgUniq = + _bindIgUniq + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOknTy = + _lhsIknTy + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (chain) + _bodyOrvarMp = + _bindIrvarMp + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + -- copy rule (down) + _bodyOwhatTo = + _lhsIwhatTo + ( _bindIaltMbScrutTy,_bindIbindLamMp,_bindIcTrf,_bindIextraBindRVarMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIgathEnv,_bindIgathRecEnv,_bindInm,_bindInmL,_bindIoTrf,_bindIqualS,_bindIrvarMp) = + bind_ _bindOboundRelevTyVarS _bindOdataGam _bindOenv _bindOevalCtx _bindOfinalRVarMp _bindOforQuantRVarMp _bindOgUniq _bindOisGlobal _bindOknTy _bindOlamMp _bindOletBindingsCateg _bindOlev _bindOopts _bindOrvarMp _bindOwhatTo + ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIcoe,_bodyIfunCoe,_bodyIfvS,_bodyIgUniq,_bodyIgathLamMp,_bodyImbFFIApp,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIoTrf,_bodyIqualS,_bodyIrvarMp,_bodyIty,_bodyIwhatBelow) = + body_ _bodyOaltMbScrutTy _bodyOboundRelevTyVarS _bodyOdataGam _bodyOenv _bodyOevalCtx _bodyOfinalRVarMp _bodyOgUniq _bodyOisTopApp _bodyOisTopTup _bodyOknTy _bodyOlamMp _bodyOlev _bodyOopts _bodyOrvarMp _bodyOwhatAbove _bodyOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprOknTy :: RelevTy + _altsOknTyCase :: RelevTy + _altsOaltNrMax :: Int + _altsOaltId :: UID + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _altQualSLSubs :: ([RelevQualS]) + _altQualSLSolv1 :: ([(RelevQualS,RVarMp)]) + _altQualSLSolv :: ([RelevQualS]) + _altQualSIntersect :: RelevQualS + _altSolveLVarMp :: ([RVarMp]) + _lhsOcTrf :: CExpr + _exprOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lhsOfvS :: FvS + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOwhatBelow :: WhatExpr + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _altsOaltMbScrutTy :: MbRelevTy + _altsOaltSolveLVarMp :: ([RVarMp]) + _altsOboundRelevTyVarS :: UIDS + _altsOdataGam :: DataGam + _altsOenv :: REnv + _altsOevalCtx :: EvalCtx + _altsOfinalRVarMp :: RVarMp + _altsOgUniq :: UID + _altsOknTy :: RelevTy + _altsOlamMp :: LamMp + _altsOlev :: Int + _altsOopts :: EHCOpts + _altsOrvarMp :: RVarMp + _altsOwhatTo :: ([WhatToRelevInfer]) + _dfltOaltMbScrutTy :: MbRelevTy + _dfltOboundRelevTyVarS :: UIDS + _dfltOdataGam :: DataGam + _dfltOenv :: REnv + _dfltOevalCtx :: EvalCtx + _dfltOfinalRVarMp :: RVarMp + _dfltOgUniq :: UID + _dfltOisTopApp :: Bool + _dfltOisTopTup :: Bool + _dfltOknTy :: RelevTy + _dfltOlamMp :: LamMp + _dfltOlev :: Int + _dfltOopts :: EHCOpts + _dfltOrvarMp :: RVarMp + _dfltOwhatAbove :: WhatExpr + _dfltOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + _altsIaltNr :: Int + _altsIaltQualSL :: ([RelevQualS]) + _altsIcTrf :: CAltL + _altsIfvS :: FvS + _altsIgUniq :: UID + _altsIoTrf :: CAltL + _altsIqualS :: RelevQualS + _altsIrvarMp :: RVarMp + _altsIty :: RelevTy + _dfltIappFunKind :: AppFunKind + _dfltIargL :: ([CBound]) + _dfltIcTrf :: CExpr + _dfltIcoe :: RelevCoe + _dfltIfunCoe :: RelevCoe + _dfltIfvS :: FvS + _dfltIgUniq :: UID + _dfltIgathLamMp :: LamMp + _dfltImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _dfltImbFunVar :: (Maybe HsName) + _dfltImbLam :: (Maybe [HsName]) + _dfltImbVar :: (Maybe HsName) + _dfltIoTrf :: CExpr + _dfltIqualS :: RelevQualS + _dfltIrvarMp :: RVarMp + _dfltIty :: RelevTy + _dfltIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 215, column 17) + _exprOknTy = + _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 225, column 17) + _altsOknTyCase = + _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 293, column 17) + _altsOaltNrMax = + _altsIaltNr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 293, column 17) + _altsOaltId = + _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 364, column 17) + _lhsOty = + _altsIty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 383, column 17) + _lhsOrvarMp = + _altsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 425, column 17) + _lhsOqualS = + Set.unions [_exprIqualS, _altQualSIntersect] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 437, column 17) + _altQualSLSubs = + map (Set.map (_altsIrvarMp `varUpd`)) _altsIaltQualSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 437, column 17) + _altQualSLSolv1 = + let bnd = _lhsIboundRelevTyVarS + s q = (Set.map (m `varUpd`) q', m) + where (q',m) = assSolve bnd q + in map s _altQualSLSubs + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 437, column 17) + _altQualSLSolv = + map fst _altQualSLSolv1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 437, column 17) + _altQualSIntersect = + foldr1 Set.intersection _altQualSLSolv + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 452, column 17) + _altQualSLSolv2 = + let s (q,m) = (Set.map (m3 `varUpd`) q', m4) + where m2 = m |+> _lhsIfinalRVarMp + (q',m3) = assSolve Set.empty (Set.map (m2 `varUpd`) q) + m4 = m3 |+> m2 + in map s _altQualSLSolv1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 452, column 17) + _altSolveLVarMp = + map snd _altQualSLSolv2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 598, column 17) + _dbg = + dbgCase _lhsIopts _lhsIboundRelevTyVarS _altQualSLSubs _altQualSLSolv _altQualSIntersect + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 620, column 17) + _lhsOcTrf = + _cTrf + -- -- generated by the unique rule mechanism. + __tup21 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} ) + -- -- generated by the unique rule mechanism. + (_exprOgUniq,_,_) = + __tup21 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_) = + __tup21 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2) = + __tup21 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _oTrf = + CExpr_Case _exprIoTrf _altsIoTrf _dfltIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _dfltIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOisTopTup = + _isTopTup + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _altsOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (from local) + _altsOaltSolveLVarMp = + _altSolveLVarMp + -- copy rule (down) + _altsOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _altsOdataGam = + _lhsIdataGam + -- copy rule (down) + _altsOenv = + _lhsIenv + -- copy rule (down) + _altsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _altsOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _altsOgUniq = + _exprIgUniq + -- copy rule (down) + _altsOknTy = + _lhsIknTy + -- copy rule (down) + _altsOlamMp = + _lhsIlamMp + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOopts = + _lhsIopts + -- copy rule (chain) + _altsOrvarMp = + _exprIrvarMp + -- copy rule (down) + _altsOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _dfltOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _dfltOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _dfltOdataGam = + _lhsIdataGam + -- copy rule (down) + _dfltOenv = + _lhsIenv + -- copy rule (down) + _dfltOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _dfltOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _dfltOgUniq = + _altsIgUniq + -- copy rule (from local) + _dfltOisTopApp = + _isTopApp + -- copy rule (from local) + _dfltOisTopTup = + _isTopTup + -- copy rule (down) + _dfltOknTy = + _lhsIknTy + -- copy rule (down) + _dfltOlamMp = + _lhsIlamMp + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOopts = + _lhsIopts + -- copy rule (chain) + _dfltOrvarMp = + _altsIrvarMp + -- copy rule (from local) + _dfltOwhatAbove = + _whatAbove + -- copy rule (down) + _dfltOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + ( _altsIaltNr,_altsIaltQualSL,_altsIcTrf,_altsIfvS,_altsIgUniq,_altsIoTrf,_altsIqualS,_altsIrvarMp,_altsIty) = + alts_ _altsOaltId _altsOaltMbScrutTy _altsOaltNrMax _altsOaltSolveLVarMp _altsOboundRelevTyVarS _altsOdataGam _altsOenv _altsOevalCtx _altsOfinalRVarMp _altsOgUniq _altsOknTy _altsOknTyCase _altsOlamMp _altsOlev _altsOopts _altsOrvarMp _altsOwhatTo + ( _dfltIappFunKind,_dfltIargL,_dfltIcTrf,_dfltIcoe,_dfltIfunCoe,_dfltIfvS,_dfltIgUniq,_dfltIgathLamMp,_dfltImbFFIApp,_dfltImbFunVar,_dfltImbLam,_dfltImbVar,_dfltIoTrf,_dfltIqualS,_dfltIrvarMp,_dfltIty,_dfltIwhatBelow) = + dflt_ _dfltOaltMbScrutTy _dfltOboundRelevTyVarS _dfltOdataGam _dfltOenv _dfltOevalCtx _dfltOfinalRVarMp _dfltOgUniq _dfltOisTopApp _dfltOisTopTup _dfltOknTy _dfltOlamMp _dfltOlev _dfltOopts _dfltOrvarMp _dfltOwhatAbove _dfltOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOargL :: ([CBound]) + _lhsOfunCoe :: RelevCoe + _lhsOgUniq :: UID + _lhsOgathLamMp :: LamMp + _lhsOmbFunVar :: (Maybe HsName) + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOrvarMp :: RVarMp + _lhsOty :: RelevTy + _lhsOwhatBelow :: WhatExpr + _errorExprOaltMbScrutTy :: MbRelevTy + _errorExprOboundRelevTyVarS :: UIDS + _errorExprOdataGam :: DataGam + _errorExprOenv :: REnv + _errorExprOevalCtx :: EvalCtx + _errorExprOfinalRVarMp :: RVarMp + _errorExprOgUniq :: UID + _errorExprOisTopApp :: Bool + _errorExprOisTopTup :: Bool + _errorExprOknTy :: RelevTy + _errorExprOlamMp :: LamMp + _errorExprOlev :: Int + _errorExprOopts :: EHCOpts + _errorExprOrvarMp :: RVarMp + _errorExprOwhatAbove :: WhatExpr + _errorExprOwhatTo :: ([WhatToRelevInfer]) + _errorExprIappFunKind :: AppFunKind + _errorExprIargL :: ([CBound]) + _errorExprIcTrf :: CExpr + _errorExprIcoe :: RelevCoe + _errorExprIfunCoe :: RelevCoe + _errorExprIfvS :: FvS + _errorExprIgUniq :: UID + _errorExprIgathLamMp :: LamMp + _errorExprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _errorExprImbFunVar :: (Maybe HsName) + _errorExprImbLam :: (Maybe [HsName]) + _errorExprImbVar :: (Maybe HsName) + _errorExprIoTrf :: CExpr + _errorExprIqualS :: RelevQualS + _errorExprIrvarMp :: RVarMp + _errorExprIty :: RelevTy + _errorExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _errorExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _errorExprIqualS + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _oTrf = + CExpr_CaseAltFail failReason_ _errorExprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOappFunKind = + _errorExprIappFunKind + -- copy rule (up) + _lhsOargL = + _errorExprIargL + -- copy rule (up) + _lhsOfunCoe = + _errorExprIfunCoe + -- copy rule (up) + _lhsOgUniq = + _errorExprIgUniq + -- copy rule (up) + _lhsOgathLamMp = + _errorExprIgathLamMp + -- copy rule (up) + _lhsOmbFunVar = + _errorExprImbFunVar + -- copy rule (up) + _lhsOmbLam = + _errorExprImbLam + -- copy rule (up) + _lhsOmbVar = + _errorExprImbVar + -- copy rule (up) + _lhsOrvarMp = + _errorExprIrvarMp + -- copy rule (up) + _lhsOty = + _errorExprIty + -- copy rule (up) + _lhsOwhatBelow = + _errorExprIwhatBelow + -- copy rule (down) + _errorExprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _errorExprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _errorExprOdataGam = + _lhsIdataGam + -- copy rule (down) + _errorExprOenv = + _lhsIenv + -- copy rule (down) + _errorExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _errorExprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _errorExprOgUniq = + _lhsIgUniq + -- copy rule (from local) + _errorExprOisTopApp = + _isTopApp + -- copy rule (from local) + _errorExprOisTopTup = + _isTopTup + -- copy rule (down) + _errorExprOknTy = + _lhsIknTy + -- copy rule (down) + _errorExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOopts = + _lhsIopts + -- copy rule (down) + _errorExprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _errorExprOwhatAbove = + _whatAbove + -- copy rule (down) + _errorExprOwhatTo = + _lhsIwhatTo + ( _errorExprIappFunKind,_errorExprIargL,_errorExprIcTrf,_errorExprIcoe,_errorExprIfunCoe,_errorExprIfvS,_errorExprIgUniq,_errorExprIgathLamMp,_errorExprImbFFIApp,_errorExprImbFunVar,_errorExprImbLam,_errorExprImbVar,_errorExprIoTrf,_errorExprIqualS,_errorExprIrvarMp,_errorExprIty,_errorExprIwhatBelow) = + errorExpr_ _errorExprOaltMbScrutTy _errorExprOboundRelevTyVarS _errorExprOdataGam _errorExprOenv _errorExprOevalCtx _errorExprOfinalRVarMp _errorExprOgUniq _errorExprOisTopApp _errorExprOisTopTup _errorExprOknTy _errorExprOlamMp _errorExprOlev _errorExprOopts _errorExprOrvarMp _errorExprOwhatAbove _errorExprOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOisTopApp :: Bool + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _offsetOaltMbScrutTy :: MbRelevTy + _offsetOboundRelevTyVarS :: UIDS + _offsetOdataGam :: DataGam + _offsetOenv :: REnv + _offsetOevalCtx :: EvalCtx + _offsetOfinalRVarMp :: RVarMp + _offsetOgUniq :: UID + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOknTy :: RelevTy + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOopts :: EHCOpts + _offsetOrvarMp :: RVarMp + _offsetOwhatAbove :: WhatExpr + _offsetOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIargL :: ([CBound]) + _offsetIcTrf :: CExpr + _offsetIcoe :: RelevCoe + _offsetIfunCoe :: RelevCoe + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIgathLamMp :: LamMp + _offsetImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _offsetImbFunVar :: (Maybe HsName) + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIoTrf :: CExpr + _offsetIqualS :: RelevQualS + _offsetIrvarMp :: RVarMp + _offsetIty :: RelevTy + _offsetIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS `Set.union` _offsetIqualS + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _oTrf = + CExpr_TupDel _exprIoTrf tag_ nm_ _offsetIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _offsetIgUniq + -- copy rule (up) + _lhsOrvarMp = + _offsetIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _offsetOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _offsetOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _offsetOdataGam = + _lhsIdataGam + -- copy rule (down) + _offsetOenv = + _lhsIenv + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOknTy = + _lhsIknTy + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIcoe,_offsetIfunCoe,_offsetIfvS,_offsetIgUniq,_offsetIgathLamMp,_offsetImbFFIApp,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIoTrf,_offsetIqualS,_offsetIrvarMp,_offsetIty,_offsetIwhatBelow) = + offset_ _offsetOaltMbScrutTy _offsetOboundRelevTyVarS _offsetOdataGam _offsetOenv _offsetOevalCtx _offsetOfinalRVarMp _offsetOgUniq _offsetOisTopApp _offsetOisTopTup _offsetOknTy _offsetOlamMp _offsetOlev _offsetOopts _offsetOrvarMp _offsetOwhatAbove _offsetOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOisTopApp :: Bool + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _offsetOaltMbScrutTy :: MbRelevTy + _offsetOboundRelevTyVarS :: UIDS + _offsetOdataGam :: DataGam + _offsetOenv :: REnv + _offsetOevalCtx :: EvalCtx + _offsetOfinalRVarMp :: RVarMp + _offsetOgUniq :: UID + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOknTy :: RelevTy + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOopts :: EHCOpts + _offsetOrvarMp :: RVarMp + _offsetOwhatAbove :: WhatExpr + _offsetOwhatTo :: ([WhatToRelevInfer]) + _fldExprOaltMbScrutTy :: MbRelevTy + _fldExprOboundRelevTyVarS :: UIDS + _fldExprOdataGam :: DataGam + _fldExprOenv :: REnv + _fldExprOevalCtx :: EvalCtx + _fldExprOfinalRVarMp :: RVarMp + _fldExprOgUniq :: UID + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOknTy :: RelevTy + _fldExprOlamMp :: LamMp + _fldExprOlev :: Int + _fldExprOopts :: EHCOpts + _fldExprOrvarMp :: RVarMp + _fldExprOwhatAbove :: WhatExpr + _fldExprOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIargL :: ([CBound]) + _offsetIcTrf :: CExpr + _offsetIcoe :: RelevCoe + _offsetIfunCoe :: RelevCoe + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIgathLamMp :: LamMp + _offsetImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _offsetImbFunVar :: (Maybe HsName) + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIoTrf :: CExpr + _offsetIqualS :: RelevQualS + _offsetIrvarMp :: RVarMp + _offsetIty :: RelevTy + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIargL :: ([CBound]) + _fldExprIcTrf :: CExpr + _fldExprIcoe :: RelevCoe + _fldExprIfunCoe :: RelevCoe + _fldExprIfvS :: FvS + _fldExprIgUniq :: UID + _fldExprIgathLamMp :: LamMp + _fldExprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _fldExprImbFunVar :: (Maybe HsName) + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIoTrf :: CExpr + _fldExprIqualS :: RelevQualS + _fldExprIrvarMp :: RVarMp + _fldExprIty :: RelevTy + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS `Set.union` _offsetIqualS `Set.union` _fldExprIqualS + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _oTrf = + CExpr_TupIns _exprIoTrf tag_ nm_ _offsetIoTrf _fldExprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (up) + _lhsOrvarMp = + _fldExprIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _offsetOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _offsetOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _offsetOdataGam = + _lhsIdataGam + -- copy rule (down) + _offsetOenv = + _lhsIenv + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOknTy = + _lhsIknTy + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _fldExprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _fldExprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _fldExprOdataGam = + _lhsIdataGam + -- copy rule (down) + _fldExprOenv = + _lhsIenv + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _fldExprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOknTy = + _lhsIknTy + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOopts = + _lhsIopts + -- copy rule (chain) + _fldExprOrvarMp = + _offsetIrvarMp + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIcoe,_offsetIfunCoe,_offsetIfvS,_offsetIgUniq,_offsetIgathLamMp,_offsetImbFFIApp,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIoTrf,_offsetIqualS,_offsetIrvarMp,_offsetIty,_offsetIwhatBelow) = + offset_ _offsetOaltMbScrutTy _offsetOboundRelevTyVarS _offsetOdataGam _offsetOenv _offsetOevalCtx _offsetOfinalRVarMp _offsetOgUniq _offsetOisTopApp _offsetOisTopTup _offsetOknTy _offsetOlamMp _offsetOlev _offsetOopts _offsetOrvarMp _offsetOwhatAbove _offsetOwhatTo + ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprIcoe,_fldExprIfunCoe,_fldExprIfvS,_fldExprIgUniq,_fldExprIgathLamMp,_fldExprImbFFIApp,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIoTrf,_fldExprIqualS,_fldExprIrvarMp,_fldExprIty,_fldExprIwhatBelow) = + fldExpr_ _fldExprOaltMbScrutTy _fldExprOboundRelevTyVarS _fldExprOdataGam _fldExprOenv _fldExprOevalCtx _fldExprOfinalRVarMp _fldExprOgUniq _fldExprOisTopApp _fldExprOisTopTup _fldExprOknTy _fldExprOlamMp _fldExprOlev _fldExprOopts _fldExprOrvarMp _fldExprOwhatAbove _fldExprOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOisTopApp :: Bool + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _offsetOaltMbScrutTy :: MbRelevTy + _offsetOboundRelevTyVarS :: UIDS + _offsetOdataGam :: DataGam + _offsetOenv :: REnv + _offsetOevalCtx :: EvalCtx + _offsetOfinalRVarMp :: RVarMp + _offsetOgUniq :: UID + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOknTy :: RelevTy + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOopts :: EHCOpts + _offsetOrvarMp :: RVarMp + _offsetOwhatAbove :: WhatExpr + _offsetOwhatTo :: ([WhatToRelevInfer]) + _fldExprOaltMbScrutTy :: MbRelevTy + _fldExprOboundRelevTyVarS :: UIDS + _fldExprOdataGam :: DataGam + _fldExprOenv :: REnv + _fldExprOevalCtx :: EvalCtx + _fldExprOfinalRVarMp :: RVarMp + _fldExprOgUniq :: UID + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOknTy :: RelevTy + _fldExprOlamMp :: LamMp + _fldExprOlev :: Int + _fldExprOopts :: EHCOpts + _fldExprOrvarMp :: RVarMp + _fldExprOwhatAbove :: WhatExpr + _fldExprOwhatTo :: ([WhatToRelevInfer]) + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIargL :: ([CBound]) + _offsetIcTrf :: CExpr + _offsetIcoe :: RelevCoe + _offsetIfunCoe :: RelevCoe + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIgathLamMp :: LamMp + _offsetImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _offsetImbFunVar :: (Maybe HsName) + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIoTrf :: CExpr + _offsetIqualS :: RelevQualS + _offsetIrvarMp :: RVarMp + _offsetIty :: RelevTy + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIargL :: ([CBound]) + _fldExprIcTrf :: CExpr + _fldExprIcoe :: RelevCoe + _fldExprIfunCoe :: RelevCoe + _fldExprIfvS :: FvS + _fldExprIgUniq :: UID + _fldExprIgathLamMp :: LamMp + _fldExprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _fldExprImbFunVar :: (Maybe HsName) + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIoTrf :: CExpr + _fldExprIqualS :: RelevQualS + _fldExprIrvarMp :: RVarMp + _fldExprIty :: RelevTy + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS `Set.union` _offsetIqualS `Set.union` _fldExprIqualS + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _oTrf = + CExpr_TupUpd _exprIoTrf tag_ nm_ _offsetIoTrf _fldExprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (up) + _lhsOrvarMp = + _fldExprIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _offsetOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _offsetOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _offsetOdataGam = + _lhsIdataGam + -- copy rule (down) + _offsetOenv = + _lhsIenv + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOknTy = + _lhsIknTy + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _fldExprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _fldExprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _fldExprOdataGam = + _lhsIdataGam + -- copy rule (down) + _fldExprOenv = + _lhsIenv + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _fldExprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOknTy = + _lhsIknTy + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOopts = + _lhsIopts + -- copy rule (chain) + _fldExprOrvarMp = + _offsetIrvarMp + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOwhatTo = + _lhsIwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIcoe,_offsetIfunCoe,_offsetIfvS,_offsetIgUniq,_offsetIgathLamMp,_offsetImbFFIApp,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIoTrf,_offsetIqualS,_offsetIrvarMp,_offsetIty,_offsetIwhatBelow) = + offset_ _offsetOaltMbScrutTy _offsetOboundRelevTyVarS _offsetOdataGam _offsetOenv _offsetOevalCtx _offsetOfinalRVarMp _offsetOgUniq _offsetOisTopApp _offsetOisTopTup _offsetOknTy _offsetOlamMp _offsetOlev _offsetOopts _offsetOrvarMp _offsetOwhatAbove _offsetOwhatTo + ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprIcoe,_fldExprIfunCoe,_fldExprIfvS,_fldExprIgUniq,_fldExprIgathLamMp,_fldExprImbFFIApp,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIoTrf,_fldExprIqualS,_fldExprIrvarMp,_fldExprIty,_fldExprIwhatBelow) = + fldExpr_ _fldExprOaltMbScrutTy _fldExprOboundRelevTyVarS _fldExprOdataGam _fldExprOenv _fldExprOevalCtx _fldExprOfinalRVarMp _fldExprOgUniq _fldExprOisTopApp _fldExprOisTopTup _fldExprOknTy _fldExprOlamMp _fldExprOlev _fldExprOopts _fldExprOrvarMp _fldExprOwhatAbove _fldExprOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _argTyLresTy :: (( TyL, Ty )) + _argTyL :: TyL + _mbPrimNeedEval :: (Maybe PrimitiveNeedsEval) + _primResNeedsEval :: Bool + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _ffiTy :: RelevTy + _amso :: (AMSOut RelevTy) + _ams :: AnaMatchState + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOrvarMp :: RVarMp + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOgUniq :: UID + _lUniq :: UID + _lUniq2 :: UID + _lhsOfvS :: FvS + _lhsOoTrf :: CExpr + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 56, column 25) + _whatBelow = + ExprIsFFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 12, column 17) + _lhsOappFunKind = + AppFunKind_FFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 2, column 17) + _argTyLresTy = + appUnArr ty_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 2, column 17) + _argTyL = + fst _argTyLresTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 2, column 17) + _resTy = + snd _argTyLresTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 2, column 17) + _foreignEntInfo = + foreignEntExtract impEnt_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 6, column 17) + _mbPrimNeedEval = + maybe Nothing lookupPrimNeedsEval $ forextractMbEnt _foreignEntInfo + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 6, column 17) + _primArgNeedsEvalL = + maybe (repeat True) (\p -> primArgNeedEval p ++ repeat True) _mbPrimNeedEval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 6, column 17) + _primResNeedsEval = + maybe False primResNeedEval _mbPrimNeedEval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 11, column 17) + _argMbConL = + map tyAppFunMbConNm _argTyL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 11, column 17) + _resMbCon = + tyAppFunMbConNm _resTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 35, column 17) + _lhsOmbFFIApp = + Just ( _resTy + , _primResNeedsEval + , callconv_ + , impEnt_ + , _argTyL + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) + __tup22 = + let (r@(RelevTy_Ana re) ,qr) = (fresh _lUniq, []) + (as,qa) = relevTyArgs (const fresh) (\(RelevTy_Ana x) (RelevTy_Ana y) -> [RelevQual_SubEval x y]) _lUniq2 (take (length _argTyL) _primArgNeedsEvalL) r + in (RelevTy_Fun RQuant_None [] [] as r, Set.fromList $ qr ++ qa) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) + (_ffiTy,_) = + __tup22 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) + (_,_ffiQualS) = + __tup22 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 266, column 33) + __tup23 = + amsLE _lhsIrvarMp _ffiTy _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 266, column 33) + (_amso,_) = + __tup23 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 266, column 33) + (_,_ams) = + __tup23 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 319, column 17) + _lhsOcoe = + _lhsIfinalRVarMp `varUpd` amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 350, column 17) + _lhsOfunCoe = + last $ relevCoeToComposeList $ amsoCoe _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 362, column 17) + _lhsOty = + amsoHi _amso + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 382, column 17) + _lhsOrvarMp = + amsLocalVarMp _ams |+> _lhsIrvarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 422, column 17) + _lhsOqualS = + Set.union _ffiQualS (amsGathQual _ams) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 597, column 17) + _dbg = + dbg _lhsIopts _ffiTy _lhsIknTy _amso _ams + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, column 17) + _lhsOcTrf = + _cTrf + -- -- generated by the unique rule mechanism. + __tup24 = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} ) + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_,_) = + __tup24 + -- -- generated by the unique rule mechanism. + (_,_lUniq,_) = + __tup24 + -- -- generated by the unique rule mechanism. + (_,_,_lUniq2) = + __tup24 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _oTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _oTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _oTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _bodyOaltMbScrutTy :: MbRelevTy + _bodyOboundRelevTyVarS :: UIDS + _bodyOdataGam :: DataGam + _bodyOenv :: REnv + _bodyOevalCtx :: EvalCtx + _bodyOfinalRVarMp :: RVarMp + _bodyOgUniq :: UID + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOknTy :: RelevTy + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOopts :: EHCOpts + _bodyOrvarMp :: RVarMp + _bodyOwhatAbove :: WhatExpr + _bodyOwhatTo :: ([WhatToRelevInfer]) + _bodyIappFunKind :: AppFunKind + _bodyIargL :: ([CBound]) + _bodyIcTrf :: CExpr + _bodyIcoe :: RelevCoe + _bodyIfunCoe :: RelevCoe + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIgathLamMp :: LamMp + _bodyImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _bodyImbFunVar :: (Maybe HsName) + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIoTrf :: CExpr + _bodyIqualS :: RelevQualS + _bodyIrvarMp :: RVarMp + _bodyIty :: RelevTy + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _bodyIqualS + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _oTrf = + CExpr_HoleLet bindsUid_ _bodyIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (up) + _lhsOrvarMp = + _bodyIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _bodyOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bodyOdataGam = + _lhsIdataGam + -- copy rule (down) + _bodyOenv = + _lhsIenv + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOknTy = + _lhsIknTy + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (down) + _bodyOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + -- copy rule (down) + _bodyOwhatTo = + _lhsIwhatTo + ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIcoe,_bodyIfunCoe,_bodyIfvS,_bodyIgUniq,_bodyIgathLamMp,_bodyImbFFIApp,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIoTrf,_bodyIqualS,_bodyIrvarMp,_bodyIty,_bodyIwhatBelow) = + body_ _bodyOaltMbScrutTy _bodyOboundRelevTyVarS _bodyOdataGam _bodyOenv _bodyOevalCtx _bodyOfinalRVarMp _bodyOgUniq _bodyOisTopApp _bodyOisTopTup _bodyOknTy _bodyOlamMp _bodyOlev _bodyOopts _bodyOrvarMp _bodyOwhatAbove _bodyOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _oTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _funcOaltMbScrutTy :: MbRelevTy + _funcOboundRelevTyVarS :: UIDS + _funcOdataGam :: DataGam + _funcOenv :: REnv + _funcOevalCtx :: EvalCtx + _funcOfinalRVarMp :: RVarMp + _funcOgUniq :: UID + _funcOisTopApp :: Bool + _funcOisTopTup :: Bool + _funcOknTy :: RelevTy + _funcOlamMp :: LamMp + _funcOlev :: Int + _funcOopts :: EHCOpts + _funcOrvarMp :: RVarMp + _funcOwhatAbove :: WhatExpr + _funcOwhatTo :: ([WhatToRelevInfer]) + _funcIappFunKind :: AppFunKind + _funcIargL :: ([CBound]) + _funcIcTrf :: CExpr + _funcIcoe :: RelevCoe + _funcIfunCoe :: RelevCoe + _funcIfvS :: FvS + _funcIgUniq :: UID + _funcIgathLamMp :: LamMp + _funcImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _funcImbFunVar :: (Maybe HsName) + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIoTrf :: CExpr + _funcIqualS :: RelevQualS + _funcIrvarMp :: RVarMp + _funcIty :: RelevTy + _funcIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _funcIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _funcIqualS + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _oTrf = + CExpr_ImplsApp _funcIoTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _funcIgUniq + -- copy rule (up) + _lhsOrvarMp = + _funcIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _funcOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _funcOdataGam = + _lhsIdataGam + -- copy rule (down) + _funcOenv = + _lhsIenv + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (from local) + _funcOisTopApp = + _isTopApp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOknTy = + _lhsIknTy + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOopts = + _lhsIopts + -- copy rule (down) + _funcOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (down) + _funcOwhatTo = + _lhsIwhatTo + ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcIcoe,_funcIfunCoe,_funcIfvS,_funcIgUniq,_funcIgathLamMp,_funcImbFFIApp,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIoTrf,_funcIqualS,_funcIrvarMp,_funcIty,_funcIwhatBelow) = + func_ _funcOaltMbScrutTy _funcOboundRelevTyVarS _funcOdataGam _funcOenv _funcOevalCtx _funcOfinalRVarMp _funcOgUniq _funcOisTopApp _funcOisTopTup _funcOknTy _funcOlamMp _funcOlev _funcOopts _funcOrvarMp _funcOwhatAbove _funcOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOargL :: ([CBound]) + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOcoe :: RelevCoe + _lhsOfunCoe :: RelevCoe + _lhsOty :: RelevTy + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _lhsOwhatBelow :: WhatExpr + _bodyOaltMbScrutTy :: MbRelevTy + _bodyOboundRelevTyVarS :: UIDS + _bodyOdataGam :: DataGam + _bodyOenv :: REnv + _bodyOevalCtx :: EvalCtx + _bodyOfinalRVarMp :: RVarMp + _bodyOgUniq :: UID + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOknTy :: RelevTy + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOopts :: EHCOpts + _bodyOrvarMp :: RVarMp + _bodyOwhatAbove :: WhatExpr + _bodyOwhatTo :: ([WhatToRelevInfer]) + _bodyIappFunKind :: AppFunKind + _bodyIargL :: ([CBound]) + _bodyIcTrf :: CExpr + _bodyIcoe :: RelevCoe + _bodyIfunCoe :: RelevCoe + _bodyIfvS :: FvS + _bodyIgUniq :: UID + _bodyIgathLamMp :: LamMp + _bodyImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _bodyImbFunVar :: (Maybe HsName) + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIoTrf :: CExpr + _bodyIqualS :: RelevQualS + _bodyIrvarMp :: RVarMp + _bodyIty :: RelevTy + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 8, column 33) + _lhsOmbFunVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 15, column 33) + _lhsOargL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonFFI.ag"(line 43, column 17) + _lhsOmbFFIApp = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 356, column 17) + _lhsOfunCoe = + RelevCoe_Err "CExpr.unimpl" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) + _lhsOty = + RelevTy_Err "unimpl" + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _bodyIqualS + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _oTrf = + CExpr_ImplsLam uid_ _bodyIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (up) + _lhsOrvarMp = + _bodyIrvarMp + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _bodyOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bodyOdataGam = + _lhsIdataGam + -- copy rule (down) + _bodyOenv = + _lhsIenv + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOknTy = + _lhsIknTy + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (down) + _bodyOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + -- copy rule (down) + _bodyOwhatTo = + _lhsIwhatTo + ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIcoe,_bodyIfunCoe,_bodyIfvS,_bodyIgUniq,_bodyIgathLamMp,_bodyImbFFIApp,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIoTrf,_bodyIqualS,_bodyIrvarMp,_bodyIty,_bodyIwhatBelow) = + body_ _bodyOaltMbScrutTy _bodyOboundRelevTyVarS _bodyOdataGam _bodyOenv _bodyOevalCtx _bodyOfinalRVarMp _bodyOgUniq _bodyOisTopApp _bodyOisTopTup _bodyOknTy _bodyOlamMp _bodyOlev _bodyOopts _bodyOrvarMp _bodyOwhatAbove _bodyOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIaltMbScrutTy + _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIevalCtx + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIisTopApp + _lhsIisTopTup + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatAbove + _lhsIwhatTo -> + (let _lhsOcoe :: RelevCoe + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExpr + _lhsOoTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOargL :: ([CBound]) + _lhsOfunCoe :: RelevCoe + _lhsOgUniq :: UID + _lhsOgathLamMp :: LamMp + _lhsOmbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _lhsOmbFunVar :: (Maybe HsName) + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOrvarMp :: RVarMp + _lhsOty :: RelevTy + _lhsOwhatBelow :: WhatExpr + _annOboundRelevTyVarS :: UIDS + _annOdataGam :: DataGam + _annOenv :: REnv + _annOfinalRVarMp :: RVarMp + _annOgUniq :: UID + _annOknTy :: RelevTy + _annOlamMp :: LamMp + _annOlev :: Int + _annOopts :: EHCOpts + _annOrvarMp :: RVarMp + _annOwhatTo :: ([WhatToRelevInfer]) + _exprOaltMbScrutTy :: MbRelevTy + _exprOboundRelevTyVarS :: UIDS + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOevalCtx :: EvalCtx + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOknTy :: RelevTy + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _annIcTrf :: CExprAnn + _annIfvS :: FvS + _annIgUniq :: UID + _annIoTrf :: CExprAnn + _annIqualS :: RelevQualS + _annIrvarMp :: RVarMp + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) + _lhsOcoe = + RelevCoe_Id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _annIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _annIqualS `Set.union` _exprIqualS + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _oTrf = + CExpr_Ann _annIoTrf _exprIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOappFunKind = + _exprIappFunKind + -- copy rule (up) + _lhsOargL = + _exprIargL + -- copy rule (up) + _lhsOfunCoe = + _exprIfunCoe + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (up) + _lhsOmbFFIApp = + _exprImbFFIApp + -- copy rule (up) + _lhsOmbFunVar = + _exprImbFunVar + -- copy rule (up) + _lhsOmbLam = + _exprImbLam + -- copy rule (up) + _lhsOmbVar = + _exprImbVar + -- copy rule (up) + _lhsOrvarMp = + _exprIrvarMp + -- copy rule (up) + _lhsOty = + _exprIty + -- copy rule (up) + _lhsOwhatBelow = + _exprIwhatBelow + -- copy rule (down) + _annOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _annOdataGam = + _lhsIdataGam + -- copy rule (down) + _annOenv = + _lhsIenv + -- copy rule (down) + _annOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _annOgUniq = + _lhsIgUniq + -- copy rule (down) + _annOknTy = + _lhsIknTy + -- copy rule (down) + _annOlamMp = + _lhsIlamMp + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOopts = + _lhsIopts + -- copy rule (down) + _annOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _annOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _exprOaltMbScrutTy = + _lhsIaltMbScrutTy + -- copy rule (down) + _exprOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _exprOgUniq = + _annIgUniq + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOknTy = + _lhsIknTy + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (chain) + _exprOrvarMp = + _annIrvarMp + -- copy rule (down) + _exprOwhatAbove = + _lhsIwhatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _annIcTrf,_annIfvS,_annIgUniq,_annIoTrf,_annIqualS,_annIrvarMp) = + ann_ _annOboundRelevTyVarS _annOdataGam _annOenv _annOfinalRVarMp _annOgUniq _annOknTy _annOlamMp _annOlev _annOopts _annOrvarMp _annOwhatTo + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOcoe,_lhsOfunCoe,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOmbFFIApp,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp,_lhsOty,_lhsOwhatBelow))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + oTrf : CExprAnn + qualS : RelevQualS + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CExprAnn,FvS,UID,CExprAnn,RelevQualS,RVarMp) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExprAnn + _lhsOoTrf :: CExprAnn + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _oTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExprAnn + _lhsOoTrf :: CExprAnn + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _oTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CExprAnn + _lhsOoTrf :: CExprAnn + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _oTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + oTrf : CMetaBind + qualS : RelevQualS + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + local oTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + local oTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + local oTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CMetaBind,FvS,UID,CMetaBind,RelevQualS,RVarMp) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaBind + _lhsOoTrf :: CMetaBind + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _oTrf = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaBind + _lhsOoTrf :: CMetaBind + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _oTrf = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaBind + _lhsOoTrf :: CMetaBind + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _oTrf = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaBind + _lhsOoTrf :: CMetaBind + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _oTrf = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + oTrf : CMetaVal + qualS : RelevQualS + alternatives: + alternative Val: + visit 0: + local cTrf : _ + local oTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + local oTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local oTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CMetaVal,FvS,UID,CMetaVal,RelevQualS,RVarMp) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaVal + _lhsOoTrf :: CMetaVal + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _oTrf = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaVal + _lhsOoTrf :: CMetaVal + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _oTrf = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaVal + _lhsOoTrf :: CMetaVal + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _oTrf = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaVal + _lhsOoTrf :: CMetaVal + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _oTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetaVal + _lhsOoTrf :: CMetaVal + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _oTrf = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CMetas + fvS : FvS + oTrf : CMetas + qualS : RelevQualS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CMetas,FvS,UID,CMetas,RelevQualS,RVarMp) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CMetas + _lhsOoTrf :: CMetas + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _x1OboundRelevTyVarS :: UIDS + _x1OdataGam :: DataGam + _x1Oenv :: REnv + _x1OfinalRVarMp :: RVarMp + _x1OgUniq :: UID + _x1OknTy :: RelevTy + _x1OlamMp :: LamMp + _x1Olev :: Int + _x1Oopts :: EHCOpts + _x1OrvarMp :: RVarMp + _x1OwhatTo :: ([WhatToRelevInfer]) + _x2OboundRelevTyVarS :: UIDS + _x2OdataGam :: DataGam + _x2Oenv :: REnv + _x2OfinalRVarMp :: RVarMp + _x2OgUniq :: UID + _x2OknTy :: RelevTy + _x2OlamMp :: LamMp + _x2Olev :: Int + _x2Oopts :: EHCOpts + _x2OrvarMp :: RVarMp + _x2OwhatTo :: ([WhatToRelevInfer]) + _x1IcTrf :: CMetaBind + _x1IfvS :: FvS + _x1IgUniq :: UID + _x1IoTrf :: CMetaBind + _x1IqualS :: RelevQualS + _x1IrvarMp :: RVarMp + _x2IcTrf :: CMetaVal + _x2IfvS :: FvS + _x2IgUniq :: UID + _x2IoTrf :: CMetaVal + _x2IqualS :: RelevQualS + _x2IrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _x1IfvS `Set.union` _x2IfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _x1IqualS `Set.union` _x2IqualS + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _oTrf = + (_x1IoTrf,_x2IoTrf) + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _x2IgUniq + -- copy rule (up) + _lhsOrvarMp = + _x2IrvarMp + -- copy rule (down) + _x1OboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _x1OdataGam = + _lhsIdataGam + -- copy rule (down) + _x1Oenv = + _lhsIenv + -- copy rule (down) + _x1OfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _x1OgUniq = + _lhsIgUniq + -- copy rule (down) + _x1OknTy = + _lhsIknTy + -- copy rule (down) + _x1OlamMp = + _lhsIlamMp + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1Oopts = + _lhsIopts + -- copy rule (down) + _x1OrvarMp = + _lhsIrvarMp + -- copy rule (down) + _x1OwhatTo = + _lhsIwhatTo + -- copy rule (down) + _x2OboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _x2OdataGam = + _lhsIdataGam + -- copy rule (down) + _x2Oenv = + _lhsIenv + -- copy rule (down) + _x2OfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _x2OgUniq = + _x1IgUniq + -- copy rule (down) + _x2OknTy = + _lhsIknTy + -- copy rule (down) + _x2OlamMp = + _lhsIlamMp + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2Oopts = + _lhsIopts + -- copy rule (chain) + _x2OrvarMp = + _x1IrvarMp + -- copy rule (down) + _x2OwhatTo = + _lhsIwhatTo + ( _x1IcTrf,_x1IfvS,_x1IgUniq,_x1IoTrf,_x1IqualS,_x1IrvarMp) = + x1_ _x1OboundRelevTyVarS _x1OdataGam _x1Oenv _x1OfinalRVarMp _x1OgUniq _x1OknTy _x1OlamMp _x1Olev _x1Oopts _x1OrvarMp _x1OwhatTo + ( _x2IcTrf,_x2IfvS,_x2IgUniq,_x2IoTrf,_x2IqualS,_x2IrvarMp) = + x2_ _x2OboundRelevTyVarS _x2OdataGam _x2Oenv _x2OfinalRVarMp _x2OgUniq _x2OknTy _x2OlamMp _x2Olev _x2Oopts _x2OrvarMp _x2OwhatTo + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CModule + fvS : FvS + gathLamMp : LamMp + qualS : RelevQualS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local altMbScrutTy : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = DataGam -> + REnv -> + RVarMp -> + UID -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CModule,FvS,UID,LamMp,RelevQualS,RVarMp) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOknTy :: RelevTy + _exprOboundRelevTyVarS :: UIDS + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CModule + _lhsOgUniq :: UID + _lhsOgathLamMp :: LamMp + _lhsOrvarMp :: RVarMp + _exprOaltMbScrutTy :: MbRelevTy + _exprOdataGam :: DataGam + _exprOenv :: REnv + _exprOfinalRVarMp :: RVarMp + _exprOgUniq :: UID + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOopts :: EHCOpts + _exprOrvarMp :: RVarMp + _exprOwhatAbove :: WhatExpr + _exprOwhatTo :: ([WhatToRelevInfer]) + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIappFunKind :: AppFunKind + _exprIargL :: ([CBound]) + _exprIcTrf :: CExpr + _exprIcoe :: RelevCoe + _exprIfunCoe :: RelevCoe + _exprIfvS :: FvS + _exprIgUniq :: UID + _exprIgathLamMp :: LamMp + _exprImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _exprImbFunVar :: (Maybe HsName) + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIoTrf :: CExpr + _exprIqualS :: RelevQualS + _exprIrvarMp :: RVarMp + _exprIty :: RelevTy + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 90, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 99, column 17) + _exprOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 204, column 17) + _exprOknTy = + RelevTy_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 17) + _exprOboundRelevTyVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _exprIqualS + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (up) + _lhsOrvarMp = + _exprIrvarMp + -- copy rule (from local) + _exprOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _exprOdataGam = + _lhsIdataGam + -- copy rule (down) + _exprOenv = + _lhsIenv + -- copy rule (down) + _exprOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _exprOwhatTo = + _lhsIwhatTo + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIcoe,_exprIfunCoe,_exprIfvS,_exprIgUniq,_exprIgathLamMp,_exprImbFFIApp,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIoTrf,_exprIqualS,_exprIrvarMp,_exprIty,_exprIwhatBelow) = + expr_ _exprOaltMbScrutTy _exprOboundRelevTyVarS _exprOdataGam _exprOenv _exprOevalCtx _exprOfinalRVarMp _exprOgUniq _exprOisTopApp _exprOisTopTup _exprOknTy _exprOlamMp _exprOlev _exprOopts _exprOrvarMp _exprOwhatAbove _exprOwhatTo + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOgathLamMp,_lhsOqualS,_lhsOrvarMp))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + patFldTyL : [(RelevTy,RelevTy)] + rvarMp : RVarMp + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + mbCTag : Maybe CTag + nmL : [HsName] + oTrf : CPat + qualS : RelevQualS + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + local oTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local oTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + ([(RelevTy,RelevTy)]) -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CPat,([HsName]),FvS,UID,(Maybe CTag),([HsName]),CPat,([(RelevTy,RelevTy)]),RelevQualS,RVarMp) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOnmL :: ([HsName]) + _lhsOmbCTag :: (Maybe CTag) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPat + _lhsOoTrf :: CPat + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 28, column 17) + _lhsOnmL = + [pnm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 22, column 33) + _lhsOmbCTag = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _oTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOnmL :: ([HsName]) + _lhsOmbCTag :: (Maybe CTag) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPat + _lhsOoTrf :: CPat + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + _restOboundRelevTyVarS :: UIDS + _restOdataGam :: DataGam + _restOenv :: REnv + _restOfinalRVarMp :: RVarMp + _restOgUniq :: UID + _restOknTy :: RelevTy + _restOknTyCase :: RelevTy + _restOlamMp :: LamMp + _restOlev :: Int + _restOopts :: EHCOpts + _restOrvarMp :: RVarMp + _restOwhatTo :: ([WhatToRelevInfer]) + _bindsOboundRelevTyVarS :: UIDS + _bindsOdataGam :: DataGam + _bindsOenv :: REnv + _bindsOfinalRVarMp :: RVarMp + _bindsOgUniq :: UID + _bindsOknTy :: RelevTy + _bindsOknTyCase :: RelevTy + _bindsOlamMp :: LamMp + _bindsOlev :: Int + _bindsOopts :: EHCOpts + _bindsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _bindsOrvarMp :: RVarMp + _bindsOwhatTo :: ([WhatToRelevInfer]) + _restIcTrf :: CPatRest + _restIfvS :: FvS + _restIgUniq :: UID + _restInmL :: ([HsName]) + _restIoTrf :: CPatRest + _restIqualS :: RelevQualS + _restIrvarMp :: RVarMp + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + _bindsIfvS :: FvS + _bindsIgUniq :: UID + _bindsInmL :: ([HsName]) + _bindsIoTrf :: CPatFldL + _bindsIpatFldTyL :: ([(RelevTy,RelevTy)]) + _bindsIqualS :: RelevQualS + _bindsIrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 29, column 17) + _lhsOnmL = + _restInmL ++ _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 20, column 25) + _lhsOmbCTag = + Just tag_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _restIfvS `Set.union` _bindsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _restIqualS `Set.union` _bindsIqualS + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _oTrf = + CPat_Con tag_ _restIoTrf _bindsIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _bindsIgUniq + -- copy rule (up) + _lhsOpatFldTyL = + _bindsIpatFldTyL + -- copy rule (up) + _lhsOrvarMp = + _bindsIrvarMp + -- copy rule (down) + _restOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _restOdataGam = + _lhsIdataGam + -- copy rule (down) + _restOenv = + _lhsIenv + -- copy rule (down) + _restOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _restOgUniq = + _lhsIgUniq + -- copy rule (down) + _restOknTy = + _lhsIknTy + -- copy rule (down) + _restOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _restOlamMp = + _lhsIlamMp + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOopts = + _lhsIopts + -- copy rule (down) + _restOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _restOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _bindsOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindsOdataGam = + _lhsIdataGam + -- copy rule (down) + _bindsOenv = + _lhsIenv + -- copy rule (down) + _bindsOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _bindsOgUniq = + _restIgUniq + -- copy rule (down) + _bindsOknTy = + _lhsIknTy + -- copy rule (down) + _bindsOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOopts = + _lhsIopts + -- copy rule (down) + _bindsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _bindsOrvarMp = + _restIrvarMp + -- copy rule (down) + _bindsOwhatTo = + _lhsIwhatTo + ( _restIcTrf,_restIfvS,_restIgUniq,_restInmL,_restIoTrf,_restIqualS,_restIrvarMp) = + rest_ _restOboundRelevTyVarS _restOdataGam _restOenv _restOfinalRVarMp _restOgUniq _restOknTy _restOknTyCase _restOlamMp _restOlev _restOopts _restOrvarMp _restOwhatTo + ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsIgUniq,_bindsInmL,_bindsIoTrf,_bindsIpatFldTyL,_bindsIqualS,_bindsIrvarMp) = + binds_ _bindsOboundRelevTyVarS _bindsOdataGam _bindsOenv _bindsOfinalRVarMp _bindsOgUniq _bindsOknTy _bindsOknTyCase _bindsOlamMp _bindsOlev _bindsOopts _bindsOpatFldTyL _bindsOrvarMp _bindsOwhatTo + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOmbCTag :: (Maybe CTag) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPat + _lhsOoTrf :: CPat + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 22, column 33) + _lhsOmbCTag = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _oTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOmbCTag :: (Maybe CTag) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPat + _lhsOoTrf :: CPat + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 22, column 33) + _lhsOmbCTag = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _oTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOmbCTag :: (Maybe CTag) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPat + _lhsOoTrf :: CPat + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonStructureInfo.ag"(line 22, column 33) + _lhsOmbCTag = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _oTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOmbCTag,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + patFldTyL : [(RelevTy,RelevTy)] + rvarMp : RVarMp + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + oTrf : CPatFld + qualS : RelevQualS + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local fldNm : _ + local _tup25 : _ + local patFldTy : _ + local fldCoe : _ + local altMbScrutTy : _ + local hereOffCoe : _ + local hereFldCoe : _ + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + ([(RelevTy,RelevTy)]) -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CPatFld,([HsName]),FvS,UID,([HsName]),CPatFld,([(RelevTy,RelevTy)]),RelevQualS,RVarMp) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOnmL :: ([HsName]) + _bindOletBindingsCateg :: CBindCateg + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _whatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _bindOevalCtx :: EvalCtx + _lhsOfldNmL :: ([HsName]) + _bindOisGlobal :: Bool + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _offsetOknTy :: RelevTy + _bindOforQuantRVarMp :: RVarMp + _lhsOcTrf :: CPatFld + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOoTrf :: CPatFld + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + _offsetOaltMbScrutTy :: MbRelevTy + _offsetOboundRelevTyVarS :: UIDS + _offsetOdataGam :: DataGam + _offsetOenv :: REnv + _offsetOfinalRVarMp :: RVarMp + _offsetOgUniq :: UID + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOopts :: EHCOpts + _offsetOrvarMp :: RVarMp + _offsetOwhatAbove :: WhatExpr + _offsetOwhatTo :: ([WhatToRelevInfer]) + _bindOboundRelevTyVarS :: UIDS + _bindOdataGam :: DataGam + _bindOenv :: REnv + _bindOfinalRVarMp :: RVarMp + _bindOgUniq :: UID + _bindOknTy :: RelevTy + _bindOlamMp :: LamMp + _bindOlev :: Int + _bindOopts :: EHCOpts + _bindOrvarMp :: RVarMp + _bindOwhatTo :: ([WhatToRelevInfer]) + _fldAnnsOboundRelevTyVarS :: UIDS + _fldAnnsOdataGam :: DataGam + _fldAnnsOenv :: REnv + _fldAnnsOfinalRVarMp :: RVarMp + _fldAnnsOgUniq :: UID + _fldAnnsOknTy :: RelevTy + _fldAnnsOknTyCase :: RelevTy + _fldAnnsOlamMp :: LamMp + _fldAnnsOlev :: Int + _fldAnnsOopts :: EHCOpts + _fldAnnsOrvarMp :: RVarMp + _fldAnnsOwhatTo :: ([WhatToRelevInfer]) + _offsetIappFunKind :: AppFunKind + _offsetIargL :: ([CBound]) + _offsetIcTrf :: CExpr + _offsetIcoe :: RelevCoe + _offsetIfunCoe :: RelevCoe + _offsetIfvS :: FvS + _offsetIgUniq :: UID + _offsetIgathLamMp :: LamMp + _offsetImbFFIApp :: (Maybe ( Ty + , Bool + , FFIWay + , ForeignEnt + , [Ty] + )) + _offsetImbFunVar :: (Maybe HsName) + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIoTrf :: CExpr + _offsetIqualS :: RelevQualS + _offsetIrvarMp :: RVarMp + _offsetIty :: RelevTy + _offsetIwhatBelow :: WhatExpr + _bindIaltMbScrutTy :: MbRelevTy + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindIextraBindRVarMp :: RVarMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: UID + _bindIgathEnv :: REnv + _bindIgathRecEnv :: REnv + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bindIoTrf :: CBind + _bindIqualS :: RelevQualS + _bindIrvarMp :: RVarMp + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIfvS :: FvS + _fldAnnsIgUniq :: UID + _fldAnnsInmL :: ([HsName]) + _fldAnnsIoTrf :: CBindAnnL + _fldAnnsIqualS :: RelevQualS + _fldAnnsIrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 22, column 17) + _lhsOnmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 9, column 17) + _bindOletBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 84, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) + _offsetOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 103, column 33) + _bindOevalCtx = + EvalCtx_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 188, column 17) + __tup25 = + hdAndTl' (panic $ "patFldTyL: " ++ show _fldNm) _lhsIpatFldTyL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 188, column 17) + (_patFldTy,_) = + __tup25 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 188, column 17) + (_,_lhsOpatFldTyL) = + __tup25 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 189, column 17) + _fldCoe = + let (tgiven,tused) = _patFldTy + in RelevCoe_CastTy tgiven tused + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 219, column 17) + _offsetOknTy = + _lhsIknTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 313, column 17) + _altMbScrutTy = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 343, column 17) + _hereOffCoe = + _lhsIfinalRVarMp `varUpd` _offsetIcoe + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 343, column 17) + _hereFldCoe = + _lhsIfinalRVarMp `varUpd` _fldCoe + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 397, column 25) + _bindOforQuantRVarMp = + emptyRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 628, column 17) + _lhsOcTrf = + CPatFld_Fld lbl_ (annCoe _hereOffCoe _offsetIcTrf) _bindIcTrf [CBindAnn_Coe _hereFldCoe] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _offsetIqualS `Set.union` _bindIqualS `Set.union` _fldAnnsIqualS + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _oTrf = + CPatFld_Fld lbl_ _offsetIoTrf _bindIoTrf _fldAnnsIoTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _fldAnnsIgUniq + -- copy rule (up) + _lhsOrvarMp = + _fldAnnsIrvarMp + -- copy rule (from local) + _offsetOaltMbScrutTy = + _altMbScrutTy + -- copy rule (down) + _offsetOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _offsetOdataGam = + _lhsIdataGam + -- copy rule (down) + _offsetOenv = + _lhsIenv + -- copy rule (down) + _offsetOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _offsetOgUniq = + _lhsIgUniq + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (down) + _offsetOrvarMp = + _lhsIrvarMp + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _bindOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _bindOdataGam = + _lhsIdataGam + -- copy rule (down) + _bindOenv = + _lhsIenv + -- copy rule (down) + _bindOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _bindOgUniq = + _offsetIgUniq + -- copy rule (down) + _bindOknTy = + _lhsIknTy + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (chain) + _bindOrvarMp = + _offsetIrvarMp + -- copy rule (down) + _bindOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _fldAnnsOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _fldAnnsOdataGam = + _lhsIdataGam + -- copy rule (down) + _fldAnnsOenv = + _lhsIenv + -- copy rule (down) + _fldAnnsOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _fldAnnsOgUniq = + _bindIgUniq + -- copy rule (down) + _fldAnnsOknTy = + _lhsIknTy + -- copy rule (down) + _fldAnnsOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _fldAnnsOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOopts = + _lhsIopts + -- copy rule (chain) + _fldAnnsOrvarMp = + _bindIrvarMp + -- copy rule (down) + _fldAnnsOwhatTo = + _lhsIwhatTo + ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIcoe,_offsetIfunCoe,_offsetIfvS,_offsetIgUniq,_offsetIgathLamMp,_offsetImbFFIApp,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIoTrf,_offsetIqualS,_offsetIrvarMp,_offsetIty,_offsetIwhatBelow) = + offset_ _offsetOaltMbScrutTy _offsetOboundRelevTyVarS _offsetOdataGam _offsetOenv _offsetOevalCtx _offsetOfinalRVarMp _offsetOgUniq _offsetOisTopApp _offsetOisTopTup _offsetOknTy _offsetOlamMp _offsetOlev _offsetOopts _offsetOrvarMp _offsetOwhatAbove _offsetOwhatTo + ( _bindIaltMbScrutTy,_bindIbindLamMp,_bindIcTrf,_bindIextraBindRVarMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIgathEnv,_bindIgathRecEnv,_bindInm,_bindInmL,_bindIoTrf,_bindIqualS,_bindIrvarMp) = + bind_ _bindOboundRelevTyVarS _bindOdataGam _bindOenv _bindOevalCtx _bindOfinalRVarMp _bindOforQuantRVarMp _bindOgUniq _bindOisGlobal _bindOknTy _bindOlamMp _bindOletBindingsCateg _bindOlev _bindOopts _bindOrvarMp _bindOwhatTo + ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsIgUniq,_fldAnnsInmL,_fldAnnsIoTrf,_fldAnnsIqualS,_fldAnnsIrvarMp) = + fldAnns_ _fldAnnsOboundRelevTyVarS _fldAnnsOdataGam _fldAnnsOenv _fldAnnsOfinalRVarMp _fldAnnsOgUniq _fldAnnsOknTy _fldAnnsOknTyCase _fldAnnsOlamMp _fldAnnsOlev _fldAnnsOopts _fldAnnsOrvarMp _fldAnnsOwhatTo + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + patFldTyL : [(RelevTy,RelevTy)] + rvarMp : RVarMp + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + oTrf : CPatFldL + qualS : RelevQualS + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + local oTrf : _ + alternative Nil: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + ([(RelevTy,RelevTy)]) -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CPatFldL,([HsName]),FvS,UID,([HsName]),CPatFldL,([(RelevTy,RelevTy)]),RelevQualS,RVarMp) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPatFldL + _lhsOoTrf :: CPatFldL + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + _hdOboundRelevTyVarS :: UIDS + _hdOdataGam :: DataGam + _hdOenv :: REnv + _hdOfinalRVarMp :: RVarMp + _hdOgUniq :: UID + _hdOknTy :: RelevTy + _hdOknTyCase :: RelevTy + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOopts :: EHCOpts + _hdOpatFldTyL :: ([(RelevTy,RelevTy)]) + _hdOrvarMp :: RVarMp + _hdOwhatTo :: ([WhatToRelevInfer]) + _tlOboundRelevTyVarS :: UIDS + _tlOdataGam :: DataGam + _tlOenv :: REnv + _tlOfinalRVarMp :: RVarMp + _tlOgUniq :: UID + _tlOknTy :: RelevTy + _tlOknTyCase :: RelevTy + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOopts :: EHCOpts + _tlOpatFldTyL :: ([(RelevTy,RelevTy)]) + _tlOrvarMp :: RVarMp + _tlOwhatTo :: ([WhatToRelevInfer]) + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _hdIfvS :: FvS + _hdIgUniq :: UID + _hdInmL :: ([HsName]) + _hdIoTrf :: CPatFld + _hdIpatFldTyL :: ([(RelevTy,RelevTy)]) + _hdIqualS :: RelevQualS + _hdIrvarMp :: RVarMp + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + _tlIfvS :: FvS + _tlIgUniq :: UID + _tlInmL :: ([HsName]) + _tlIoTrf :: CPatFldL + _tlIpatFldTyL :: ([(RelevTy,RelevTy)]) + _tlIqualS :: RelevQualS + _tlIrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + _hdIqualS `Set.union` _tlIqualS + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _oTrf = + (:) _hdIoTrf _tlIoTrf + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOpatFldTyL = + _tlIpatFldTyL + -- copy rule (up) + _lhsOrvarMp = + _tlIrvarMp + -- copy rule (down) + _hdOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _hdOdataGam = + _lhsIdataGam + -- copy rule (down) + _hdOenv = + _lhsIenv + -- copy rule (down) + _hdOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOknTy = + _lhsIknTy + -- copy rule (down) + _hdOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (down) + _hdOrvarMp = + _lhsIrvarMp + -- copy rule (down) + _hdOwhatTo = + _lhsIwhatTo + -- copy rule (down) + _tlOboundRelevTyVarS = + _lhsIboundRelevTyVarS + -- copy rule (down) + _tlOdataGam = + _lhsIdataGam + -- copy rule (down) + _tlOenv = + _lhsIenv + -- copy rule (down) + _tlOfinalRVarMp = + _lhsIfinalRVarMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOknTy = + _lhsIknTy + -- copy rule (down) + _tlOknTyCase = + _lhsIknTyCase + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOpatFldTyL = + _hdIpatFldTyL + -- copy rule (chain) + _tlOrvarMp = + _hdIrvarMp + -- copy rule (down) + _tlOwhatTo = + _lhsIwhatTo + ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdIgUniq,_hdInmL,_hdIoTrf,_hdIpatFldTyL,_hdIqualS,_hdIrvarMp) = + hd_ _hdOboundRelevTyVarS _hdOdataGam _hdOenv _hdOfinalRVarMp _hdOgUniq _hdOknTy _hdOknTyCase _hdOlamMp _hdOlev _hdOopts _hdOpatFldTyL _hdOrvarMp _hdOwhatTo + ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlIgUniq,_tlInmL,_tlIoTrf,_tlIpatFldTyL,_tlIqualS,_tlIrvarMp) = + tl_ _tlOboundRelevTyVarS _tlOdataGam _tlOenv _tlOfinalRVarMp _tlOgUniq _tlOknTy _tlOknTyCase _tlOlamMp _tlOlev _tlOopts _tlOpatFldTyL _tlOrvarMp _tlOwhatTo + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIpatFldTyL + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPatFldL + _lhsOoTrf :: CPatFldL + _lhsOgUniq :: UID + _lhsOpatFldTyL :: ([(RelevTy,RelevTy)]) + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + [] + -- self rule + _oTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOpatFldTyL = + _lhsIpatFldTyL + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOpatFldTyL,_lhsOqualS,_lhsOrvarMp))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + boundRelevTyVarS : UIDS + dataGam : DataGam + env : REnv + finalRVarMp : RVarMp + knTy : RelevTy + knTyCase : RelevTy + lamMp : LamMp + lev : Int + opts : EHCOpts + whatTo : [WhatToRelevInfer] + chained attributes: + gUniq : UID + rvarMp : RVarMp + synthesized attributes: + cTrf : CPatRest + fvS : FvS + nmL : [HsName] + oTrf : CPatRest + qualS : RelevQualS + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + local oTrf : _ + alternative Empty: + visit 0: + local cTrf : _ + local oTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = UIDS -> + DataGam -> + REnv -> + RVarMp -> + UID -> + RelevTy -> + RelevTy -> + LamMp -> + Int -> + EHCOpts -> + RVarMp -> + ([WhatToRelevInfer]) -> + ( CPatRest,FvS,UID,([HsName]),CPatRest,RelevQualS,RVarMp) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOnmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPatRest + _lhsOoTrf :: CPatRest + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 25, column 17) + _lhsOnmL = + [nm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _oTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIboundRelevTyVarS + _lhsIdataGam + _lhsIenv + _lhsIfinalRVarMp + _lhsIgUniq + _lhsIknTy + _lhsIknTyCase + _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIrvarMp + _lhsIwhatTo -> + (let _lhsOfvS :: FvS + _lhsOnmL :: ([HsName]) + _lhsOqualS :: RelevQualS + _lhsOcTrf :: CPatRest + _lhsOoTrf :: CPatRest + _lhsOgUniq :: UID + _lhsOrvarMp :: RVarMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 28) + _lhsOqualS = + Set.empty + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _oTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOoTrf = + _oTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOrvarMp = + _lhsIrvarMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOnmL,_lhsOoTrf,_lhsOqualS,_lhsOrvarMp))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + dataGam : DataGam + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + gathLamMp : LamMp + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local gathLamMp : _ + local whatTo : _ + local howUnionGathLamInfo : _ + local howMergeLamInfo : _ + local gUniq : _ + local env : _ + local rvarMp : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = DataGam -> + LamMp -> + EHCOpts -> + ( CModule,LamMp) +data Inh_CodeAGItf = Inh_CodeAGItf {dataGam_Inh_CodeAGItf :: !(DataGam),lamMp_Inh_CodeAGItf :: !(LamMp),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule),gathLamMp_Syn_CodeAGItf :: !(LamMp)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIdataGam _lhsIlamMp _lhsIopts) = + (let ( _lhsOcTrf,_lhsOgathLamMp) = sem _lhsIdataGam _lhsIlamMp _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf _lhsOgathLamMp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIdataGam + _lhsIlamMp + _lhsIopts -> + (let _moduleOlamMp :: LamMp + _moduleOlev :: Int + _moduleOfinalRVarMp :: RVarMp + _lhsOcTrf :: CModule + _lhsOgathLamMp :: LamMp + _moduleOdataGam :: DataGam + _moduleOenv :: REnv + _moduleOgUniq :: UID + _moduleOopts :: EHCOpts + _moduleOrvarMp :: RVarMp + _moduleOwhatTo :: ([WhatToRelevInfer]) + _moduleIcTrf :: CModule + _moduleIfvS :: FvS + _moduleIgUniq :: UID + _moduleIgathLamMp :: LamMp + _moduleIqualS :: RelevQualS + _moduleIrvarMp :: RVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 15, column 17) + _gathLamMp = + lamMpMergeInto _howMergeLamInfo const _moduleIgathLamMp _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 16, column 17) + _moduleOlamMp = + _howUnionGathLamInfo _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 104, column 17) + _whatTo = + case optimizeOptionStictnessAnalysisQuant (ehcOptOptimizeOptionMp _lhsIopts) of + OptimizeOptionValue_StrictnessAnalysis_NoQuant -> [ ] + OptimizeOptionValue_StrictnessAnalysis_QuantInstantiate -> [ WhatToRelevInfer_Quant, WhatToRelevInfer_InstToBot ] + _ -> [ WhatToRelevInfer_Quant ] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 110, column 17) + _howUnionGathLamInfo = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 114, column 17) + _howMergeLamInfo = + (\(LamInfo {laminfoBindAspMp=m}) i -> i {laminfoBindAspMp = m `Map.union` laminfoBindAspMp i}) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 146, column 17) + _gUniq = + uidStart + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 153, column 17) + _env = + emptyGam + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 375, column 17) + _rvarMp = + emptyRVarMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 402, column 17) + _moduleOfinalRVarMp = + _moduleIrvarMp + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + -- copy rule (from local) + _lhsOgathLamMp = + _gathLamMp + -- copy rule (down) + _moduleOdataGam = + _lhsIdataGam + -- copy rule (from local) + _moduleOenv = + _env + -- copy rule (from local) + _moduleOgUniq = + _gUniq + -- copy rule (down) + _moduleOopts = + _lhsIopts + -- copy rule (from local) + _moduleOrvarMp = + _rvarMp + -- copy rule (from local) + _moduleOwhatTo = + _whatTo + ( _moduleIcTrf,_moduleIfvS,_moduleIgUniq,_moduleIgathLamMp,_moduleIqualS,_moduleIrvarMp) = + module_ _moduleOdataGam _moduleOenv _moduleOfinalRVarMp _moduleOgUniq _moduleOlamMp _moduleOlev _moduleOopts _moduleOrvarMp _moduleOwhatTo + in ( _lhsOcTrf,_lhsOgathLamMp))) diff --git a/src/UHC/Light/Compiler/Core/Trf/AnnBasedSimplify.hs b/src/UHC/Light/Compiler/Core/Trf/AnnBasedSimplify.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/AnnBasedSimplify.hs @@ -0,0 +1,3291 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnnBa) +module UHC.Light.Compiler.Core.Trf.AnnBasedSimplify(cmodTrfAnnBasedSimplify) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.CodeGen.Bits +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import Data.Maybe +import qualified Data.Set as Set +import UHC.Light.Compiler.AbstractCore + + + + + + + + + +cmodTrfAnnBasedSimplify :: EHCOpts -> CModule -> CModule +cmodTrfAnnBasedSimplify opts cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + }) + in cTrf_Syn_CodeAGItf t + + + +data Prop + = Prop_None + | Prop_HasTy Ty -- has ty + | Prop_IsTyInt -- is of type Int + | Prop_IsTyInteger -- is of type Integer + | Prop_IsInteger CExpr -- is an Integer + | Prop_IsIntegerConst Integer -- is an Integer constant + | Prop_IsIntConst Int -- is an Int constant + +type PropS = Set.Set Prop + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + propDown : Prop + synthesized attributes: + cTrf : CAlt + mbCTag : Maybe CTag + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + Int -> + EHCOpts -> + Prop -> + ( CAlt,(Maybe CTag)) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts + _lhsIpropDown -> + (case (_lhsIpropDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIopts) of + { _patOopts | _patOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOlev _patOopts) of + { ( _patIcTrf,_patIfldNmL,_patImbCTag) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_patImbCTag) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOmbCTag) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + propDown : Prop + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + Int -> + EHCOpts -> + Prop -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts + _lhsIpropDown -> + (case (_lhsIpropDown) of + { _tlOpropDown | _tlOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIpropDown) of + { _hdOpropDown | _hdOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOlev _tlOopts _tlOpropDown) of + { ( _tlIcTrf) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOlev _hdOopts _hdOpropDown) of + { ( _hdIcTrf,_hdImbCTag) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts + _lhsIpropDown -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBind + nm : HsName + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBind,HsName) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts | _bindAspectsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg | _bindAspectsOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx | _bindAspectsOevalCtx `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOopts) of + { ( _bindAspectsIcTrf) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + ( _lhsOcTrf,_lhsOnm) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + EHCOpts -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + EHCOpts -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOletBindingsCateg _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdInm) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + propDown : Prop + synthesized attributes: + cTrf : CBound + propUp : Prop + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local propDown : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local propUp : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + local propUp : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + local propUp : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local propDown : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + local propUp : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local propDown : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local propUp : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + Prop -> + ( CBound,Prop) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (Prop_None) of + { _propDown | _propDown `seq` (True) -> + (case (_propDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (_lhsIopts) of + { _bindMetaOopts | _bindMetaOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev _bindMetaOopts) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (_lhsIopts) of + { _cmetasOopts | _cmetasOopts `seq` (True) -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev _cmetasOopts) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (Prop_None) of + { _propDown | _propDown `seq` (True) -> + (case (_propDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIpropUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts + _lhsIpropDown -> + (case (Prop_None) of + { _propDown | _propDown `seq` (True) -> + (case (_propDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsLam 0) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + ( _lhsOcTrf,_lhsOpropUp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attribute: + cTrf : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (True) of + { _hdOisTopApp | _hdOisTopApp `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOnm _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (Prop_None) of + { _hdOpropDown | _hdOpropDown `seq` (True) -> + (case (True) of + { _hdOisTopTup | _hdOisTopTup `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm _hdOopts _hdOpropDown) of + { ( _hdIcTrf,_hdIpropUp) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lev : Int + opts : EHCOpts + propDown : Prop + whatAbove : WhatExpr + synthesized attributes: + appFunKind : AppFunKind + argL : [CBound] + cTrf : CExpr + mbFunVar : Maybe HsName + mbLam : Maybe [HsName] + mbVar : Maybe HsName + propUp : Prop + propUpL : [Prop] + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + local mbVar : {Maybe HsName} + local propUp : _ + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local whatAbove : {WhatExpr} + local propDown : _ + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local argL : _ + local cTrf : _ + local propUpL : _ + local propUp : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local propUp : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local propUp : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local propUp : _ + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ + local propUp : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + Int -> + EHCOpts -> + Prop -> + WhatExpr -> + ( AppFunKind,([CBound]),CExpr,(Maybe HsName),(Maybe [HsName]),(Maybe HsName),Prop,([Prop]),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Just _nm) of + { _mbVar | _mbVar `seq` (True) -> + (case (_mbVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_mbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsVar _nm) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsInt int_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsTup tag_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _bodyOpropDown | _bodyOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx | _evalCtx `seq` (True) -> + (case (_evalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOpropDown _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIpropUp,_bodyIpropUpL,_bodyIwhatBelow) | True -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (categ_) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg | _bindsOletBindingsCateg `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (_evalCtx) of + { _bindsOevalCtx | _bindsOevalCtx `seq` (True) -> + (case (binds_ _bindsOevalCtx _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev _bindsOopts) of + { ( _bindsIcTrf) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (Prop_None) of + { _propDown | _propDown `seq` (True) -> + (case (_propDown) of + { _funcOpropDown | _funcOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (False) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOpropDown _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIpropUp,_funcIpropUpL,_funcIwhatBelow) | True -> + (case (_funcIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (True) of + { _argOisTopApp | _argOisTopApp `seq` (True) -> + (case (_propDown) of + { _argOpropDown | _argOpropDown `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg | _argOletBindingsCateg `seq` (True) -> + (case (_isTopTup) of + { _argOisTopTup | _argOisTopTup `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (EvalCtx_Thunk) of + { _argOevalCtx | _argOevalCtx `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm _argOopts _argOpropDown) of + { ( _argIcTrf,_argIpropUp) | True -> + (case (_argIcTrf : _funcIargL) of + { _argL | _argL `seq` (True) -> + (case (_argL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_argIpropUp : _funcIpropUpL) of + { _propUpL | _propUpL `seq` (True) -> + (case (if _lhsIisTopApp + then case (_funcImbFunVar,reverse (zip (map acoreUnBoundVal _argL) _propUpL),_lhsIpropDown) of + (Just f,[(CExpr_String s,_)],_) + | f == (ehcOptBuiltin _lhsIopts ehbnPackedStringToInteger) + -> Prop_IsIntegerConst $ read s + (Just f,[_,(e,Prop_IsIntegerConst i)],Prop_HasTy t) + | f == (ehcOptBuiltin _lhsIopts ehbnFromInteger) + -> if t == tyInt + then + Prop_IsIntConst $ fromInteger i + else if t == tyInteger + then + if signedFitsInBits 30 i + then Prop_IsInteger $ acoreApp (acoreVar $ ehcOptBuiltin _lhsIopts ehbnPrimIntToInteger) [acoreInt2 _lhsIopts i] + else Prop_IsInteger e + else Prop_None + _ -> Prop_None + else Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (case _propUp of + Prop_IsIntConst i + -> acoreInt _lhsIopts i + Prop_IsInteger e + -> e + _ -> _cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case (_propUpL) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _bodyOpropDown | _bodyOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOpropDown _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIpropUp,_bodyIpropUpL,_bodyIwhatBelow) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindInm) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _dfltOpropDown | _dfltOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _dfltOopts | _dfltOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _dfltOisTopApp | _dfltOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _altsOpropDown | _altsOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _altsOopts | _altsOopts `seq` (True) -> + (case (_lhsIpropDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _dfltOwhatAbove | _dfltOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _dfltOisTopTup | _dfltOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx | _dfltOevalCtx `seq` (True) -> + (case (dflt_ _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOopts _dfltOpropDown _dfltOwhatAbove) of + { ( _dfltIappFunKind,_dfltIargL,_dfltIcTrf,_dfltImbFunVar,_dfltImbLam,_dfltImbVar,_dfltIpropUp,_dfltIpropUpL,_dfltIwhatBelow) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _altsOevalCtx | _altsOevalCtx `seq` (True) -> + (case (alts_ _altsOevalCtx _altsOlev _altsOopts _altsOpropDown) of + { ( _altsIcTrf) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _errorExprOwhatAbove | _errorExprOwhatAbove `seq` (True) -> + (case (_lhsIpropDown) of + { _errorExprOpropDown | _errorExprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _errorExprOopts | _errorExprOopts `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _errorExprOisTopTup | _errorExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _errorExprOisTopApp | _errorExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx | _errorExprOevalCtx `seq` (True) -> + (case (errorExpr_ _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOopts _errorExprOpropDown _errorExprOwhatAbove) of + { ( _errorExprIappFunKind,_errorExprIargL,_errorExprIcTrf,_errorExprImbFunVar,_errorExprImbLam,_errorExprImbVar,_errorExprIpropUp,_errorExprIpropUpL,_errorExprIwhatBelow) | True -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_errorExprIargL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (_errorExprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_errorExprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _offsetOpropDown | _offsetOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOpropDown _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIpropUp,_offsetIpropUpL,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _fldExprOpropDown | _fldExprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _offsetOpropDown | _offsetOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOpropDown _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIpropUp,_fldExprIpropUpL,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOpropDown _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIpropUp,_offsetIpropUpL,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _fldExprOpropDown | _fldExprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _offsetOpropDown | _offsetOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIpropDown) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOpropDown _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIpropUp,_fldExprIpropUpL,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOpropDown _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIpropUp,_offsetIpropUpL,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsFFI) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _bodyOpropDown | _bodyOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOpropDown _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIpropUp,_bodyIpropUpL,_bodyIwhatBelow) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _funcOpropDown | _funcOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOpropDown _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIpropUp,_funcIpropUpL,_funcIwhatBelow) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIpropDown) of + { _bodyOpropDown | _bodyOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOpropDown _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIpropUp,_bodyIpropUpL,_bodyIwhatBelow) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case ([]) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIpropDown + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (_lhsIopts) of + { _annOopts | _annOopts `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev _annOopts) of + { ( _annIcTrf,_annIprop) | True -> + (case (_annIprop) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (_exprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_exprIargL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (_exprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_exprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (Prop_None) of + { _propUp | _propUp `seq` (True) -> + (case (_propUp) of + { _lhsOpropUp | _lhsOpropUp `seq` (True) -> + (case (_exprIpropUpL) of + { _lhsOpropUpL | _lhsOpropUpL `seq` (True) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOpropUp,_lhsOpropUpL,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CExprAnn + prop : Prop + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + local prop : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + local prop : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ + local prop : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + EHCOpts -> + ( CExprAnn,Prop) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_HasTy ty_) of + { _prop | _prop `seq` (True) -> + (case (_prop) of + { _lhsOprop | _lhsOprop `seq` (True) -> + ( _lhsOcTrf,_lhsOprop) }) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _prop | _prop `seq` (True) -> + (case (_prop) of + { _lhsOprop | _lhsOprop `seq` (True) -> + ( _lhsOcTrf,_lhsOprop) }) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Prop_None) of + { _prop | _prop `seq` (True) -> + (case (_prop) of + { _lhsOprop | _lhsOprop `seq` (True) -> + ( _lhsOcTrf,_lhsOprop) }) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + EHCOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + EHCOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + EHCOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts | _x2Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev _x2Oopts) of + { ( _x2IcTrf) | True -> + (case (_lhsIopts) of + { _x1Oopts | _x1Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev _x1Oopts) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + EHCOpts -> + ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (Prop_None) of + { _exprOpropDown | _exprOpropDown `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOpropDown _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIpropUp,_exprIpropUpL,_exprIwhatBelow) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + mbCTag : Maybe CTag + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + EHCOpts -> + ( CPat,([HsName]),(Maybe CTag)) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOmbCTag) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev _bindsOopts) of + { ( _bindsIcTrf,_bindsIfldNmL) | True -> + (case (_lhsIopts) of + { _restOopts | _restOopts `seq` (True) -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev _restOopts) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Just tag_) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOmbCTag) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOmbCTag) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOmbCTag) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOmbCTag) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local propDown : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + EHCOpts -> + ( CPatFld,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (Prop_None) of + { _propDown | _propDown `seq` (True) -> + (case (_propDown) of + { _offsetOpropDown | _offsetOpropDown `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _fldAnnsOopts | _fldAnnsOopts `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev _fldAnnsOopts) of + { ( _fldAnnsIcTrf) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (EvalCtx_None) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindInm) | True -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (True) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOpropDown _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIpropUp,_offsetIpropUpL,_offsetIwhatBelow) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + EHCOpts -> + ( CPatFldL,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfldNmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfldNmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + EHCOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = EHCOpts -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = + (let ( _lhsOcTrf) | True = sem _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts | _moduleOopts `seq` (True) -> + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev _moduleOopts) of + { ( _moduleIcTrf) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs b/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs @@ -0,0 +1,7796 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGl) +module UHC.Light.Compiler.Core.Trf.CAFGlobalAsArg(cmodTrfCAFGlobalAsArg) where + +import UHC.Util.Utils +import Data.Maybe +import qualified Data.Set as Set +import Data.List +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.AbstractCore +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Debug.Trace + + + + + + + + + + + + + + + +cmodTrfCAFGlobalAsArg :: CModule -> CModule +cmodTrfCAFGlobalAsArg cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf) + in cTrf_Syn_CodeAGItf t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CAlt + fvS : FvS + levOf : Int + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cvi : _ + local fvS : _ + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CAlt,FvS,Int,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _exprOvarS :: FvS + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _lhsOlevOf :: Int + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOcTrf :: CAlt + _lhsOgUniq :: Int + _patOargMp :: CVarReplNmMp + _patOcvarIntroMp :: CVarIntroMp + _patOfvSCafMp :: FvSMp + _patOgUniq :: Int + _patOintroCVarIntroMp :: CVarIntroMp + _patOlamS :: FvS + _patOlev :: Int + _patOvarS :: FvS + _exprOargMp :: CVarReplNmMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOlamS :: FvS + _exprOlev :: Int + _exprOwhatAbove :: WhatExpr + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _patIfvS :: FvS + _patIgUniq :: Int + _patIlevOf :: Int + _patInmL :: ([HsName]) + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 23, column 17) + _exprOvarS = + _lhsIvarS `Set.union` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 15, column 17) + _cvi = + emptyCVarIntro { cviLev = _lev } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 36, column 17) + _exprOcvarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 48, column 17) + _exprOintroCVarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 70, column 17) + _lhsOlevOf = + fvsLev _lhsIcvarIntroMp cLevModule _exprIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 14, column 17) + _fvS = + _exprIfvS `Set.difference` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 87, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _patOargMp = + _lhsIargMp + -- copy rule (down) + _patOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _patOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _patOgUniq = + _lhsIgUniq + -- copy rule (down) + _patOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _patOlamS = + _lhsIlamS + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOvarS = + _lhsIvarS + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _exprOgUniq = + _patIgUniq + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _patIcTrf,_patIfldNmL,_patIfvS,_patIgUniq,_patIlevOf,_patInmL) = + pat_ _patOargMp _patOcvarIntroMp _patOfvSCafMp _patOgUniq _patOintroCVarIntroMp _patOlamS _patOlev _patOvarS + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CAltL + fvS : FvS + levOf : Int + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CAltL,FvS,Int,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOfvSCafMp :: FvSMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOfvSCafMp :: FvSMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CAlt + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _tlIcTrf :: CAltL + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevOf) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOevalCtx _hdOfvSCafMp _hdOgUniq _hdOintroCVarIntroMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevOf) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOevalCtx _tlOfvSCafMp _tlOgUniq _tlOintroCVarIntroMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBind + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + lamBindSq : Seq.Seq CBind + levOf : Int + nm : HsName + nmL : [HsName] + varBindSq : Seq.Seq CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + Bool -> + FvS -> + CBindCateg -> + Int -> + FvS -> + ( FvS,FvS,CVarIntroMp,CBind,CVarIntroMp,FvS,FvSMp,Int,(Seq.Seq CBind),Int,HsName,([HsName]),(Seq.Seq CBind)) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsOfvSMp :: FvSMp + _lhsOnmL :: ([HsName]) + _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBind + _lhsOgUniq :: Int + _bindAspectsOargMp :: CVarReplNmMp + _bindAspectsOcvarIntroMp :: CVarIntroMp + _bindAspectsOevalCtx :: EvalCtx + _bindAspectsOfvSCafMp :: FvSMp + _bindAspectsOgUniq :: Int + _bindAspectsOintroCVarIntroMp :: CVarIntroMp + _bindAspectsOisGlobal :: Bool + _bindAspectsOlamS :: FvS + _bindAspectsOletBindingsCateg :: CBindCateg + _bindAspectsOlev :: Int + _bindAspectsOvarS :: FvS + _bindAspectsIbindLamS :: FvS + _bindAspectsIbindVarS :: FvS + _bindAspectsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIcvarIntroExprMp :: CVarIntroMp + _bindAspectsIfvS :: FvS + _bindAspectsIfvSMp :: FvSMp + _bindAspectsIgUniq :: Int + _bindAspectsIlamBindSq :: (Seq.Seq CBind) + _bindAspectsIlevOf :: Int + _bindAspectsInmL :: ([HsName]) + _bindAspectsIvarBindSq :: (Seq.Seq CBind) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 11, column 17) + _lhsOfvSMp = + Map.singleton nm_ _bindAspectsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 19, column 17) + _lhsOnmL = + [nm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _bindAspectsIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _bindAspectsIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _bindAspectsIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _bindAspectsIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindAspectsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + _bindAspectsIlamBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindAspectsIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + _bindAspectsIvarBindSq + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindAspectsIgUniq + -- copy rule (down) + _bindAspectsOargMp = + _lhsIargMp + -- copy rule (down) + _bindAspectsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindAspectsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindAspectsOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _bindAspectsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindAspectsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOlamS = + _lhsIlamS + -- copy rule (down) + _bindAspectsOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOvarS = + _lhsIvarS + ( _bindAspectsIbindLamS,_bindAspectsIbindVarS,_bindAspectsIbindsIntroCVarIntroMp,_bindAspectsIcTrf,_bindAspectsIcvarIntroExprMp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsIgUniq,_bindAspectsIlamBindSq,_bindAspectsIlevOf,_bindAspectsInmL,_bindAspectsIvarBindSq) = + bindAspects_ _bindAspectsOargMp _bindAspectsOcvarIntroMp _bindAspectsOevalCtx _bindAspectsOfvSCafMp _bindAspectsOgUniq _bindAspectsOintroCVarIntroMp _bindAspectsOisGlobal _bindAspectsOlamS _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOvarS + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnm,_lhsOnmL,_lhsOvarBindSq))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CBindAnn,FvS,Int,Int,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CBindAnnL,FvS,Int,Int,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOfvSCafMp :: FvSMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOfvSCafMp :: FvSMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CBindAnn + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CBindAnnL + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevOf,_hdInmL) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOfvSCafMp _hdOgUniq _hdOintroCVarIntroMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOfvSCafMp _tlOgUniq _tlOintroCVarIntroMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBindL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + lamBindSq : Seq.Seq CBind + levOf : Int + nmL : [HsName] + varBindSq : Seq.Seq CBind + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + Bool -> + FvS -> + CBindCateg -> + Int -> + FvS -> + ( FvS,FvS,CVarIntroMp,CBindL,CVarIntroMp,FvS,FvSMp,Int,(Seq.Seq CBind),Int,([HsName]),(Seq.Seq CBind)) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBindL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOfvSCafMp :: FvSMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlamS :: FvS + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOfvSCafMp :: FvSMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlamS :: FvS + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOvarS :: FvS + _hdIbindLamS :: FvS + _hdIbindVarS :: FvS + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBind + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: Int + _hdIlamBindSq :: (Seq.Seq CBind) + _hdIlevOf :: Int + _hdInm :: HsName + _hdInmL :: ([HsName]) + _hdIvarBindSq :: (Seq.Seq CBind) + _tlIbindLamS :: FvS + _tlIbindVarS :: FvS + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBindL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: Int + _tlIlamBindSq :: (Seq.Seq CBind) + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + _tlIvarBindSq :: (Seq.Seq CBind) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _hdIbindLamS `Set.union` _tlIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _hdIbindVarS `Set.union` _tlIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + _hdIlamBindSq `Seq.union` _tlIlamBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + _hdIvarBindSq `Seq.union` _tlIvarBindSq + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIbindLamS,_hdIbindVarS,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIlamBindSq,_hdIlevOf,_hdInm,_hdInmL,_hdIvarBindSq) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOevalCtx _hdOfvSCafMp _hdOgUniq _hdOintroCVarIntroMp _hdOisGlobal _hdOlamS _hdOletBindingsCateg _hdOlev _hdOvarS + ( _tlIbindLamS,_tlIbindVarS,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIlamBindSq,_tlIlevOf,_tlInmL,_tlIvarBindSq) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOevalCtx _tlOfvSCafMp _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOlamS _tlOletBindingsCateg _tlOlev _tlOvarS + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBindL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBound + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + lamBindSq : Seq.Seq CBind + levOf : Int + nmL : [HsName] + varBindSq : Seq.Seq CBind + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local isClosurableBind : _ + local _tup1 : _ + local cmetaVal : _ + local cvi : _ + local cviExpr : _ + local whatAbove : {WhatExpr} + local lUniq1 : _ + local lUniq2 : _ + local _tup2 : _ + local argOldL : _ + local argNewL : _ + local argMpNew : _ + local nmLam : _ + local cTrfVar : _ + local cTrfLam : _ + local _tup3 : _ + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + Bool -> + Bool -> + Bool -> + FvS -> + CBindCateg -> + Int -> + HsName -> + FvS -> + ( FvS,FvS,CVarIntroMp,CBound,CVarIntroMp,FvS,FvSMp,Int,(Seq.Seq CBind),Int,([HsName]),(Seq.Seq CBind)) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindVarS :: FvS + _lhsObindLamS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _bindMetaOargMp :: CVarReplNmMp + _bindMetaOcvarIntroMp :: CVarIntroMp + _bindMetaOfvSCafMp :: FvSMp + _bindMetaOgUniq :: Int + _bindMetaOintroCVarIntroMp :: CVarIntroMp + _bindMetaOlamS :: FvS + _bindMetaOlev :: Int + _bindMetaOvarS :: FvS + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _bindMetaIcTrf :: CMetas + _bindMetaIfvS :: FvS + _bindMetaIgUniq :: Int + _bindMetaIlevOf :: Int + _bindMetaIself :: CMetas + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 34, column 17) + _isClosurableBind = + ( _lhsIletBindingsCateg /= CBindCateg_Strict + && _exprIisClosurableExpr + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + __tup1 = + if isJust _exprImbLam + then (Set.empty,Set.singleton _lhsInm) + else (Set.singleton _lhsInm,Set.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + (_lhsObindVarS,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + (_,_lhsObindLamS) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cmetaVal = + cmetasVal _bindMetaIself + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cvi = + emptyCVarIntro { cviLev = _lhsIlev , cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cviExpr = + emptyCVarIntro { cviLev = _exprIlevOf, cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 53, column 17) + _lhsObindsIntroCVarIntroMp = + Map.singleton _lhsInm _cvi + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 75, column 17) + _lhsOcvarIntroExprMp = + Map.singleton _lhsInm _cviExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 63, column 17) + _lUniq1 = + _lhsIgUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 63, column 17) + _lUniq2 = + _lUniq1 + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 65, column 17) + _exprOgUniq = + _lUniq2 + Map.size _argMpNew + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 90, column 17) + _exprOargMp = + _argMpNew `Map.union` _lhsIargMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 93, column 33) + __tup2 = + if _isClosurableBind + then let mbvs = Map.lookup _lhsInm _lhsIfvSCafMp + vs = panicJust ("CAFGlobalAsArg.CBind.Bind.argLevL: " ++ show _lhsInm ++ " not found in " ++ show _lhsIfvSCafMp) mbvs + argLevL = fvLAsArg _lhsIintroCVarIntroMp vs + in fvLArgRepl _lUniq2 argLevL + else ([], [], Map.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 93, column 33) + (_argOldL,_,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 93, column 33) + (_,_argNewL,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 93, column 33) + (_,_,_argMpNew) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 106, column 17) + _nmLam = + mkFvNm _lUniq1 _lhsInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 106, column 17) + _cTrfVar = + acoreBind1MetasTy _lhsInm _bindMetaIcTrf (acoreTyErr "CAFGlobalAsArg.CBound.Bind.cTrfVar") + $ acoreApp (acoreVar _nmLam) + $ map (\(n,cvi) -> (fvVarRepl _lhsIargMp n)) _argOldL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 106, column 17) + _cTrfLam = + acoreBind1CatTy CBindCateg_Plain _nmLam (acoreTyErr "CAFGlobalAsArg.CBound.Bind.cTrfLam") + $ acoreLam [(n) | (n,cvi) <- _argNewL] _exprIcTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 112, column 33) + __tup3 = + if null _argNewL + then (Seq.singleton (acoreBind1Asp1 _lhsInm _cTrf ) , Seq.empty ) + else (Seq.singleton _cTrfVar , Seq.singleton _cTrfLam) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 112, column 33) + (_lhsOvarBindSq,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 112, column 33) + (_,_lhsOlamBindSq) = + __tup3 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindMetaIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindMetaIlevOf `max` _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _bindMetaOargMp = + _lhsIargMp + -- copy rule (down) + _bindMetaOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindMetaOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _bindMetaOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindMetaOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindMetaOlamS = + _lhsIlamS + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (down) + _bindMetaOvarS = + _lhsIvarS + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIgUniq,_bindMetaIlevOf,_bindMetaIself) = + bindMeta_ _bindMetaOargMp _bindMetaOcvarIntroMp _bindMetaOfvSCafMp _bindMetaOgUniq _bindMetaOintroCVarIntroMp _bindMetaOlamS _bindMetaOlev _bindMetaOvarS + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _cmetasOargMp :: CVarReplNmMp + _cmetasOcvarIntroMp :: CVarIntroMp + _cmetasOfvSCafMp :: FvSMp + _cmetasOgUniq :: Int + _cmetasOintroCVarIntroMp :: CVarIntroMp + _cmetasOlamS :: FvS + _cmetasOlev :: Int + _cmetasOvarS :: FvS + _cmetasIcTrf :: CMetas + _cmetasIfvS :: FvS + _cmetasIgUniq :: Int + _cmetasIlevOf :: Int + _cmetasIself :: CMetas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _cmetasIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _cmetasIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _cmetasIgUniq + -- copy rule (down) + _cmetasOargMp = + _lhsIargMp + -- copy rule (down) + _cmetasOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _cmetasOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _cmetasOgUniq = + _lhsIgUniq + -- copy rule (down) + _cmetasOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _cmetasOlamS = + _lhsIlamS + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOvarS = + _lhsIvarS + ( _cmetasIcTrf,_cmetasIfvS,_cmetasIgUniq,_cmetasIlevOf,_cmetasIself) = + cmetas_ _cmetasOargMp _cmetasOcvarIntroMp _cmetasOfvSCafMp _cmetasOgUniq _cmetasOintroCVarIntroMp _cmetasOlamS _cmetasOlev _cmetasOvarS + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _whatAbove :: WhatExpr + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 81, column 17) + _whatAbove = + ExprIsLam 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 118, column 17) + _lhsOvarBindSq = + Seq.singleton (acoreBind1Asp1 _lhsInm _cTrf) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBoundL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + lamBindSq : Seq.Seq CBind + levOf : Int + nmL : [HsName] + varBindSq : Seq.Seq CBind + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + Bool -> + FvS -> + CBindCateg -> + Int -> + HsName -> + FvS -> + ( FvS,FvS,CVarIntroMp,CBoundL,CVarIntroMp,FvS,FvSMp,Int,(Seq.Seq CBind),Int,([HsName]),(Seq.Seq CBind)) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _hdOisTopApp :: Bool + _hdOisTopTup :: Bool + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOfvSCafMp :: FvSMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlamS :: FvS + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOnm :: HsName + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOfvSCafMp :: FvSMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlamS :: FvS + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOnm :: HsName + _tlOvarS :: FvS + _hdIbindLamS :: FvS + _hdIbindVarS :: FvS + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBound + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: Int + _hdIlamBindSq :: (Seq.Seq CBind) + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _hdIvarBindSq :: (Seq.Seq CBind) + _tlIbindLamS :: FvS + _tlIbindVarS :: FvS + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBoundL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: Int + _tlIlamBindSq :: (Seq.Seq CBind) + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + _tlIvarBindSq :: (Seq.Seq CBind) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopTup = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _hdIbindLamS `Set.union` _tlIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _hdIbindVarS `Set.union` _tlIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + _hdIlamBindSq `Seq.union` _tlIlamBindSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + _hdIvarBindSq `Seq.union` _tlIvarBindSq + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIbindLamS,_hdIbindVarS,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIlamBindSq,_hdIlevOf,_hdInmL,_hdIvarBindSq) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOevalCtx _hdOfvSCafMp _hdOgUniq _hdOintroCVarIntroMp _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOlamS _hdOletBindingsCateg _hdOlev _hdOnm _hdOvarS + ( _tlIbindLamS,_tlIbindVarS,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIlamBindSq,_tlIlevOf,_tlInmL,_tlIvarBindSq) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOevalCtx _tlOfvSCafMp _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOlamS _tlOletBindingsCateg _tlOlev _tlOnm _tlOvarS + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlamBindSq :: (Seq.Seq CBind) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOvarBindSq :: (Seq.Seq CBind) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 102, column 32) + _lhsOlamBindSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 101, column 32) + _lhsOvarBindSq = + Seq.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlamBindSq,_lhsOlevOf,_lhsOnmL,_lhsOvarBindSq))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + isTopApp : Bool + isTopTup : Bool + lamS : FvS + lev : Int + varS : FvS + whatAbove : WhatExpr + chained attribute: + gUniq : Int + synthesized attributes: + appFunKind : AppFunKind + cTrf : CExpr + fvS : FvS + isClosurableExpr : Bool + levOf : Int + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local mbVar : {Maybe HsName} + local nm : {HsName} + local nmAsp : {HsName} + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local varS : _ + local lamS : _ + local maxBindLev : _ + local _tup4 : _ + local strLev : _ + local introCVarIntroMp : _ + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLet : _ + local evalCtx : _ + local isGlobal : _ + local fvSCafMp : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopApp' : _ + local isGlobal : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local varS : _ + local cvi : _ + local levOf : _ + local fvS : _ + local argNm : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLam : _ + local lev : _ + local isGlobal : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CoeArg: + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + FvSMp -> + Int -> + CVarIntroMp -> + Bool -> + Bool -> + FvS -> + Int -> + FvS -> + WhatExpr -> + ( AppFunKind,CExpr,FvS,Int,Bool,Int,(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _mbVar :: (Maybe HsName) + _lhsOlevOf :: Int + _lhsOfvS :: FvS + _nm :: HsName + _nmAsp :: HsName + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 13, column 17) + _lhsOappFunKind = + AppFunKind_Fun ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 21, column 17) + _mbVar = + Just _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 59, column 17) + _lhsOlevOf = + fvLev _nm _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 7, column 17) + _lhsOfvS = + Set.singleton _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 52, column 17) + _whatBelow = + ExprIsVar _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 121, column 17) + _lhsOcTrf = + fvVarRepl _lhsIargMp _nm + -- self rule + _cTrf = + CExpr_Var ref_ + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOmbVar = + _mbVar + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 53, column 17) + _whatBelow = + ExprIsInt int_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 67, column 17) + _levOf = + cLevIntern + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 11, column 17) + _lhsOappFunKind = + AppFunKind_Tag tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 55, column 25) + _whatBelow = + ExprIsTup tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _bindsOlev :: Int + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _bindsOcvarIntroMp :: CVarIntroMp + _bodyOcvarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOcTrf :: CExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindsOargMp :: CVarReplNmMp + _bindsOevalCtx :: EvalCtx + _bindsOfvSCafMp :: FvSMp + _bindsOgUniq :: Int + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOisGlobal :: Bool + _bindsOlamS :: FvS + _bindsOletBindingsCateg :: CBindCateg + _bindsOvarS :: FvS + _bodyOargMp :: CVarReplNmMp + _bodyOevalCtx :: EvalCtx + _bodyOfvSCafMp :: FvSMp + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bindsIbindLamS :: FvS + _bindsIbindVarS :: FvS + _bindsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindsIcTrf :: CBindL + _bindsIcvarIntroExprMp :: CVarIntroMp + _bindsIfvS :: FvS + _bindsIfvSMp :: FvSMp + _bindsIgUniq :: Int + _bindsIlamBindSq :: (Seq.Seq CBind) + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + _bindsIvarBindSq :: (Seq.Seq CBind) + _bodyIappFunKind :: AppFunKind + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIisClosurableExpr :: Bool + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 10, column 17) + _lhsOisClosurableExpr = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLet.ag"(line 2, column 17) + _bindsOlev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 18, column 17) + _varS = + _lhsIvarS `Set.union` _bindsIbindVarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 18, column 17) + _lamS = + _lhsIlamS `Set.union` _bindsIbindLamS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 24, column 17) + _maxBindLev = + fvsLev _lhsIcvarIntroMp cLevModule _bindsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + __tup4 = + case categ_ of + CBindCateg_Strict -> (const _lhsIlev,_lhsIcvarIntroMp) + CBindCateg_Rec -> ( const _maxBindLev + , Map.map (\cvi -> cvi {cviLev = _maxBindLev}) _bindsIcvarIntroExprMp + `Map.union` _lhsIcvarIntroMp + ) + _ -> (id,_lhsIcvarIntroMp) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_strLev,_) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_,_bindsOcvarIntroMp) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 33, column 17) + _bodyOcvarIntroMp = + Map.map (\cvi -> cvi {cviLev = _strLev $ cviLev cvi}) _bindsIcvarIntroExprMp `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 45, column 17) + _introCVarIntroMp = + Map.map (\cvi -> cvi {cviLev = _lhsIlev}) _bindsIbindsIntroCVarIntroMp `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 66, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _fvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 6, column 17) + _fvS = + (_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 4, column 17) + _letBindingsCateg = + categ_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 75, column 17) + _isTopLet = + _lhsIwhatAbove == ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, column 17) + _evalCtx = + if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 74, column 17) + _fvSCafMp = + (let start varS = fvsClosure _bindsIbindVarS Set.empty varS _lhsIfvSCafMp _bindsIfvSMp + in case categ_ of + CBindCateg_Rec + -> fvsTransClosure lm m + where (m,lm) = start (_lhsIvarS `Set.union` _bindsIbindVarS) + _ -> m + where (m,_) = start _lhsIvarS + ) + `Map.union` _lhsIfvSCafMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 122, column 17) + _lhsOcTrf = + acoreLet CBindCateg_Plain (Seq.toList _bindsIlamBindSq) + $ acoreLet categ_ (Seq.toList _bindsIvarBindSq) + $ _bodyIcTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindsOargMp = + _lhsIargMp + -- copy rule (from local) + _bindsOevalCtx = + _evalCtx + -- copy rule (from local) + _bindsOfvSCafMp = + _fvSCafMp + -- copy rule (down) + _bindsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bindsOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (from local) + _bindsOlamS = + _lamS + -- copy rule (from local) + _bindsOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindsOvarS = + _varS + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (from local) + _bodyOevalCtx = + _evalCtx + -- copy rule (from local) + _bodyOfvSCafMp = + _fvSCafMp + -- copy rule (chain) + _bodyOgUniq = + _bindsIgUniq + -- copy rule (from local) + _bodyOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlamS = + _lamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (from local) + _bodyOvarS = + _varS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindsIbindLamS,_bindsIbindVarS,_bindsIbindsIntroCVarIntroMp,_bindsIcTrf,_bindsIcvarIntroExprMp,_bindsIfvS,_bindsIfvSMp,_bindsIgUniq,_bindsIlamBindSq,_bindsIlevOf,_bindsInmL,_bindsIvarBindSq) = + binds_ _bindsOargMp _bindsOcvarIntroMp _bindsOevalCtx _bindsOfvSCafMp _bindsOgUniq _bindsOintroCVarIntroMp _bindsOisGlobal _bindsOlamS _bindsOletBindingsCateg _bindsOlev _bindsOvarS + ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIisClosurableExpr,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOfvSCafMp _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamS _bodyOlev _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _argOnm :: HsName + _funcOisTopApp :: Bool + _argOisTopApp :: Bool + _whatAbove :: WhatExpr + _argOevalCtx :: EvalCtx + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOargMp :: CVarReplNmMp + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOfvSCafMp :: FvSMp + _funcOgUniq :: Int + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisTopTup :: Bool + _funcOlamS :: FvS + _funcOlev :: Int + _funcOvarS :: FvS + _funcOwhatAbove :: WhatExpr + _argOargMp :: CVarReplNmMp + _argOcvarIntroMp :: CVarIntroMp + _argOfvSCafMp :: FvSMp + _argOgUniq :: Int + _argOintroCVarIntroMp :: CVarIntroMp + _argOisGlobal :: Bool + _argOisTopTup :: Bool + _argOlamS :: FvS + _argOletBindingsCateg :: CBindCateg + _argOlev :: Int + _argOvarS :: FvS + _funcIappFunKind :: AppFunKind + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIgUniq :: Int + _funcIisClosurableExpr :: Bool + _funcIlevOf :: Int + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIwhatBelow :: WhatExpr + _argIbindLamS :: FvS + _argIbindVarS :: FvS + _argIbindsIntroCVarIntroMp :: CVarIntroMp + _argIcTrf :: CBound + _argIcvarIntroExprMp :: CVarIntroMp + _argIfvS :: FvS + _argIfvSMp :: FvSMp + _argIgUniq :: Int + _argIlamBindSq :: (Seq.Seq CBind) + _argIlevOf :: Int + _argInmL :: ([HsName]) + _argIvarBindSq :: (Seq.Seq CBind) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 30, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 14, column 17) + _lhsOappFunKind = + _funcIappFunKind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 60, column 17) + _levOf = + _funcIlevOf `max` _argIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 8, column 17) + _fvS = + _funcIfvS `Set.union` _argIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 14, column 17) + _funcOisTopApp = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 15, column 17) + _argOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 54, column 17) + _whatBelow = + maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 70, column 17) + _whatAbove = + maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 77, column 17) + _isTopApp' = + isNothing $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 112, column 17) + _argOevalCtx = + EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _argIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOargMp = + _lhsIargMp + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamS = + _lhsIlamS + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOvarS = + _lhsIvarS + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (down) + _argOargMp = + _lhsIargMp + -- copy rule (down) + _argOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _argOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _argOgUniq = + _funcIgUniq + -- copy rule (down) + _argOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (from local) + _argOisTopTup = + _isTopTup + -- copy rule (down) + _argOlamS = + _lhsIlamS + -- copy rule (from local) + _argOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOvarS = + _lhsIvarS + ( _funcIappFunKind,_funcIcTrf,_funcIfvS,_funcIgUniq,_funcIisClosurableExpr,_funcIlevOf,_funcImbLam,_funcImbVar,_funcIwhatBelow) = + func_ _funcOargMp _funcOcvarIntroMp _funcOevalCtx _funcOfvSCafMp _funcOgUniq _funcOintroCVarIntroMp _funcOisTopApp _funcOisTopTup _funcOlamS _funcOlev _funcOvarS _funcOwhatAbove + ( _argIbindLamS,_argIbindVarS,_argIbindsIntroCVarIntroMp,_argIcTrf,_argIcvarIntroExprMp,_argIfvS,_argIfvSMp,_argIgUniq,_argIlamBindSq,_argIlevOf,_argInmL,_argIvarBindSq) = + arg_ _argOargMp _argOcvarIntroMp _argOevalCtx _argOfvSCafMp _argOgUniq _argOintroCVarIntroMp _argOisGlobal _argOisTopApp _argOisTopTup _argOlamS _argOletBindingsCateg _argOlev _argOnm _argOvarS + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindOargMp :: CVarReplNmMp + _bindOcvarIntroMp :: CVarIntroMp + _bindOevalCtx :: EvalCtx + _bindOfvSCafMp :: FvSMp + _bindOgUniq :: Int + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOisGlobal :: Bool + _bindOlamS :: FvS + _bindOletBindingsCateg :: CBindCateg + _bindOlev :: Int + _bindOvarS :: FvS + _bodyOargMp :: CVarReplNmMp + _bodyOevalCtx :: EvalCtx + _bodyOfvSCafMp :: FvSMp + _bodyOgUniq :: Int + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bindIbindLamS :: FvS + _bindIbindVarS :: FvS + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: Int + _bindIlamBindSq :: (Seq.Seq CBind) + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bindIvarBindSq :: (Seq.Seq CBind) + _bodyIappFunKind :: AppFunKind + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIisClosurableExpr :: Bool + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 4, column 17) + _lhsOmbLam = + Just $ maybe [_argNm] (_argNm:) _bodyImbLam + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 20, column 17) + _varS = + _argNm `Set.insert` _lhsIvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 4, column 17) + _cvi = + CVarIntro + { cviLev = _lev + , cviMeta = CMetaVal_Val + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 23, column 17) + _bodyOcvarIntroMp = + Map.insert _argNm _cvi _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 44, column 17) + _bodyOintroCVarIntroMp = + Map.insert _argNm _cvi _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 65, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 5, column 17) + _fvS = + _argNm `Set.delete` _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 51, column 17) + _whatBelow = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) + _whatAbove = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 76, column 17) + _isTopLam = + not $ whatExprIsLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindOargMp = + _lhsIargMp + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _bindOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (down) + _bindOlamS = + _lhsIlamS + -- copy rule (from local) + _bindOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (from local) + _bindOvarS = + _varS + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _bodyOgUniq = + _bindIgUniq + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (from local) + _bodyOvarS = + _varS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindIbindLamS,_bindIbindVarS,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlamBindSq,_bindIlevOf,_bindInm,_bindInmL,_bindIvarBindSq) = + bind_ _bindOargMp _bindOcvarIntroMp _bindOevalCtx _bindOfvSCafMp _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOlamS _bindOletBindingsCateg _bindOlev _bindOvarS + ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIisClosurableExpr,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOfvSCafMp _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamS _bodyOlev _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _altsOargMp :: CVarReplNmMp + _altsOcvarIntroMp :: CVarIntroMp + _altsOevalCtx :: EvalCtx + _altsOfvSCafMp :: FvSMp + _altsOgUniq :: Int + _altsOintroCVarIntroMp :: CVarIntroMp + _altsOlamS :: FvS + _altsOlev :: Int + _altsOvarS :: FvS + _dfltOargMp :: CVarReplNmMp + _dfltOcvarIntroMp :: CVarIntroMp + _dfltOevalCtx :: EvalCtx + _dfltOfvSCafMp :: FvSMp + _dfltOgUniq :: Int + _dfltOintroCVarIntroMp :: CVarIntroMp + _dfltOisTopApp :: Bool + _dfltOisTopTup :: Bool + _dfltOlamS :: FvS + _dfltOlev :: Int + _dfltOvarS :: FvS + _dfltOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _altsIcTrf :: CAltL + _altsIfvS :: FvS + _altsIgUniq :: Int + _altsIlevOf :: Int + _dfltIappFunKind :: AppFunKind + _dfltIcTrf :: CExpr + _dfltIfvS :: FvS + _dfltIgUniq :: Int + _dfltIisClosurableExpr :: Bool + _dfltIlevOf :: Int + _dfltImbLam :: (Maybe [HsName]) + _dfltImbVar :: (Maybe HsName) + _dfltIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 10, column 17) + _lhsOisClosurableExpr = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 61, column 17) + _levOf = + _exprIlevOf `max` _altsIlevOf `max` _dfltIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _dfltIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOisTopTup = + _isTopTup + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _altsOargMp = + _lhsIargMp + -- copy rule (down) + _altsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _altsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _altsOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _altsOgUniq = + _exprIgUniq + -- copy rule (down) + _altsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _altsOlamS = + _lhsIlamS + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOvarS = + _lhsIvarS + -- copy rule (down) + _dfltOargMp = + _lhsIargMp + -- copy rule (down) + _dfltOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _dfltOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _dfltOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _dfltOgUniq = + _altsIgUniq + -- copy rule (down) + _dfltOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _dfltOisTopApp = + _isTopApp + -- copy rule (from local) + _dfltOisTopTup = + _isTopTup + -- copy rule (down) + _dfltOlamS = + _lhsIlamS + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOvarS = + _lhsIvarS + -- copy rule (from local) + _dfltOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + ( _altsIcTrf,_altsIfvS,_altsIgUniq,_altsIlevOf) = + alts_ _altsOargMp _altsOcvarIntroMp _altsOevalCtx _altsOfvSCafMp _altsOgUniq _altsOintroCVarIntroMp _altsOlamS _altsOlev _altsOvarS + ( _dfltIappFunKind,_dfltIcTrf,_dfltIfvS,_dfltIgUniq,_dfltIisClosurableExpr,_dfltIlevOf,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) = + dflt_ _dfltOargMp _dfltOcvarIntroMp _dfltOevalCtx _dfltOfvSCafMp _dfltOgUniq _dfltOintroCVarIntroMp _dfltOisTopApp _dfltOisTopTup _dfltOlamS _dfltOlev _dfltOvarS _dfltOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOgUniq :: Int + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + _errorExprOargMp :: CVarReplNmMp + _errorExprOcvarIntroMp :: CVarIntroMp + _errorExprOevalCtx :: EvalCtx + _errorExprOfvSCafMp :: FvSMp + _errorExprOgUniq :: Int + _errorExprOintroCVarIntroMp :: CVarIntroMp + _errorExprOisTopApp :: Bool + _errorExprOisTopTup :: Bool + _errorExprOlamS :: FvS + _errorExprOlev :: Int + _errorExprOvarS :: FvS + _errorExprOwhatAbove :: WhatExpr + _errorExprIappFunKind :: AppFunKind + _errorExprIcTrf :: CExpr + _errorExprIfvS :: FvS + _errorExprIgUniq :: Int + _errorExprIisClosurableExpr :: Bool + _errorExprIlevOf :: Int + _errorExprImbLam :: (Maybe [HsName]) + _errorExprImbVar :: (Maybe HsName) + _errorExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _errorExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _errorExprIlevOf + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappFunKind = + _errorExprIappFunKind + -- copy rule (up) + _lhsOgUniq = + _errorExprIgUniq + -- copy rule (up) + _lhsOmbLam = + _errorExprImbLam + -- copy rule (up) + _lhsOmbVar = + _errorExprImbVar + -- copy rule (up) + _lhsOwhatBelow = + _errorExprIwhatBelow + -- copy rule (down) + _errorExprOargMp = + _lhsIargMp + -- copy rule (down) + _errorExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _errorExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _errorExprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _errorExprOgUniq = + _lhsIgUniq + -- copy rule (down) + _errorExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _errorExprOisTopApp = + _isTopApp + -- copy rule (from local) + _errorExprOisTopTup = + _isTopTup + -- copy rule (down) + _errorExprOlamS = + _lhsIlamS + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOvarS = + _lhsIvarS + -- copy rule (from local) + _errorExprOwhatAbove = + _whatAbove + ( _errorExprIappFunKind,_errorExprIcTrf,_errorExprIfvS,_errorExprIgUniq,_errorExprIisClosurableExpr,_errorExprIlevOf,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) = + errorExpr_ _errorExprOargMp _errorExprOcvarIntroMp _errorExprOevalCtx _errorExprOfvSCafMp _errorExprOgUniq _errorExprOintroCVarIntroMp _errorExprOisTopApp _errorExprOisTopTup _errorExprOlamS _errorExprOlev _errorExprOvarS _errorExprOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOfvSCafMp :: FvSMp + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIisClosurableExpr :: Bool + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 10, column 17) + _lhsOisClosurableExpr = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 62, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _offsetIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIisClosurableExpr,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOfvSCafMp _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamS _offsetOlev _offsetOvarS _offsetOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOfvSCafMp :: FvSMp + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _fldExprOargMp :: CVarReplNmMp + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOfvSCafMp :: FvSMp + _fldExprOgUniq :: Int + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamS :: FvS + _fldExprOlev :: Int + _fldExprOvarS :: FvS + _fldExprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIisClosurableExpr :: Bool + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIgUniq :: Int + _fldExprIisClosurableExpr :: Bool + _fldExprIlevOf :: Int + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 10, column 17) + _lhsOisClosurableExpr = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOargMp = + _lhsIargMp + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _fldExprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamS = + _lhsIlamS + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOvarS = + _lhsIvarS + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIisClosurableExpr,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOfvSCafMp _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamS _offsetOlev _offsetOvarS _offsetOwhatAbove + ( _fldExprIappFunKind,_fldExprIcTrf,_fldExprIfvS,_fldExprIgUniq,_fldExprIisClosurableExpr,_fldExprIlevOf,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) = + fldExpr_ _fldExprOargMp _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOfvSCafMp _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamS _fldExprOlev _fldExprOvarS _fldExprOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOfvSCafMp :: FvSMp + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _fldExprOargMp :: CVarReplNmMp + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOfvSCafMp :: FvSMp + _fldExprOgUniq :: Int + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamS :: FvS + _fldExprOlev :: Int + _fldExprOvarS :: FvS + _fldExprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIisClosurableExpr :: Bool + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIgUniq :: Int + _fldExprIisClosurableExpr :: Bool + _fldExprIlevOf :: Int + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 10, column 17) + _lhsOisClosurableExpr = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _offsetOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOargMp = + _lhsIargMp + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _fldExprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamS = + _lhsIlamS + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOvarS = + _lhsIvarS + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIisClosurableExpr,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOfvSCafMp _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamS _offsetOlev _offsetOvarS _offsetOwhatAbove + ( _fldExprIappFunKind,_fldExprIcTrf,_fldExprIfvS,_fldExprIgUniq,_fldExprIisClosurableExpr,_fldExprIlevOf,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) = + fldExpr_ _fldExprOargMp _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOfvSCafMp _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamS _fldExprOlev _fldExprOvarS _fldExprOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 12, column 17) + _lhsOappFunKind = + AppFunKind_FFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 56, column 25) + _whatBelow = + ExprIsFFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOargMp :: CVarReplNmMp + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOfvSCafMp :: FvSMp + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bodyIappFunKind :: AppFunKind + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIisClosurableExpr :: Bool + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOvarS = + _lhsIvarS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIisClosurableExpr,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOfvSCafMp _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamS _bodyOlev _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOargMp :: CVarReplNmMp + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOfvSCafMp :: FvSMp + _funcOgUniq :: Int + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisTopApp :: Bool + _funcOisTopTup :: Bool + _funcOlamS :: FvS + _funcOlev :: Int + _funcOvarS :: FvS + _funcOwhatAbove :: WhatExpr + _funcIappFunKind :: AppFunKind + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIgUniq :: Int + _funcIisClosurableExpr :: Bool + _funcIlevOf :: Int + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _funcIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _funcIlevOf + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _funcIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOargMp = + _lhsIargMp + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _funcOisTopApp = + _isTopApp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamS = + _lhsIlamS + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOvarS = + _lhsIvarS + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + ( _funcIappFunKind,_funcIcTrf,_funcIfvS,_funcIgUniq,_funcIisClosurableExpr,_funcIlevOf,_funcImbLam,_funcImbVar,_funcIwhatBelow) = + func_ _funcOargMp _funcOcvarIntroMp _funcOevalCtx _funcOfvSCafMp _funcOgUniq _funcOintroCVarIntroMp _funcOisTopApp _funcOisTopTup _funcOlamS _funcOlev _funcOvarS _funcOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOargMp :: CVarReplNmMp + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOfvSCafMp :: FvSMp + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bodyIappFunKind :: AppFunKind + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIisClosurableExpr :: Bool + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFloat.ag"(line 27, column 17) + _lhsOisClosurableExpr = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOvarS = + _lhsIvarS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyIgUniq,_bodyIisClosurableExpr,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOfvSCafMp _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisTopApp _bodyOisTopTup _bodyOlamS _bodyOlev _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamS + _lhsIlev + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOgUniq :: Int + _lhsOisClosurableExpr :: Bool + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + _annOargMp :: CVarReplNmMp + _annOcvarIntroMp :: CVarIntroMp + _annOfvSCafMp :: FvSMp + _annOgUniq :: Int + _annOintroCVarIntroMp :: CVarIntroMp + _annOlamS :: FvS + _annOlev :: Int + _annOvarS :: FvS + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _annIcTrf :: CExprAnn + _annIfvS :: FvS + _annIgUniq :: Int + _annIlevOf :: Int + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _annIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _annIlevOf `max` _exprIlevOf + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappFunKind = + _exprIappFunKind + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOisClosurableExpr = + _exprIisClosurableExpr + -- copy rule (up) + _lhsOmbLam = + _exprImbLam + -- copy rule (up) + _lhsOmbVar = + _exprImbVar + -- copy rule (up) + _lhsOwhatBelow = + _exprIwhatBelow + -- copy rule (down) + _annOargMp = + _lhsIargMp + -- copy rule (down) + _annOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _annOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _annOgUniq = + _lhsIgUniq + -- copy rule (down) + _annOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _annOlamS = + _lhsIlamS + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOvarS = + _lhsIvarS + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _exprOgUniq = + _annIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (down) + _exprOwhatAbove = + _lhsIwhatAbove + ( _annIcTrf,_annIfvS,_annIgUniq,_annIlevOf) = + ann_ _annOargMp _annOcvarIntroMp _annOfvSCafMp _annOgUniq _annOintroCVarIntroMp _annOlamS _annOlev _annOvarS + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisClosurableExpr,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + levOf : Int + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CExprAnn,FvS,Int,Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + levOf : Int + self : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + local self : _ + alternative Function0: + visit 0: + local cTrf : _ + local self : _ + alternative Function1: + visit 0: + local cTrf : _ + local self : _ + alternative Apply0: + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CMetaBind,FvS,Int,Int,CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _self = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _self = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _self = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _self = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + levOf : Int + self : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + local self : _ + alternative Dict: + visit 0: + local cTrf : _ + local self : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CMetaVal,FvS,Int,Int,CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _self = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _self = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _self = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _self = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _self = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetas + fvS : FvS + levOf : Int + self : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CMetas,FvS,Int,Int,CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetas + _lhsOself :: CMetas + _lhsOgUniq :: Int + _x1OargMp :: CVarReplNmMp + _x1OcvarIntroMp :: CVarIntroMp + _x1OfvSCafMp :: FvSMp + _x1OgUniq :: Int + _x1OintroCVarIntroMp :: CVarIntroMp + _x1OlamS :: FvS + _x1Olev :: Int + _x1OvarS :: FvS + _x2OargMp :: CVarReplNmMp + _x2OcvarIntroMp :: CVarIntroMp + _x2OfvSCafMp :: FvSMp + _x2OgUniq :: Int + _x2OintroCVarIntroMp :: CVarIntroMp + _x2OlamS :: FvS + _x2Olev :: Int + _x2OvarS :: FvS + _x1IcTrf :: CMetaBind + _x1IfvS :: FvS + _x1IgUniq :: Int + _x1IlevOf :: Int + _x1Iself :: CMetaBind + _x2IcTrf :: CMetaVal + _x2IfvS :: FvS + _x2IgUniq :: Int + _x2IlevOf :: Int + _x2Iself :: CMetaVal + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _x1IfvS `Set.union` _x2IfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _x1IlevOf `max` _x2IlevOf + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _self = + (_x1Iself,_x2Iself) + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOgUniq = + _x2IgUniq + -- copy rule (down) + _x1OargMp = + _lhsIargMp + -- copy rule (down) + _x1OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x1OfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _x1OgUniq = + _lhsIgUniq + -- copy rule (down) + _x1OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x1OlamS = + _lhsIlamS + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1OvarS = + _lhsIvarS + -- copy rule (down) + _x2OargMp = + _lhsIargMp + -- copy rule (down) + _x2OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x2OfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _x2OgUniq = + _x1IgUniq + -- copy rule (down) + _x2OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x2OlamS = + _lhsIlamS + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2OvarS = + _lhsIvarS + ( _x1IcTrf,_x1IfvS,_x1IgUniq,_x1IlevOf,_x1Iself) = + x1_ _x1OargMp _x1OcvarIntroMp _x1OfvSCafMp _x1OgUniq _x1OintroCVarIntroMp _x1OlamS _x1Olev _x1OvarS + ( _x2IcTrf,_x2IfvS,_x2IgUniq,_x2IlevOf,_x2Iself) = + x2_ _x2OargMp _x2OcvarIntroMp _x2OfvSCafMp _x2OgUniq _x2OintroCVarIntroMp _x2OlamS _x2Olev _x2OvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CModule + fvS : FvS + levOf : Int + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CModule,FvS,Int,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOevalCtx :: EvalCtx + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CModule + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOfvSCafMp :: FvSMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIappFunKind :: AppFunKind + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIisClosurableExpr :: Bool + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 90, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 99, column 17) + _exprOevalCtx = + EvalCtx_Eval + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprIgUniq,_exprIisClosurableExpr,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOfvSCafMp _exprOgUniq _exprOintroCVarIntroMp _exprOisTopApp _exprOisTopTup _exprOlamS _exprOlev _exprOvarS _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CPat,([HsName]),FvS,Int,Int,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 28, column 17) + _lhsOnmL = + [pnm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + _restOargMp :: CVarReplNmMp + _restOcvarIntroMp :: CVarIntroMp + _restOfvSCafMp :: FvSMp + _restOgUniq :: Int + _restOintroCVarIntroMp :: CVarIntroMp + _restOlamS :: FvS + _restOlev :: Int + _restOvarS :: FvS + _bindsOargMp :: CVarReplNmMp + _bindsOcvarIntroMp :: CVarIntroMp + _bindsOfvSCafMp :: FvSMp + _bindsOgUniq :: Int + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOlamS :: FvS + _bindsOlev :: Int + _bindsOvarS :: FvS + _restIcTrf :: CPatRest + _restIfvS :: FvS + _restIgUniq :: Int + _restIlevOf :: Int + _restInmL :: ([HsName]) + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + _bindsIfvS :: FvS + _bindsIgUniq :: Int + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 29, column 17) + _lhsOnmL = + _restInmL ++ _bindsInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _restIfvS `Set.union` _bindsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _restIlevOf `max` _bindsIlevOf + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindsIgUniq + -- copy rule (down) + _restOargMp = + _lhsIargMp + -- copy rule (down) + _restOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _restOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _restOgUniq = + _lhsIgUniq + -- copy rule (down) + _restOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _restOlamS = + _lhsIlamS + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOvarS = + _lhsIvarS + -- copy rule (down) + _bindsOargMp = + _lhsIargMp + -- copy rule (down) + _bindsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindsOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _bindsOgUniq = + _restIgUniq + -- copy rule (down) + _bindsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindsOlamS = + _lhsIlamS + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOvarS = + _lhsIvarS + ( _restIcTrf,_restIfvS,_restIgUniq,_restIlevOf,_restInmL) = + rest_ _restOargMp _restOcvarIntroMp _restOfvSCafMp _restOgUniq _restOintroCVarIntroMp _restOlamS _restOlev _restOvarS + ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsIgUniq,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOargMp _bindsOcvarIntroMp _bindsOfvSCafMp _bindsOgUniq _bindsOintroCVarIntroMp _bindsOlamS _bindsOlev _bindsOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CPatFld,([HsName]),FvS,Int,Int,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _bindOletBindingsCateg :: CBindCateg + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _whatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _bindOevalCtx :: EvalCtx + _bindOisGlobal :: Bool + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatFld + _lhsOgUniq :: Int + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOfvSCafMp :: FvSMp + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _bindOargMp :: CVarReplNmMp + _bindOcvarIntroMp :: CVarIntroMp + _bindOfvSCafMp :: FvSMp + _bindOgUniq :: Int + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOlamS :: FvS + _bindOlev :: Int + _bindOvarS :: FvS + _fldAnnsOargMp :: CVarReplNmMp + _fldAnnsOcvarIntroMp :: CVarIntroMp + _fldAnnsOfvSCafMp :: FvSMp + _fldAnnsOgUniq :: Int + _fldAnnsOintroCVarIntroMp :: CVarIntroMp + _fldAnnsOlamS :: FvS + _fldAnnsOlev :: Int + _fldAnnsOvarS :: FvS + _offsetIappFunKind :: AppFunKind + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIisClosurableExpr :: Bool + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _bindIbindLamS :: FvS + _bindIbindVarS :: FvS + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: Int + _bindIlamBindSq :: (Seq.Seq CBind) + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bindIvarBindSq :: (Seq.Seq CBind) + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIfvS :: FvS + _fldAnnsIgUniq :: Int + _fldAnnsIlevOf :: Int + _fldAnnsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 22, column 17) + _lhsOnmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 9, column 17) + _bindOletBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 84, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) + _offsetOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 103, column 33) + _bindOevalCtx = + EvalCtx_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _offsetIlevOf `max` _bindIlevOf `max` _fldAnnsIlevOf + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldAnnsIgUniq + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _offsetOgUniq = + _lhsIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _bindOargMp = + _lhsIargMp + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _bindOgUniq = + _offsetIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindOlamS = + _lhsIlamS + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOvarS = + _lhsIvarS + -- copy rule (down) + _fldAnnsOargMp = + _lhsIargMp + -- copy rule (down) + _fldAnnsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldAnnsOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _fldAnnsOgUniq = + _bindIgUniq + -- copy rule (down) + _fldAnnsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldAnnsOlamS = + _lhsIlamS + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOvarS = + _lhsIvarS + ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetIgUniq,_offsetIisClosurableExpr,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOfvSCafMp _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisTopApp _offsetOisTopTup _offsetOlamS _offsetOlev _offsetOvarS _offsetOwhatAbove + ( _bindIbindLamS,_bindIbindVarS,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlamBindSq,_bindIlevOf,_bindInm,_bindInmL,_bindIvarBindSq) = + bind_ _bindOargMp _bindOcvarIntroMp _bindOevalCtx _bindOfvSCafMp _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOlamS _bindOletBindingsCateg _bindOlev _bindOvarS + ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsIgUniq,_fldAnnsIlevOf,_fldAnnsInmL) = + fldAnns_ _fldAnnsOargMp _fldAnnsOcvarIntroMp _fldAnnsOfvSCafMp _fldAnnsOgUniq _fldAnnsOintroCVarIntroMp _fldAnnsOlamS _fldAnnsOlev _fldAnnsOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CPatFldL,([HsName]),FvS,Int,Int,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOfvSCafMp :: FvSMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOfvSCafMp :: FvSMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOfvSCafMp = + _lhsIfvSCafMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdIgUniq,_hdIlevOf,_hdInmL) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOfvSCafMp _hdOgUniq _hdOintroCVarIntroMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlIgUniq,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOfvSCafMp _tlOgUniq _tlOintroCVarIntroMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + fvSCafMp : FvSMp + introCVarIntroMp : CVarIntroMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatRest + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = CVarReplNmMp -> + CVarIntroMp -> + FvSMp -> + Int -> + CVarIntroMp -> + FvS -> + Int -> + FvS -> + ( CPatRest,FvS,Int,Int,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatRest + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 25, column 17) + _lhsOnmL = + [nm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIfvSCafMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatRest + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (let _moduleOvarS :: FvS + _moduleOlamS :: FvS + _moduleOcvarIntroMp :: CVarIntroMp + _moduleOintroCVarIntroMp :: CVarIntroMp + _moduleOlev :: Int + _moduleOgUniq :: Int + _moduleOfvSCafMp :: FvSMp + _moduleOargMp :: CVarReplNmMp + _lhsOcTrf :: CModule + _moduleIcTrf :: CModule + _moduleIfvS :: FvS + _moduleIgUniq :: Int + _moduleIlevOf :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 14, column 17) + _moduleOvarS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 14, column 17) + _moduleOlamS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 20, column 17) + _moduleOcvarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 41, column 17) + _moduleOintroCVarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 60, column 17) + _moduleOgUniq = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 71, column 17) + _moduleOfvSCafMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.ag"(line 87, column 17) + _moduleOargMp = + Map.empty + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + ( _moduleIcTrf,_moduleIfvS,_moduleIgUniq,_moduleIlevOf) = + module_ _moduleOargMp _moduleOcvarIntroMp _moduleOfvSCafMp _moduleOgUniq _moduleOintroCVarIntroMp _moduleOlamS _moduleOlev _moduleOvarS + in ( _lhsOcTrf)) diff --git a/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs b/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs @@ -0,0 +1,2794 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Const) +module UHC.Light.Compiler.Core.Trf.ConstProp(cmodTrfConstProp) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import Data.Maybe + + + + + + + + + +cmodTrfConstProp :: EHCOpts -> CModule -> CModule +cmodTrfConstProp opts cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + }) + in cTrf_Syn_CodeAGItf t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + Int -> + EHCOpts -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIopts) of + { _patOopts | _patOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOlev _patOopts) of + { ( _patIcTrf,_patIfldNmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + Int -> + EHCOpts -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOlev _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOlev _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBind + nm : HsName + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBind,HsName) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts | _bindAspectsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg | _bindAspectsOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx | _bindAspectsOevalCtx `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOopts) of + { ( _bindAspectsIcTrf) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + ( _lhsOcTrf,_lhsOnm) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + EHCOpts -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + EHCOpts -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOletBindingsCateg _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdInm) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attribute: + cTrf : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( CBound) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (_lhsIopts) of + { _bindMetaOopts | _bindMetaOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev _bindMetaOopts) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _cmetasOopts | _cmetasOopts `seq` (True) -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev _cmetasOopts) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsLam 0) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attribute: + cTrf : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (True) of + { _hdOisTopApp | _hdOisTopApp `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOnm _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (True) of + { _hdOisTopTup | _hdOisTopTup `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lev : Int + opts : EHCOpts + whatAbove : WhatExpr + synthesized attributes: + appArgL : [CBound] + appLam : CExpr + cTrf : CExpr + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local letBindingsCateg : _ + local isTopTup : _ + local isGlobal : _ + local whatAbove : {WhatExpr} + local appArgL : _ + local appLam : _ + local cTrf : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + Int -> + EHCOpts -> + WhatExpr -> + ( ([CBound]),CExpr,CExpr,WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (ExprIsVar _nm) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsInt int_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsTup tag_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx | _evalCtx `seq` (True) -> + (case (_evalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappArgL,_bodyIappLam,_bodyIcTrf,_bodyIwhatBelow) | True -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (categ_) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg | _bindsOletBindingsCateg `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (_evalCtx) of + { _bindsOevalCtx | _bindsOevalCtx `seq` (True) -> + (case (binds_ _bindsOevalCtx _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev _bindsOopts) of + { ( _bindsIcTrf) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (True) of + { _argOisTopApp | _argOisTopApp `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg | _argOletBindingsCateg `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _argOisTopTup | _argOisTopTup `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (EvalCtx_Thunk) of + { _argOevalCtx | _argOevalCtx `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm _argOopts) of + { ( _argIcTrf) | True -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (False) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIappArgL,_funcIappLam,_funcIcTrf,_funcIwhatBelow) | True -> + (case (_argIcTrf : _funcIappArgL) of + { _appArgL | _appArgL `seq` (True) -> + (case (_appArgL) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_funcIappLam) of + { _appLam | _appLam `seq` (True) -> + (case (_appLam) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (if _lhsIisTopApp + then case (acoreExprMbVar _appLam,reverse _appArgL) of + (Just n,[e1,e2]) | n == (ehcOptBuiltin _lhsIopts ehbnPrimAddInt) && isJust i1 && isJust i2 + -> acoreInt _lhsIopts (fromInteger $ snd (fromJust i1) + snd (fromJust i2)) + where i1 = acoreExprMbInt $ acoreUnBoundVal e1 + i2 = acoreExprMbInt $ acoreUnBoundVal e2 + _ -> _cTrf + else _cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappArgL,_bodyIappLam,_bodyIcTrf,_bodyIwhatBelow) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindInm) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _dfltOopts | _dfltOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _dfltOisTopApp | _dfltOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _altsOopts | _altsOopts `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _dfltOwhatAbove | _dfltOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _dfltOisTopTup | _dfltOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx | _dfltOevalCtx `seq` (True) -> + (case (dflt_ _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOopts _dfltOwhatAbove) of + { ( _dfltIappArgL,_dfltIappLam,_dfltIcTrf,_dfltIwhatBelow) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _altsOevalCtx | _altsOevalCtx `seq` (True) -> + (case (alts_ _altsOevalCtx _altsOlev _altsOopts) of + { ( _altsIcTrf) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _errorExprOopts | _errorExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _errorExprOisTopApp | _errorExprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _errorExprOwhatAbove | _errorExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _errorExprOisTopTup | _errorExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx | _errorExprOevalCtx `seq` (True) -> + (case (errorExpr_ _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOopts _errorExprOwhatAbove) of + { ( _errorExprIappArgL,_errorExprIappLam,_errorExprIcTrf,_errorExprIwhatBelow) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappArgL,_offsetIappLam,_offsetIcTrf,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappArgL,_fldExprIappLam,_fldExprIcTrf,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappArgL,_offsetIappLam,_offsetIcTrf,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappArgL,_fldExprIappLam,_fldExprIcTrf,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappArgL,_offsetIappLam,_offsetIcTrf,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsFFI) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappArgL,_bodyIappLam,_bodyIcTrf,_bodyIwhatBelow) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIappArgL,_funcIappLam,_funcIcTrf,_funcIwhatBelow) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case ([]) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappArgL,_bodyIappLam,_bodyIcTrf,_bodyIwhatBelow) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (_exprIappArgL) of + { _lhsOappArgL | _lhsOappArgL `seq` (True) -> + (case (_exprIappLam) of + { _lhsOappLam | _lhsOappLam `seq` (True) -> + (case (_lhsIopts) of + { _annOopts | _annOopts `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev _annOopts) of + { ( _annIcTrf) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappArgL,_lhsOappLam,_lhsOcTrf,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + EHCOpts -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + EHCOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + EHCOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + EHCOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts | _x2Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev _x2Oopts) of + { ( _x2IcTrf) | True -> + (case (_lhsIopts) of + { _x1Oopts | _x1Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev _x1Oopts) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + EHCOpts -> + ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappArgL,_exprIappLam,_exprIcTrf,_exprIwhatBelow) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + EHCOpts -> + ( CPat,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev _bindsOopts) of + { ( _bindsIcTrf,_bindsIfldNmL) | True -> + (case (_lhsIopts) of + { _restOopts | _restOopts `seq` (True) -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev _restOopts) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + EHCOpts -> + ( CPatFld,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _fldAnnsOopts | _fldAnnsOopts `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev _fldAnnsOopts) of + { ( _fldAnnsIcTrf) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (EvalCtx_None) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindInm) | True -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (True) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappArgL,_offsetIappLam,_offsetIcTrf,_offsetIwhatBelow) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + EHCOpts -> + ( CPatFldL,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfldNmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfldNmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + EHCOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = EHCOpts -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = + (let ( _lhsOcTrf) | True = sem _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts | _moduleOopts `seq` (True) -> + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev _moduleOopts) of + { ( _moduleIcTrf) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs b/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs @@ -0,0 +1,1758 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ElimN) +module UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs(cmodTrfElimNonCodegenConstructs) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore + + + + + + + +cmodTrfElimNonCodegenConstructs + :: EHCOpts + -> CModule + -> CModule +cmodTrfElimNonCodegenConstructs opts cmod + = ( cTrf_Syn_CodeAGItf t + ) + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + }) + + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EHCOpts -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (_lhsIopts) of + { _patOopts | _patOopts `seq` (True) -> + (case (pat_ _patOopts) of + { ( _patIcTrf) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EHCOpts -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (tl_ _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (hd_ _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EHCOpts -> + ( CBind) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts | _bindAspectsOopts `seq` (True) -> + (case (bindAspects_ _bindAspectsOopts) of + { ( _bindAspectsIcTrf) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = EHCOpts -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIopts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = EHCOpts -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (tl_ _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (hd_ _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EHCOpts -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (tl_ _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (hd_ _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EHCOpts -> + ( CBound) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (_lhsIopts) of + { _bindMetaOopts | _bindMetaOopts `seq` (True) -> + (case (bindMeta_ _bindMetaOopts) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _cmetasOopts | _cmetasOopts `seq` (True) -> + (case (cmetas_ _cmetasOopts) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIopts -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIopts -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EHCOpts -> + ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (tl_ _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (hd_ _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EHCOpts -> + ( CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIopts -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIopts -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIopts -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIopts -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIopts -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIopts -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (body_ _bodyOopts) of + { ( _bodyIcTrf) | True -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (binds_ _bindsOopts) of + { ( _bindsIcTrf) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (arg_ _argOopts) of + { ( _argIcTrf) | True -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (func_ _funcOopts) of + { ( _funcIcTrf) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (body_ _bodyOopts) of + { ( _bodyIcTrf) | True -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (bind_ _bindOopts) of + { ( _bindIcTrf) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _dfltOopts | _dfltOopts `seq` (True) -> + (case (dflt_ _dfltOopts) of + { ( _dfltIcTrf) | True -> + (case (_lhsIopts) of + { _altsOopts | _altsOopts `seq` (True) -> + (case (alts_ _altsOopts) of + { ( _altsIcTrf) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _errorExprOopts | _errorExprOopts `seq` (True) -> + (case (errorExpr_ _errorExprOopts) of + { ( _errorExprIcTrf) | True -> + (case (_errorExprIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (offset_ _offsetOopts) of + { ( _offsetIcTrf) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (fldExpr_ _fldExprOopts) of + { ( _fldExprIcTrf) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (offset_ _offsetOopts) of + { ( _offsetIcTrf) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (fldExpr_ _fldExprOopts) of + { ( _fldExprIcTrf) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (offset_ _offsetOopts) of + { ( _offsetIcTrf) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIopts -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIopts -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIopts -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (body_ _bodyOopts) of + { ( _bodyIcTrf) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIopts -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (func_ _funcOopts) of + { ( _funcIcTrf) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (body_ _bodyOopts) of + { ( _bodyIcTrf) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (_lhsIopts) of + { _annOopts | _annOopts `seq` (True) -> + (case (ann_ _annOopts) of + { ( _annIcTrf) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = EHCOpts -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIopts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIopts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIopts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = EHCOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIopts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIopts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIopts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIopts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = EHCOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIopts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIopts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIopts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIopts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIopts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = EHCOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts | _x2Oopts `seq` (True) -> + (case (x2_ _x2Oopts) of + { ( _x2IcTrf) | True -> + (case (_lhsIopts) of + { _x1Oopts | _x1Oopts `seq` (True) -> + (case (x1_ _x1Oopts) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = EHCOpts -> + ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (expr_ _exprOopts) of + { ( _exprIcTrf) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = EHCOpts -> + ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIopts -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (binds_ _bindsOopts) of + { ( _bindsIcTrf) | True -> + (case (_lhsIopts) of + { _restOopts | _restOopts `seq` (True) -> + (case (rest_ _restOopts) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIopts -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIopts -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIopts -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = EHCOpts -> + ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _fldAnnsOopts | _fldAnnsOopts `seq` (True) -> + (case (fldAnns_ _fldAnnsOopts) of + { ( _fldAnnsIcTrf) | True -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (bind_ _bindOopts) of + { ( _bindIcTrf) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (offset_ _offsetOopts) of + { ( _offsetIcTrf) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = EHCOpts -> + ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (tl_ _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (hd_ _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = EHCOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIopts -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIopts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = EHCOpts -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = + (let ( _lhsOcTrf) | True = sem _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts | _moduleOopts `seq` (True) -> + (case (module_ _moduleOopts) of + { ( _moduleIcTrf) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs b/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs @@ -0,0 +1,3183 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ElimT) +module UHC.Light.Compiler.Core.Trf.ElimTrivApp(cmodTrfElimTrivApp) where + +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Util.Utils + + + + + + + + + +cmodTrfElimTrivApp :: EHCOpts -> CModule -> CModule +cmodTrfElimTrivApp opts cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) (Inh_CodeAGItf {opts_Inh_CodeAGItf = opts}) + in cTrf_Syn_CodeAGItf t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CAlt + fvS : FvS + mbCTag : Maybe CTag + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + Int -> + EHCOpts -> + ( CAlt,FvS,(Maybe CTag)) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIopts) of + { _patOopts | _patOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOlev _patOopts) of + { ( _patIcTrf,_patIfldNmL,_patIfvS,_patImbCTag,_patInmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_patImbCTag) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOmbCTag) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CAltL + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + Int -> + EHCOpts -> + ( CAltL,FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfvS) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfvS,_hdImbCTag) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBind + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBind,FvS,FvSMp,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts | _bindAspectsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg | _bindAspectsOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx | _bindAspectsOevalCtx `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOopts) of + { ( _bindAspectsIcTrf,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + EHCOpts -> + ( CBindAnn,FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + EHCOpts -> + ( CBindAnnL,FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfvS,_tlInmL) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CBindL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + EHCOpts -> + ( CBindL,FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOletBindingsCateg _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attributes: + cTrf : CBound + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( CBound,FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_lhsIopts) of + { _bindMetaOopts | _bindMetaOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev _bindMetaOopts) of + { ( _bindMetaIcTrf,_bindMetaIfvS) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _cmetasOopts | _cmetasOopts `seq` (True) -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev _cmetasOopts) of + { ( _cmetasIcTrf,_cmetasIfvS) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cmetasIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsLam 0) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + opts : EHCOpts + synthesized attributes: + cTrf : CBoundL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + HsName -> + EHCOpts -> + ( CBoundL,FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (True) of + { _hdOisTopApp | _hdOisTopApp `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOnm _tlOopts) of + { ( _tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (True) of + { _hdOisTopTup | _hdOisTopTup `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm _hdOopts) of + { ( _hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lev : Int + opts : EHCOpts + whatAbove : WhatExpr + synthesized attributes: + appFunKind : AppFunKind + argL : [CBound] + cTrf : CExpr + fvS : FvS + mbFunVar : Maybe HsName + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + local mbVar : {Maybe HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local fvS : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local argL : _ + local cTrf : _ + local fvS : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local fvS : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local whatAbove : {WhatExpr} + local isTopTup : _ + local cTrf : _ + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + Int -> + EHCOpts -> + WhatExpr -> + ( AppFunKind,([CBound]),CExpr,FvS,(Maybe HsName),(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Set.singleton _nm) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Just _nm) of + { _mbVar | _mbVar `seq` (True) -> + (case (_mbVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_mbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsVar _nm) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsInt int_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsTup tag_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx | _evalCtx `seq` (True) -> + (case (_evalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIfvS,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (categ_) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg | _bindsOletBindingsCateg `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (_evalCtx) of + { _bindsOevalCtx | _bindsOevalCtx `seq` (True) -> + (case (binds_ _bindsOevalCtx _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev _bindsOopts) of + { ( _bindsIcTrf,_bindsIfvS,_bindsIfvSMp,_bindsInmL) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (False) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcIfvS,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (_funcIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (True) of + { _argOisTopApp | _argOisTopApp `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg | _argOletBindingsCateg `seq` (True) -> + (case (_isTopTup) of + { _argOisTopTup | _argOisTopTup `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (EvalCtx_Thunk) of + { _argOevalCtx | _argOevalCtx `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm _argOopts) of + { ( _argIcTrf,_argIfvS,_argIfvSMp,_argInmL) | True -> + (case (_argIcTrf : _funcIargL) of + { _argL | _argL `seq` (True) -> + (case (_argL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (if _lhsIisTopApp + then case (_funcImbFunVar,reverse _argL) of + (Just f,[a]) | f == (ehcOptBuiltin _lhsIopts ehbnId) + -> acoreUnBoundVal a + _ -> _cTrf + else _cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_funcImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIfvS,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _dfltOopts | _dfltOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _dfltOisTopApp | _dfltOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _altsOopts | _altsOopts `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _dfltOwhatAbove | _dfltOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _dfltOisTopTup | _dfltOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx | _dfltOevalCtx `seq` (True) -> + (case (dflt_ _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOopts _dfltOwhatAbove) of + { ( _dfltIappFunKind,_dfltIargL,_dfltIcTrf,_dfltIfvS,_dfltImbFunVar,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _altsOevalCtx | _altsOevalCtx `seq` (True) -> + (case (alts_ _altsOevalCtx _altsOlev _altsOopts) of + { ( _altsIcTrf,_altsIfvS) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _errorExprOwhatAbove | _errorExprOwhatAbove `seq` (True) -> + (case (_lhsIopts) of + { _errorExprOopts | _errorExprOopts `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _errorExprOisTopTup | _errorExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _errorExprOisTopApp | _errorExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx | _errorExprOevalCtx `seq` (True) -> + (case (errorExpr_ _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOopts _errorExprOwhatAbove) of + { ( _errorExprIappFunKind,_errorExprIargL,_errorExprIcTrf,_errorExprIfvS,_errorExprImbFunVar,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) | True -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_errorExprIargL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_errorExprImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (_errorExprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_errorExprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIfvS,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprIfvS,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIfvS,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOopts _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIargL,_fldExprIcTrf,_fldExprIfvS,_fldExprImbFunVar,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIfvS,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsFFI) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIfvS,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOopts _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIargL,_funcIcTrf,_funcIfvS,_funcImbFunVar,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case ([]) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOopts _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIargL,_bodyIcTrf,_bodyIfvS,_bodyImbFunVar,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIopts + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_exprIargL) of + { _lhsOargL | _lhsOargL `seq` (True) -> + (case (_lhsIopts) of + { _annOopts | _annOopts `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev _annOopts) of + { ( _annIcTrf,_annIfvS) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprImbFunVar) of + { _lhsOmbFunVar | _lhsOmbFunVar `seq` (True) -> + (case (_exprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_exprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOargL,_lhsOcTrf,_lhsOfvS,_lhsOmbFunVar,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + EHCOpts -> + ( CExprAnn,FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev + _lhsIopts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + EHCOpts -> + ( CMetaBind,FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + EHCOpts -> + ( CMetaVal,FvS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev + _lhsIopts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CMetas + fvS : FvS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + EHCOpts -> + ( CMetas,FvS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts | _x2Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev _x2Oopts) of + { ( _x2IcTrf,_x2IfvS) | True -> + (case (_lhsIopts) of + { _x1Oopts | _x1Oopts `seq` (True) -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev _x1Oopts) of + { ( _x1IcTrf,_x1IfvS) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CModule + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + EHCOpts -> + ( CModule,FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOopts _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIargL,_exprIcTrf,_exprIfvS,_exprImbFunVar,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + mbCTag : Maybe CTag + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + EHCOpts -> + ( CPat,([HsName]),FvS,(Maybe CTag),([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOmbCTag,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev _bindsOopts) of + { ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsInmL) | True -> + (case (_lhsIopts) of + { _restOopts | _restOopts `seq` (True) -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev _restOopts) of + { ( _restIcTrf,_restIfvS,_restInmL) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Just tag_) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOmbCTag,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOmbCTag,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOmbCTag,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbCTag | _lhsOmbCTag `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOmbCTag,_lhsOnmL) }) }) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + EHCOpts -> + ( CPatFld,([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (True) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIopts) of + { _fldAnnsOopts | _fldAnnsOopts `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev _fldAnnsOopts) of + { ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsInmL) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (EvalCtx_None) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev _bindOopts) of + { ( _bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (True) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOopts _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIargL,_offsetIcTrf,_offsetIfvS,_offsetImbFunVar,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + EHCOpts -> + ( CPatFldL,([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev _tlOopts) of + { ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev _hdOopts) of + { ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lev : Int + opts : EHCOpts + synthesized attributes: + cTrf : CPatRest + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + EHCOpts -> + ( CPatRest,FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev + _lhsIopts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : EHCOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = EHCOpts -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIopts) = + (let ( _lhsOcTrf) | True = sem _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts | _moduleOopts `seq` (True) -> + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev _moduleOopts) of + { ( _moduleIcTrf,_moduleIfvS) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs b/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs @@ -0,0 +1,2298 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Erase) +module UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore(cmodTrfEraseExtractTysigCore, cmodTrfEraseTyCore) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Core.BindExtract +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set + + + + + + + + + + + + + +cmodTrfEraseExtractTysigCore + :: EHCOpts + -> CModule + -> ( CModule + , LamMp + ) +cmodTrfEraseExtractTysigCore opts cmod + = ( cTrf_Syn_CodeAGItf t + , gathLamMp_Syn_CodeAGItf t + ) + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + , lamMp_Inh_CodeAGItf = Map.empty + }) + +cmodTrfEraseTyCore + :: EHCOpts + -> CModule + -> ( CModule + -- , LamMp + ) +cmodTrfEraseTyCore opts cmod = fst $ cmodTrfEraseExtractTysigCore opts cmod + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = LamMp -> + EHCOpts -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (_lhsIopts) of + { _patOopts | _patOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _patOlamMp | _patOlamMp `seq` (True) -> + (case (pat_ _patOlamMp _patOopts) of + { ( _patIcTrf,_patIfldNmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = LamMp -> + EHCOpts -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _tlOlamMp | _tlOlamMp `seq` (True) -> + (case (tl_ _tlOlamMp _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _hdOlamMp | _hdOlamMp `seq` (True) -> + (case (hd_ _hdOlamMp _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + boundsel : BoundSel + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cBindL : [CBind] + cTrf : CBind + nm : HsName + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ + local cBindL : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = BoundSel -> + LamMp -> + EHCOpts -> + ( LamMp,([CBind]),CBind,HsName,([SelVal]),([SelVal])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _bindAspectsOopts | _bindAspectsOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindAspectsOlamMp | _bindAspectsOlamMp `seq` (True) -> + (case (_lhsIboundsel) of + { _bindAspectsOboundsel | _bindAspectsOboundsel `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOboundsel _bindAspectsOlamMp _bindAspectsOnm _bindAspectsOopts) of + { ( _bindAspectsIbindLamMp,_bindAspectsIcBindL,_bindAspectsIcTrf,_bindAspectsIselvalNoL,_bindAspectsIselvalYesL) | True -> + (case (_bindAspectsIbindLamMp) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case (CBind_Bind nm_ _bindAspectsIselvalYesL) of + { _cTrf | _cTrf `seq` (True) -> + (case (if null _bindAspectsIselvalYesL then [] else [_cTrf]) of + { _cBindL | _cBindL `seq` (True) -> + (case (_cBindL) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case (_bindAspectsIselvalNoL) of + { _lhsOselvalNoL | _lhsOselvalNoL `seq` (True) -> + (case (_bindAspectsIselvalYesL) of + { _lhsOselvalYesL | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOnm,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = LamMp -> + EHCOpts -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = LamMp -> + EHCOpts -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _tlOlamMp | _tlOlamMp `seq` (True) -> + (case (tl_ _tlOlamMp _tlOopts) of + { ( _tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _hdOlamMp | _hdOlamMp `seq` (True) -> + (case (hd_ _hdOlamMp _hdOopts) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + boundsel : BoundSel + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cBindL : [CBind] + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = BoundSel -> + LamMp -> + EHCOpts -> + ( LamMp,([CBind]),CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _tlOlamMp | _tlOlamMp `seq` (True) -> + (case (_lhsIboundsel) of + { _tlOboundsel | _tlOboundsel `seq` (True) -> + (case (tl_ _tlOboundsel _tlOlamMp _tlOopts) of + { ( _tlIbindLamMp,_tlIcBindL,_tlIcTrf) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _hdOlamMp | _hdOlamMp `seq` (True) -> + (case (_lhsIboundsel) of + { _hdOboundsel | _hdOboundsel `seq` (True) -> + (case (hd_ _hdOboundsel _hdOlamMp _hdOopts) of + { ( _hdIbindLamMp,_hdIcBindL,_hdIcTrf,_hdInm,_hdIselvalNoL,_hdIselvalYesL) | True -> + (case (_hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case (_hdIcBindL ++ _tlIcBindL) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIboundsel + _lhsIlamMp + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + boundsel : BoundSel + lamMp : LamMp + nm : HsName + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cBindL : [CBind] + cTrf : CBound + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup1 : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup2 : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup3 : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup4 : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup5 : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ + local boundval : _ + local isSelected : _ + local _tup6 : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = BoundSel -> + LamMp -> + HsName -> + EHCOpts -> + ( LamMp,([CBind]),CBound,([SelVal]),([SelVal])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (_lhsIopts) of + { _bindMetaOopts | _bindMetaOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindMetaOlamMp | _bindMetaOlamMp `seq` (True) -> + (case (bindMeta_ _bindMetaOlamMp _bindMetaOopts) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selBind _lhsIboundsel) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup1) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (_lhsIopts) of + { _cmetasOopts | _cmetasOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _cmetasOlamMp | _cmetasOlamMp `seq` (True) -> + (case (cmetas_ _cmetasOlamMp _cmetasOopts) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selMeta _lhsIboundsel aspectKeyS_) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup2 | __tup2 `seq` (True) -> + (case (__tup2) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup2) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selRelevTy _lhsIboundsel aspectKeyS_ relevTy_) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup3 | __tup3 `seq` (True) -> + (case (__tup3) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup3) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selVal _lhsIboundsel aspectKeyS_ mlev_ lbl_) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup4 | __tup4 `seq` (True) -> + (case (__tup4) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup4) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selTy _lhsIboundsel aspectKeyS_) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup5 | __tup5 `seq` (True) -> + (case (__tup5) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup5) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cTrf) of + { _boundval | _boundval `seq` (True) -> + (case (selFFE _lhsIboundsel) of + { _isSelected | _isSelected `seq` (True) -> + (case (if _isSelected + then ([_boundval],[]) + else ([],[_boundval])) of + { __tup6 | __tup6 `seq` (True) -> + (case (__tup6) of + { (_,_lhsOselvalNoL) | _lhsOselvalNoL `seq` (True) -> + (case (__tup6) of + { (_lhsOselvalYesL,_) | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + boundsel : BoundSel + lamMp : LamMp + nm : HsName + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cBindL : [CBind] + cTrf : CBoundL + selvalNoL : [SelVal] + selvalYesL : [SelVal] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = BoundSel -> + LamMp -> + HsName -> + EHCOpts -> + ( LamMp,([CBind]),CBoundL,([SelVal]),([SelVal])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlamMp) of + { _tlOlamMp | _tlOlamMp `seq` (True) -> + (case (_lhsIboundsel) of + { _tlOboundsel | _tlOboundsel `seq` (True) -> + (case (tl_ _tlOboundsel _tlOlamMp _tlOnm _tlOopts) of + { ( _tlIbindLamMp,_tlIcBindL,_tlIcTrf,_tlIselvalNoL,_tlIselvalYesL) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlamMp) of + { _hdOlamMp | _hdOlamMp `seq` (True) -> + (case (_lhsIboundsel) of + { _hdOboundsel | _hdOboundsel `seq` (True) -> + (case (hd_ _hdOboundsel _hdOlamMp _hdOnm _hdOopts) of + { ( _hdIbindLamMp,_hdIcBindL,_hdIcTrf,_hdIselvalNoL,_hdIselvalYesL) | True -> + (case (_hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case (_hdIcBindL ++ _tlIcBindL) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIselvalNoL ++ _tlIselvalNoL) of + { _lhsOselvalNoL | _lhsOselvalNoL `seq` (True) -> + (case (_hdIselvalYesL ++ _tlIselvalYesL) of + { _lhsOselvalYesL | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIboundsel + _lhsIlamMp + _lhsInm + _lhsIopts -> + (case (Map.empty) of + { _lhsObindLamMp | _lhsObindLamMp `seq` (True) -> + (case ([]) of + { _lhsOcBindL | _lhsOcBindL `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOselvalNoL | _lhsOselvalNoL `seq` (True) -> + (case ([]) of + { _lhsOselvalYesL | _lhsOselvalYesL `seq` (True) -> + ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CExpr + gathLamMp : LamMp + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = LamMp -> + EHCOpts -> + ( CExpr,LamMp) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (boundSelMetaLev0) of + { _bindsOboundsel | _bindsOboundsel `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bodyOlamMp | _bodyOlamMp `seq` (True) -> + (case (body_ _bodyOlamMp _bodyOopts) of + { ( _bodyIcTrf,_bodyIgathLamMp) | True -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindsOlamMp | _bindsOlamMp `seq` (True) -> + (case (binds_ _bindsOboundsel _bindsOlamMp _bindsOopts) of + { ( _bindsIbindLamMp,_bindsIcBindL,_bindsIcTrf) | True -> + (case (if null _bindsIcBindL then _bodyIcTrf else CExpr_Let categ_ _bindsIcBindL _bodyIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIbindLamMp `Map.union` _bodyIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _argOlamMp | _argOlamMp `seq` (True) -> + (case (boundSelMetaLev0) of + { _argOboundsel | _argOboundsel `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOboundsel _argOlamMp _argOnm _argOopts) of + { ( _argIbindLamMp,_argIcBindL,_argIcTrf,_argIselvalNoL,_argIselvalYesL) | True -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _funcOlamMp | _funcOlamMp `seq` (True) -> + (case (func_ _funcOlamMp _funcOopts) of + { ( _funcIcTrf,_funcIgathLamMp) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (if null _argIselvalYesL then _funcIcTrf else _cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (boundSelMetaLev01) of + { _bindOboundsel | _bindOboundsel `seq` (True) -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindOlamMp | _bindOlamMp `seq` (True) -> + (case (bind_ _bindOboundsel _bindOlamMp _bindOopts) of + { ( _bindIbindLamMp,_bindIcBindL,_bindIcTrf,_bindInm,_bindIselvalNoL,_bindIselvalYesL) | True -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (Map.delete _argNm _lhsIlamMp) of + { _bodyOlamMp | _bodyOlamMp `seq` (True) -> + (case (body_ _bodyOlamMp _bodyOopts) of + { ( _bodyIcTrf,_bodyIgathLamMp) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (if null _bindIselvalYesL + then if null _bindIselvalNoL + then _cTrf + else _bodyIcTrf + else CExpr_Lam (CBind_Bind _argNm _bindIselvalNoL) _bodyIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _dfltOopts | _dfltOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _dfltOlamMp | _dfltOlamMp `seq` (True) -> + (case (dflt_ _dfltOlamMp _dfltOopts) of + { ( _dfltIcTrf,_dfltIgathLamMp) | True -> + (case (_lhsIopts) of + { _altsOopts | _altsOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _altsOlamMp | _altsOlamMp `seq` (True) -> + (case (alts_ _altsOlamMp _altsOopts) of + { ( _altsIcTrf) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _errorExprOopts | _errorExprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _errorExprOlamMp | _errorExprOlamMp `seq` (True) -> + (case (errorExpr_ _errorExprOlamMp _errorExprOopts) of + { ( _errorExprIcTrf,_errorExprIgathLamMp) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _offsetOlamMp | _offsetOlamMp `seq` (True) -> + (case (offset_ _offsetOlamMp _offsetOopts) of + { ( _offsetIcTrf,_offsetIgathLamMp) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _fldExprOlamMp | _fldExprOlamMp `seq` (True) -> + (case (fldExpr_ _fldExprOlamMp _fldExprOopts) of + { ( _fldExprIcTrf,_fldExprIgathLamMp) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _offsetOlamMp | _offsetOlamMp `seq` (True) -> + (case (offset_ _offsetOlamMp _offsetOopts) of + { ( _offsetIcTrf,_offsetIgathLamMp) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _fldExprOopts | _fldExprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _fldExprOlamMp | _fldExprOlamMp `seq` (True) -> + (case (fldExpr_ _fldExprOlamMp _fldExprOopts) of + { ( _fldExprIcTrf,_fldExprIgathLamMp) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _offsetOlamMp | _offsetOlamMp `seq` (True) -> + (case (offset_ _offsetOlamMp _offsetOopts) of + { ( _offsetIcTrf,_offsetIgathLamMp) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bodyOlamMp | _bodyOlamMp `seq` (True) -> + (case (body_ _bodyOlamMp _bodyOopts) of + { ( _bodyIcTrf,_bodyIgathLamMp) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _funcOlamMp | _funcOlamMp `seq` (True) -> + (case (func_ _funcOlamMp _funcOopts) of + { ( _funcIcTrf,_funcIgathLamMp) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _bodyOopts | _bodyOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bodyOlamMp | _bodyOlamMp `seq` (True) -> + (case (body_ _bodyOlamMp _bodyOopts) of + { ( _bodyIcTrf,_bodyIgathLamMp) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (_lhsIopts) of + { _annOopts | _annOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _annOlamMp | _annOlamMp `seq` (True) -> + (case (ann_ _annOlamMp _annOopts) of + { ( _annIcTrf) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = LamMp -> + EHCOpts -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = LamMp -> + EHCOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = LamMp -> + EHCOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = LamMp -> + EHCOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _x2Oopts | _x2Oopts `seq` (True) -> + (case (_lhsIlamMp) of + { _x2OlamMp | _x2OlamMp `seq` (True) -> + (case (x2_ _x2OlamMp _x2Oopts) of + { ( _x2IcTrf) | True -> + (case (_lhsIopts) of + { _x1Oopts | _x1Oopts `seq` (True) -> + (case (_lhsIlamMp) of + { _x1OlamMp | _x1OlamMp `seq` (True) -> + (case (x1_ _x1OlamMp _x1Oopts) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + gathLamMp : LamMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = LamMp -> + EHCOpts -> + ( CModule,LamMp) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _exprOlamMp | _exprOlamMp `seq` (True) -> + (case (expr_ _exprOlamMp _exprOopts) of + { ( _exprIcTrf,_exprIgathLamMp) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = LamMp -> + EHCOpts -> + ( CPat,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _bindsOopts | _bindsOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindsOlamMp | _bindsOlamMp `seq` (True) -> + (case (binds_ _bindsOlamMp _bindsOopts) of + { ( _bindsIcTrf,_bindsIfldNmL) | True -> + (case (_lhsIopts) of + { _restOopts | _restOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _restOlamMp | _restOlamMp `seq` (True) -> + (case (rest_ _restOlamMp _restOopts) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local boundsel : _ + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = LamMp -> + EHCOpts -> + ( CPatFld,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (noBoundSel) of + { _boundsel | _boundsel `seq` (True) -> + (case (_boundsel) of + { _bindOboundsel | _bindOboundsel `seq` (True) -> + (case (_lhsIopts) of + { _fldAnnsOopts | _fldAnnsOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _fldAnnsOlamMp | _fldAnnsOlamMp `seq` (True) -> + (case (fldAnns_ _fldAnnsOlamMp _fldAnnsOopts) of + { ( _fldAnnsIcTrf) | True -> + (case (_lhsIopts) of + { _bindOopts | _bindOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _bindOlamMp | _bindOlamMp `seq` (True) -> + (case (bind_ _bindOboundsel _bindOlamMp _bindOopts) of + { ( _bindIbindLamMp,_bindIcBindL,_bindIcTrf,_bindInm,_bindIselvalNoL,_bindIselvalYesL) | True -> + (case (_lhsIopts) of + { _offsetOopts | _offsetOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _offsetOlamMp | _offsetOlamMp `seq` (True) -> + (case (offset_ _offsetOlamMp _offsetOopts) of + { ( _offsetIcTrf,_offsetIgathLamMp) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = LamMp -> + EHCOpts -> + ( CPatFldL,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _tlOlamMp | _tlOlamMp `seq` (True) -> + (case (tl_ _tlOlamMp _tlOopts) of + { ( _tlIcTrf,_tlIfldNmL) | True -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIlamMp) of + { _hdOlamMp | _hdOlamMp `seq` (True) -> + (case (hd_ _hdOlamMp _hdOopts) of + { ( _hdIcTrf,_hdIfldNmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = LamMp -> + EHCOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlamMp + _lhsIopts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + gathLamMp : LamMp + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local howUnionGathLamInfo : _ + local howMergeLamInfo : _ + local gathLamMp : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = LamMp -> + EHCOpts -> + ( CModule,LamMp) +data Inh_CodeAGItf = Inh_CodeAGItf {lamMp_Inh_CodeAGItf :: !(LamMp),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule),gathLamMp_Syn_CodeAGItf :: !(LamMp)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIlamMp _lhsIopts) = + (let ( _lhsOcTrf,_lhsOgathLamMp) | True = sem _lhsIlamMp _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf _lhsOgathLamMp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIlamMp + _lhsIopts -> + (case (_lhsIopts) of + { _moduleOopts | _moduleOopts `seq` (True) -> + (case (id) of + { _howUnionGathLamInfo | _howUnionGathLamInfo `seq` (True) -> + (case (_howUnionGathLamInfo _lhsIlamMp) of + { _moduleOlamMp | _moduleOlamMp `seq` (True) -> + (case (module_ _moduleOlamMp _moduleOopts) of + { ( _moduleIcTrf,_moduleIgathLamMp) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ((\(LamInfo {laminfoBindAspMp=m}) i -> i {laminfoBindAspMp = m `Map.union` laminfoBindAspMp i})) of + { _howMergeLamInfo | _howMergeLamInfo `seq` (True) -> + (case (lamMpMergeInto _howMergeLamInfo const _moduleIgathLamMp _lhsIlamMp) of + { _gathLamMp | _gathLamMp `seq` (True) -> + (case (_gathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + ( _lhsOcTrf,_lhsOgathLamMp) }) }) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs b/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs @@ -0,0 +1,2983 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/EtaRe) +module UHC.Light.Compiler.Core.Trf.EtaRed(cmodTrfEtaRed) where + +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore + + + + + + + + + +cmodTrfEtaRed :: CModule -> CModule +cmodTrfEtaRed cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) Inh_CodeAGItf + in cTrf_Syn_CodeAGItf t + + + +type MbApp = Maybe ((CExpr,FvS),CBound) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + synthesized attributes: + cTrf : CAlt + fvS : FvS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + Int -> + ( CAlt,FvS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlev -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOlev) of + { ( _patIcTrf,_patIfldNmL,_patIfvS,_patInmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + synthesized attributes: + cTrf : CAltL + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + Int -> + ( CAltL,FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOlev) of + { ( _tlIcTrf,_tlIfvS) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOlev) of + { ( _hdIcTrf,_hdIfvS) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + synthesized attributes: + cTrf : CBind + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + ( CBind,FvS,FvSMp,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg | _bindAspectsOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx | _bindAspectsOevalCtx `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm) of + { ( _bindAspectsIcTrf,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + ( CBindAnn,FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + ( CBindAnnL,FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcTrf,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcTrf,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + synthesized attributes: + cTrf : CBindL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + ( CBindL,FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev) of + { ( _tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOletBindingsCateg _hdOlev) of + { ( _hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + synthesized attributes: + cTrf : CBound + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( CBound,FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev) of + { ( _bindMetaIcTrf,_bindMetaIfvS) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev) of + { ( _cmetasIcTrf,_cmetasIfvS) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cmetasIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (ExprIsLam 0) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + synthesized attributes: + cTrf : CBoundL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( CBoundL,FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOletBindingsCateg _tlOlev _tlOnm) of + { ( _tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (True) of + { _hdOisTopTup | _hdOisTopTup `seq` (True) -> + (case (True) of + { _hdOisTopApp | _hdOisTopApp `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm) of + { ( _hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lev : Int + whatAbove : WhatExpr + synthesized attributes: + appFunKind : AppFunKind + cTrf : CExpr + fvS : FvS + mbApp : MbApp + mbFunAppL : [MbApp] + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + local mbVar : {Maybe HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local evalCtx : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local fvS : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local fvS : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local isTopTup : _ + local isTopApp : {Bool} + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local _tup2 : _ + local cNew : _ + local fvS : _ + local isMatch : _ + local _tup1 : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + Int -> + WhatExpr -> + ( AppFunKind,CExpr,FvS,MbApp,([MbApp]),(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Set.singleton _nm) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Just _nm) of + { _mbVar | _mbVar `seq` (True) -> + (case (_mbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsVar _nm) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsInt int_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsTup tag_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx | _evalCtx `seq` (True) -> + (case (_evalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyImbApp,_bodyImbFunAppL,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (categ_) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg | _bindsOletBindingsCateg `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (_evalCtx) of + { _bindsOevalCtx | _bindsOevalCtx `seq` (True) -> + (case (binds_ _bindsOevalCtx _bindsOisGlobal _bindsOletBindingsCateg _bindsOlev) of + { ( _bindsIcTrf,_bindsIfvS,_bindsIfvSMp,_bindsInmL) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (False) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIcTrf,_funcIfvS,_funcImbApp,_funcImbFunAppL,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (_funcIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg | _argOletBindingsCateg `seq` (True) -> + (case (_isTopTup) of + { _argOisTopTup | _argOisTopTup `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (EvalCtx_Thunk) of + { _argOevalCtx | _argOevalCtx `seq` (True) -> + (case (True) of + { _argOisTopApp | _argOisTopApp `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm) of + { ( _argIcTrf,_argIfvS,_argIfvSMp,_argInmL) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (case _funcIappFunKind of + AppFunKind_Tag _ -> Nothing + AppFunKind_FFI -> Nothing + _ -> Just ((_funcIcTrf,_funcIfvS),_argIcTrf)) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case (_funcImbApp : _funcImbFunAppL) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyImbApp,_bodyImbFunAppL,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev) of + { ( _bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (case _bodyImbApp of + Just ((f,fFvS),v) | isJust mbV && a == _argNm && not (a `Set.member` fFvS) + -> (f,True) + where mbV@(~(Just a)) = acoreExprMbVar $ acoreUnBoundVal v + _ -> (_cTrf,False)) of + { __tup2 | __tup2 `seq` (True) -> + (case (__tup2) of + { (_cNew,_) | _cNew `seq` (True) -> + (case (_cNew) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (__tup2) of + { (_,_isMatch) | _isMatch `seq` (True) -> + (case (case _bodyImbFunAppL of + (f:fs) | _isMatch + -> (f,fs) + _ -> (Nothing,_bodyImbFunAppL)) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_lhsOmbApp,_) | _lhsOmbApp `seq` (True) -> + (case (__tup1) of + { (_,_lhsOmbFunAppL) | _lhsOmbFunAppL `seq` (True) -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _dfltOwhatAbove | _dfltOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _dfltOisTopTup | _dfltOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _dfltOisTopApp | _dfltOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx | _dfltOevalCtx `seq` (True) -> + (case (dflt_ _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOwhatAbove) of + { ( _dfltIappFunKind,_dfltIcTrf,_dfltIfvS,_dfltImbApp,_dfltImbFunAppL,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _altsOevalCtx | _altsOevalCtx `seq` (True) -> + (case (alts_ _altsOevalCtx _altsOlev) of + { ( _altsIcTrf,_altsIfvS) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _errorExprOwhatAbove | _errorExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _errorExprOisTopTup | _errorExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _errorExprOisTopApp | _errorExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx | _errorExprOevalCtx `seq` (True) -> + (case (errorExpr_ _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOwhatAbove) of + { ( _errorExprIappFunKind,_errorExprIcTrf,_errorExprIfvS,_errorExprImbApp,_errorExprImbFunAppL,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) | True -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (_errorExprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_errorExprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetImbApp,_offsetImbFunAppL,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIcTrf,_fldExprIfvS,_fldExprImbApp,_fldExprImbFunAppL,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetImbApp,_offsetImbFunAppL,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIcTrf,_fldExprIfvS,_fldExprImbApp,_fldExprImbFunAppL,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetImbApp,_offsetImbFunAppL,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsFFI) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyImbApp,_bodyImbFunAppL,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlev _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIcTrf,_funcIfvS,_funcImbApp,_funcImbFunAppL,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcTrf,_bodyIfvS,_bodyImbApp,_bodyImbFunAppL,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Nothing) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case ([]) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev) of + { ( _annIcTrf,_annIfvS) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprImbApp) of + { _lhsOmbApp | _lhsOmbApp `seq` (True) -> + (case (_exprImbFunAppL) of + { _lhsOmbFunAppL | _lhsOmbFunAppL `seq` (True) -> + (case (_exprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_exprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcTrf,_lhsOfvS,_lhsOmbApp,_lhsOmbFunAppL,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + ( CExprAnn,FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + ( CMetaBind,FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + ( CMetaVal,FvS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetas + fvS : FvS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + ( CMetas,FvS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev) of + { ( _x2IcTrf,_x2IfvS) | True -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev) of + { ( _x1IcTrf,_x1IfvS) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CModule + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + ( CModule,FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcTrf,_exprIfvS,_exprImbApp,_exprImbFunAppL,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + ( CPat,([HsName]),FvS,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev) of + { ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsInmL) | True -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev) of + { ( _restIcTrf,_restIfvS,_restInmL) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + ( CPatFld,([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev) of + { ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsInmL) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (EvalCtx_None) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOletBindingsCateg _bindOlev) of + { ( _bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (True) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (True) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcTrf,_offsetIfvS,_offsetImbApp,_offsetImbFunAppL,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + ( CPatFldL,([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatRest + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + ( CPatRest,FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) | True = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev) of + { ( _moduleIcTrf,_moduleIfvS) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) diff --git a/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs b/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs @@ -0,0 +1,6026 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Expli) +module UHC.Light.Compiler.Core.Trf.ExplicitStackTrace(cmodTrfExplicitStackTrace) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.AbstractCore +import Data.Maybe +import qualified Data.Map as Map + + + + + + + + + + + +cmodTrfExplicitStackTrace :: EHCOpts -> LamMp -> CModule -> (CModule,LamMp) +cmodTrfExplicitStackTrace opts lamMp cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + , lamMp_Inh_CodeAGItf = lamMp + }) + in ( cTrf_Syn_CodeAGItf t + , debugLamMp_Syn_CodeAGItf t `Map.union` + gathLamMp_Syn_CodeAGItf t + -- [ | (n,) <- debugLamMp_Syn_CodeAGItf t ] + ) + + + +mbStackTrace :: EHCOpts -> Bool -> HsName -> StackTraceInfo +mbStackTrace opts isCand nm + | isCand && ehcOptTargetFlavor opts == TargetFlavor_Debug + = StackTraceInfo_HasStackTraceEquiv (hsnSuffix nm "-$explstacktraced") + | otherwise = StackTraceInfo_None + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CAlt + debugLamMp : LamMp + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CAlt,LamMp,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CAlt + _lhsOuniq :: Int + _patOlamMp :: LamMp + _patOlev :: Int + _patOmbInStackTraceCtxt :: (Maybe HsName) + _patOopts :: EHCOpts + _patOuniq :: Int + _exprOevalCtx :: EvalCtx + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _patIcTrf :: CPat + _patIdebugLamMp :: LamMp + _patIfldNmL :: ([HsName]) + _patIuniq :: Int + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 87, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _patIdebugLamMp `Map.union` _exprIdebugLamMp + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _exprIuniq + -- copy rule (down) + _patOlamMp = + _lhsIlamMp + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _patOopts = + _lhsIopts + -- copy rule (down) + _patOuniq = + _lhsIuniq + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (chain) + _exprOuniq = + _patIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _patIcTrf,_patIdebugLamMp,_patIfldNmL,_patIuniq) = + pat_ _patOlamMp _patOlev _patOmbInStackTraceCtxt _patOopts _patOuniq + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CAltL + debugLamMp : LamMp + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CAltL,LamMp,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CAltL + _lhsOuniq :: Int + _hdOevalCtx :: EvalCtx + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOmbInStackTraceCtxt :: (Maybe HsName) + _hdOopts :: EHCOpts + _hdOuniq :: Int + _tlOevalCtx :: EvalCtx + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOmbInStackTraceCtxt :: (Maybe HsName) + _tlOopts :: EHCOpts + _tlOuniq :: Int + _hdIcTrf :: CAlt + _hdIdebugLamMp :: LamMp + _hdIuniq :: Int + _tlIcTrf :: CAltL + _tlIdebugLamMp :: LamMp + _tlIuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _hdIdebugLamMp `Map.union` _tlIdebugLamMp + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _tlIuniq + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOuniq = + _lhsIuniq + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOuniq = + _hdIuniq + ( _hdIcTrf,_hdIdebugLamMp,_hdIuniq) = + hd_ _hdOevalCtx _hdOlamMp _hdOlev _hdOmbInStackTraceCtxt _hdOopts _hdOuniq + ( _tlIcTrf,_tlIdebugLamMp,_tlIuniq) = + tl_ _tlOevalCtx _tlOlamMp _tlOlev _tlOmbInStackTraceCtxt _tlOopts _tlOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CAltL + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + bindCTrfL : [CBind] + bindLamMp : LamMp + cTrf : CBind + debugLamMp : LamMp + nm : HsName + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : {CBind} +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( ([CBind]),LamMp,CBind,LamMp,HsName,Int) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBind + _lhsOcTrf :: CBind + _lhsOuniq :: Int + _bindAspectsOevalCtx :: EvalCtx + _bindAspectsOisGlobal :: Bool + _bindAspectsOlamMp :: LamMp + _bindAspectsOletBindingsCateg :: CBindCateg + _bindAspectsOlev :: Int + _bindAspectsOmbInStackTraceCtxt :: (Maybe HsName) + _bindAspectsOopts :: EHCOpts + _bindAspectsOuniq :: Int + _bindAspectsIbindCTrfL :: ([CBind]) + _bindAspectsIbindLamMp :: LamMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIdebugLamMp :: LamMp + _bindAspectsIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindAspectsIbindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _bindAspectsIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _bindAspectsIdebugLamMp + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _bindAspectsIuniq + -- copy rule (down) + _bindAspectsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindAspectsOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bindAspectsOopts = + _lhsIopts + -- copy rule (down) + _bindAspectsOuniq = + _lhsIuniq + ( _bindAspectsIbindCTrfL,_bindAspectsIbindLamMp,_bindAspectsIcTrf,_bindAspectsIdebugLamMp,_bindAspectsIuniq) = + bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOlamMp _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOmbInStackTraceCtxt _bindAspectsOnm _bindAspectsOopts _bindAspectsOuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOnm,_lhsOuniq))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CBindAnn + debugLamMp : LamMp + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CBindAnn,LamMp,Int) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBindAnn + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CBindAnnL + debugLamMp : LamMp + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CBindAnnL,LamMp,Int) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBindAnnL + _lhsOuniq :: Int + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOmbInStackTraceCtxt :: (Maybe HsName) + _hdOopts :: EHCOpts + _hdOuniq :: Int + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOmbInStackTraceCtxt :: (Maybe HsName) + _tlOopts :: EHCOpts + _tlOuniq :: Int + _hdIcTrf :: CBindAnn + _hdIdebugLamMp :: LamMp + _hdIuniq :: Int + _tlIcTrf :: CBindAnnL + _tlIdebugLamMp :: LamMp + _tlIuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _hdIdebugLamMp `Map.union` _tlIdebugLamMp + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _tlIuniq + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOuniq = + _lhsIuniq + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOuniq = + _hdIuniq + ( _hdIcTrf,_hdIdebugLamMp,_hdIuniq) = + hd_ _hdOlamMp _hdOlev _hdOmbInStackTraceCtxt _hdOopts _hdOuniq + ( _tlIcTrf,_tlIdebugLamMp,_tlIuniq) = + tl_ _tlOlamMp _tlOlev _tlOmbInStackTraceCtxt _tlOopts _tlOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBindAnnL + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + bindCTrfL : [CBind] + bindLamMp : LamMp + cTrf : CBindL + debugLamMp : LamMp + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( ([CBind]),LamMp,CBindL,LamMp,Int) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBindL + _lhsOuniq :: Int + _hdOevalCtx :: EvalCtx + _hdOisGlobal :: Bool + _hdOlamMp :: LamMp + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOmbInStackTraceCtxt :: (Maybe HsName) + _hdOopts :: EHCOpts + _hdOuniq :: Int + _tlOevalCtx :: EvalCtx + _tlOisGlobal :: Bool + _tlOlamMp :: LamMp + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOmbInStackTraceCtxt :: (Maybe HsName) + _tlOopts :: EHCOpts + _tlOuniq :: Int + _hdIbindCTrfL :: ([CBind]) + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBind + _hdIdebugLamMp :: LamMp + _hdInm :: HsName + _hdIuniq :: Int + _tlIbindCTrfL :: ([CBind]) + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBindL + _tlIdebugLamMp :: LamMp + _tlIuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _hdIbindCTrfL ++ _tlIbindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _hdIdebugLamMp `Map.union` _tlIdebugLamMp + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _tlIuniq + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOuniq = + _lhsIuniq + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOuniq = + _hdIuniq + ( _hdIbindCTrfL,_hdIbindLamMp,_hdIcTrf,_hdIdebugLamMp,_hdInm,_hdIuniq) = + hd_ _hdOevalCtx _hdOisGlobal _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOmbInStackTraceCtxt _hdOopts _hdOuniq + ( _tlIbindCTrfL,_tlIbindLamMp,_tlIcTrf,_tlIdebugLamMp,_tlIuniq) = + tl_ _tlOevalCtx _tlOisGlobal _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOmbInStackTraceCtxt _tlOopts _tlOuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBindL + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + mbInStackTraceCtxt : Maybe HsName + nm : HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + bindCTrfL : [CBind] + bindLamMp : LamMp + cTrf : CBound + debugLamMp : LamMp + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTraceCandidate : _ + local _tup1 : _ + local mbStackTrace : _ + local uniq : _ + local nmStackTrace : _ + local _tup2 : _ + local bindCTrfL : _ + local mbInStackTraceCtxt : _ + local newLamMp : _ + local cTrf : {CBound} + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local bindCTrfL : _ + local cTrf : {CBound} + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local bindCTrfL : _ + local cTrf : {CBound} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local bindCTrfL : _ + local cTrf : {CBound} + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local bindCTrfL : _ + local cTrf : {CBound} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local bindCTrfL : _ + local cTrf : {CBound} +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + (Maybe HsName) -> + HsName -> + EHCOpts -> + Int -> + ( ([CBind]),LamMp,CBound,LamMp,Int) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _lhsObindCTrfL :: ([CBind]) + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + _bindMetaOlamMp :: LamMp + _bindMetaOlev :: Int + _bindMetaOmbInStackTraceCtxt :: (Maybe HsName) + _bindMetaOopts :: EHCOpts + _bindMetaOuniq :: Int + _exprOevalCtx :: EvalCtx + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _bindMetaIcTrf :: CMetas + _bindMetaIdebugLamMp :: LamMp + _bindMetaIuniq :: Int + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 79, column 17) + _isTraceCandidate = + _lhsIisGlobal || _exprIisTraceCandidate + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 97, column 17) + __tup1 = + let mbt = mbStackTrace _lhsIopts _isTraceCandidate _lhsInm + in (mbt,Map.singleton _lhsInm (emptyLamInfo {laminfoStackTrace = mbt})) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 97, column 17) + (_mbStackTrace,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 97, column 17) + (_,_lhsObindLamMp) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 107, column 17) + _uniq = + _lhsIuniq + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 107, column 17) + _nmStackTrace = + mkHNm $ "_$" ++ show _lhsIuniq ++ "_stacktrace" + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 113, column 17) + __tup2 = + case _mbStackTrace of + StackTraceInfo_HasStackTraceEquiv dbNm | _isTraceCandidate + -> ( [ acoreBind1Cat CBindCateg_Plain dbNm (acoreLam1 _nmStackTrace _exprIcTrf) + , acoreBind1MetasTy _lhsInm _bindMetaIcTrf (acoreTyErr "ExplicitStackTrace.CBound.Bind") + $ acoreLam _exprItraceCandidateLamArgs + $ acoreApp (acoreVar dbNm) + ( acoreVar (ehcOptBuiltin _lhsIopts ehbnDataListAltNil) + : map acoreVar _exprItraceCandidateLamArgs + ) + ] + , Just _nmStackTrace + , Map.fromList + [ (dbNm, emptyLamInfo {laminfoStackTrace = StackTraceInfo_IsStackTraceEquiv _lhsInm}) + ] + ) + _ -> ([acoreBind1Asp1 _lhsInm _cTrf], _lhsImbInStackTraceCtxt, Map.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 113, column 17) + (_bindCTrfL,_,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 113, column 17) + (_,_mbInStackTraceCtxt,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 113, column 17) + (_,_,_newLamMp) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 152, column 17) + _lhsOdebugLamMp = + _newLamMp `Map.union` _exprIdebugLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (from local) + _lhsOuniq = + _uniq + -- copy rule (down) + _bindMetaOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (from local) + _bindMetaOmbInStackTraceCtxt = + _mbInStackTraceCtxt + -- copy rule (down) + _bindMetaOopts = + _lhsIopts + -- copy rule (from local) + _bindMetaOuniq = + _uniq + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (from local) + _exprOmbInStackTraceCtxt = + _mbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (from local) + _exprOuniq = + _uniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _bindMetaIcTrf,_bindMetaIdebugLamMp,_bindMetaIuniq) = + bindMeta_ _bindMetaOlamMp _bindMetaOlev _bindMetaOmbInStackTraceCtxt _bindMetaOopts _bindMetaOuniq + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + _cmetasOlamMp :: LamMp + _cmetasOlev :: Int + _cmetasOmbInStackTraceCtxt :: (Maybe HsName) + _cmetasOopts :: EHCOpts + _cmetasOuniq :: Int + _cmetasIcTrf :: CMetas + _cmetasIdebugLamMp :: LamMp + _cmetasIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 130, column 17) + _bindCTrfL = + [acoreBind1Asp1 _lhsInm _cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _cmetasIdebugLamMp + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _cmetasIuniq + -- copy rule (down) + _cmetasOlamMp = + _lhsIlamMp + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _cmetasOopts = + _lhsIopts + -- copy rule (down) + _cmetasOuniq = + _lhsIuniq + ( _cmetasIcTrf,_cmetasIdebugLamMp,_cmetasIuniq) = + cmetas_ _cmetasOlamMp _cmetasOlev _cmetasOmbInStackTraceCtxt _cmetasOopts _cmetasOuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 130, column 17) + _bindCTrfL = + [acoreBind1Asp1 _lhsInm _cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _whatAbove :: WhatExpr + _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 130, column 17) + _bindCTrfL = + [acoreBind1Asp1 _lhsInm _cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _exprIuniq + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 130, column 17) + _bindCTrfL = + [acoreBind1Asp1 _lhsInm _cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _cTrf :: CBound + _lhsOcTrf :: CBound + _lhsOuniq :: Int + _exprOevalCtx :: EvalCtx + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 81, column 17) + _whatAbove = + ExprIsLam 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 130, column 17) + _bindCTrfL = + [acoreBind1Asp1 _lhsInm _cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _bindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _exprIuniq + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + lamMp : LamMp + letBindingsCateg : CBindCateg + lev : Int + mbInStackTraceCtxt : Maybe HsName + nm : HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + bindCTrfL : [CBind] + bindLamMp : LamMp + cTrf : CBoundL + debugLamMp : LamMp + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + LamMp -> + CBindCateg -> + Int -> + (Maybe HsName) -> + HsName -> + EHCOpts -> + Int -> + ( ([CBind]),LamMp,CBoundL,LamMp,Int) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _hdOisTopApp :: Bool + _hdOisTopTup :: Bool + _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBoundL + _lhsOuniq :: Int + _hdOevalCtx :: EvalCtx + _hdOisGlobal :: Bool + _hdOlamMp :: LamMp + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOmbInStackTraceCtxt :: (Maybe HsName) + _hdOnm :: HsName + _hdOopts :: EHCOpts + _hdOuniq :: Int + _tlOevalCtx :: EvalCtx + _tlOisGlobal :: Bool + _tlOlamMp :: LamMp + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOmbInStackTraceCtxt :: (Maybe HsName) + _tlOnm :: HsName + _tlOopts :: EHCOpts + _tlOuniq :: Int + _hdIbindCTrfL :: ([CBind]) + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBound + _hdIdebugLamMp :: LamMp + _hdIuniq :: Int + _tlIbindCTrfL :: ([CBind]) + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBoundL + _tlIdebugLamMp :: LamMp + _tlIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopTup = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + _hdIbindCTrfL ++ _tlIbindCTrfL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _hdIdebugLamMp `Map.union` _tlIdebugLamMp + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _tlIuniq + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOuniq = + _lhsIuniq + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOuniq = + _hdIuniq + ( _hdIbindCTrfL,_hdIbindLamMp,_hdIcTrf,_hdIdebugLamMp,_hdIuniq) = + hd_ _hdOevalCtx _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOlamMp _hdOletBindingsCateg _hdOlev _hdOmbInStackTraceCtxt _hdOnm _hdOopts _hdOuniq + ( _tlIbindCTrfL,_tlIbindLamMp,_tlIcTrf,_tlIdebugLamMp,_tlIuniq) = + tl_ _tlOevalCtx _tlOisGlobal _tlOlamMp _tlOletBindingsCateg _tlOlev _tlOmbInStackTraceCtxt _tlOnm _tlOopts _tlOuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIlamMp + _lhsIletBindingsCateg + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsInm + _lhsIopts + _lhsIuniq -> + (let _lhsObindCTrfL :: ([CBind]) + _lhsObindLamMp :: LamMp + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CBoundL + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 110, column 30) + _lhsObindCTrfL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsObindCTrfL,_lhsObindLamMp,_lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isTopApp : Bool + isTopTup : Bool + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + whatAbove : WhatExpr + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CExpr + debugLamMp : LamMp + gathLamMp : LamMp + isTraceCandidate : Bool + traceCandidateLamArgs : [HsName] + traceCandidateLamBody : CExpr + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local nmAsp : {HsName} + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLet : _ + local evalCtx : _ + local isGlobal : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local letBindingsCateg : _ + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopApp' : _ + local isGlobal : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLam : _ + local lev : _ + local isGlobal : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CoeArg: + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + WhatExpr -> + ( CExpr,LamMp,LamMp,Bool,([HsName]),CExpr,Int,WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _nm :: HsName + _nmAsp :: HsName + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOcTrf :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 52, column 17) + _whatBelow = + ExprIsVar _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 137, column 17) + _lhsOcTrf = + case Map.lookup _nm _lhsIlamMp of + Just (LamInfo {laminfoStackTrace=StackTraceInfo_HasStackTraceEquiv dbNm}) + -> case _lhsImbInStackTraceCtxt of + Just stTrNm + -> acore1App (acoreVar dbNm) + (acoreApp (acoreVar hsnStackTracePush) [acoreBuiltinString _lhsIopts (show _nm), acoreVar stTrNm]) + _ -> _cTrf + _ -> _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Var ref_ + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 53, column 17) + _whatBelow = + ExprIsInt int_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 55, column 25) + _whatBelow = + ExprIsTup tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _bindsOlev :: Int + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOcTrf :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindsOevalCtx :: EvalCtx + _bindsOisGlobal :: Bool + _bindsOlamMp :: LamMp + _bindsOletBindingsCateg :: CBindCateg + _bindsOmbInStackTraceCtxt :: (Maybe HsName) + _bindsOopts :: EHCOpts + _bindsOuniq :: Int + _bodyOevalCtx :: EvalCtx + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOmbInStackTraceCtxt :: (Maybe HsName) + _bodyOopts :: EHCOpts + _bodyOuniq :: Int + _bodyOwhatAbove :: WhatExpr + _bindsIbindCTrfL :: ([CBind]) + _bindsIbindLamMp :: LamMp + _bindsIcTrf :: CBindL + _bindsIdebugLamMp :: LamMp + _bindsIuniq :: Int + _bodyIcTrf :: CExpr + _bodyIdebugLamMp :: LamMp + _bodyIgathLamMp :: LamMp + _bodyIisTraceCandidate :: Bool + _bodyItraceCandidateLamArgs :: ([HsName]) + _bodyItraceCandidateLamBody :: CExpr + _bodyIuniq :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 7, column 17) + _lhsOgathLamMp = + _bindsIbindLamMp `Map.union` _bodyIgathLamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 4, column 17) + _letBindingsCateg = + categ_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 75, column 17) + _isTopLet = + _lhsIwhatAbove == ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, column 17) + _evalCtx = + if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLet.ag"(line 2, column 17) + _bindsOlev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 136, column 17) + _lhsOcTrf = + CExpr_Let categ_ _bindsIbindCTrfL _bodyIcTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _bindsIdebugLamMp `Map.union` _bodyIdebugLamMp + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- copy rule (up) + _lhsOuniq = + _bodyIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (from local) + _bindsOevalCtx = + _evalCtx + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (from local) + _bindsOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _bindsOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bindsOopts = + _lhsIopts + -- copy rule (down) + _bindsOuniq = + _lhsIuniq + -- copy rule (from local) + _bodyOevalCtx = + _evalCtx + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (chain) + _bodyOuniq = + _bindsIuniq + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindsIbindCTrfL,_bindsIbindLamMp,_bindsIcTrf,_bindsIdebugLamMp,_bindsIuniq) = + binds_ _bindsOevalCtx _bindsOisGlobal _bindsOlamMp _bindsOletBindingsCateg _bindsOlev _bindsOmbInStackTraceCtxt _bindsOopts _bindsOuniq + ( _bodyIcTrf,_bodyIdebugLamMp,_bodyIgathLamMp,_bodyIisTraceCandidate,_bodyItraceCandidateLamArgs,_bodyItraceCandidateLamBody,_bodyIuniq,_bodyIwhatBelow) = + body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmbInStackTraceCtxt _bodyOopts _bodyOuniq _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _argOnm :: HsName + _funcOisTopApp :: Bool + _argOisTopApp :: Bool + _whatAbove :: WhatExpr + _argOevalCtx :: EvalCtx + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOevalCtx :: EvalCtx + _funcOisTopTup :: Bool + _funcOlamMp :: LamMp + _funcOlev :: Int + _funcOmbInStackTraceCtxt :: (Maybe HsName) + _funcOopts :: EHCOpts + _funcOuniq :: Int + _funcOwhatAbove :: WhatExpr + _argOisGlobal :: Bool + _argOisTopTup :: Bool + _argOlamMp :: LamMp + _argOletBindingsCateg :: CBindCateg + _argOlev :: Int + _argOmbInStackTraceCtxt :: (Maybe HsName) + _argOopts :: EHCOpts + _argOuniq :: Int + _funcIcTrf :: CExpr + _funcIdebugLamMp :: LamMp + _funcIgathLamMp :: LamMp + _funcIisTraceCandidate :: Bool + _funcItraceCandidateLamArgs :: ([HsName]) + _funcItraceCandidateLamBody :: CExpr + _funcIuniq :: Int + _funcIwhatBelow :: WhatExpr + _argIbindCTrfL :: ([CBind]) + _argIbindLamMp :: LamMp + _argIcTrf :: CBound + _argIdebugLamMp :: LamMp + _argIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 14, column 17) + _funcOisTopApp = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 15, column 17) + _argOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 54, column 17) + _whatBelow = + maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 70, column 17) + _whatAbove = + maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 77, column 17) + _isTopApp' = + isNothing $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 112, column 17) + _argOevalCtx = + EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _funcIdebugLamMp `Map.union` _argIdebugLamMp + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _argIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _funcOopts = + _lhsIopts + -- copy rule (down) + _funcOuniq = + _lhsIuniq + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (from local) + _argOisTopTup = + _isTopTup + -- copy rule (down) + _argOlamMp = + _lhsIlamMp + -- copy rule (from local) + _argOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _argOopts = + _lhsIopts + -- copy rule (chain) + _argOuniq = + _funcIuniq + ( _funcIcTrf,_funcIdebugLamMp,_funcIgathLamMp,_funcIisTraceCandidate,_funcItraceCandidateLamArgs,_funcItraceCandidateLamBody,_funcIuniq,_funcIwhatBelow) = + func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlamMp _funcOlev _funcOmbInStackTraceCtxt _funcOopts _funcOuniq _funcOwhatAbove + ( _argIbindCTrfL,_argIbindLamMp,_argIcTrf,_argIdebugLamMp,_argIuniq) = + arg_ _argOevalCtx _argOisGlobal _argOisTopApp _argOisTopTup _argOlamMp _argOletBindingsCateg _argOlev _argOmbInStackTraceCtxt _argOnm _argOopts _argOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _bodyOlamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindOevalCtx :: EvalCtx + _bindOisGlobal :: Bool + _bindOlamMp :: LamMp + _bindOletBindingsCateg :: CBindCateg + _bindOlev :: Int + _bindOmbInStackTraceCtxt :: (Maybe HsName) + _bindOopts :: EHCOpts + _bindOuniq :: Int + _bodyOevalCtx :: EvalCtx + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlev :: Int + _bodyOmbInStackTraceCtxt :: (Maybe HsName) + _bodyOopts :: EHCOpts + _bodyOuniq :: Int + _bodyOwhatAbove :: WhatExpr + _bindIbindCTrfL :: ([CBind]) + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindIdebugLamMp :: LamMp + _bindInm :: HsName + _bindIuniq :: Int + _bodyIcTrf :: CExpr + _bodyIdebugLamMp :: LamMp + _bodyIgathLamMp :: LamMp + _bodyIisTraceCandidate :: Bool + _bodyItraceCandidateLamArgs :: ([HsName]) + _bodyItraceCandidateLamBody :: CExpr + _bodyIuniq :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLamInfo.ag"(line 7, column 17) + _bodyOlamMp = + Map.delete _argNm _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 51, column 17) + _whatBelow = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) + _whatAbove = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 76, column 17) + _isTopLam = + not $ whatExprIsLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 65, column 17) + _lhsOisTraceCandidate = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 65, column 17) + _lhsOtraceCandidateLamArgs = + _argNm : _bodyItraceCandidateLamArgs + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 65, column 17) + _lhsOtraceCandidateLamBody = + _bodyItraceCandidateLamBody + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _bindIdebugLamMp `Map.union` _bodyIdebugLamMp + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _bodyIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (from local) + _bindOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (down) + _bindOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (down) + _bindOuniq = + _lhsIuniq + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (down) + _bodyOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (chain) + _bodyOuniq = + _bindIuniq + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindIbindCTrfL,_bindIbindLamMp,_bindIcTrf,_bindIdebugLamMp,_bindInm,_bindIuniq) = + bind_ _bindOevalCtx _bindOisGlobal _bindOlamMp _bindOletBindingsCateg _bindOlev _bindOmbInStackTraceCtxt _bindOopts _bindOuniq + ( _bodyIcTrf,_bodyIdebugLamMp,_bodyIgathLamMp,_bodyIisTraceCandidate,_bodyItraceCandidateLamArgs,_bodyItraceCandidateLamBody,_bodyIuniq,_bodyIwhatBelow) = + body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmbInStackTraceCtxt _bodyOopts _bodyOuniq _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _altsOevalCtx :: EvalCtx + _altsOlamMp :: LamMp + _altsOlev :: Int + _altsOmbInStackTraceCtxt :: (Maybe HsName) + _altsOopts :: EHCOpts + _altsOuniq :: Int + _dfltOevalCtx :: EvalCtx + _dfltOisTopApp :: Bool + _dfltOisTopTup :: Bool + _dfltOlamMp :: LamMp + _dfltOlev :: Int + _dfltOmbInStackTraceCtxt :: (Maybe HsName) + _dfltOopts :: EHCOpts + _dfltOuniq :: Int + _dfltOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + _altsIcTrf :: CAltL + _altsIdebugLamMp :: LamMp + _altsIuniq :: Int + _dfltIcTrf :: CExpr + _dfltIdebugLamMp :: LamMp + _dfltIgathLamMp :: LamMp + _dfltIisTraceCandidate :: Bool + _dfltItraceCandidateLamArgs :: ([HsName]) + _dfltItraceCandidateLamBody :: CExpr + _dfltIuniq :: Int + _dfltIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp `Map.union` _altsIdebugLamMp `Map.union` _dfltIdebugLamMp + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _dfltIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOisTopTup = + _isTopTup + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _altsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _altsOlamMp = + _lhsIlamMp + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _altsOopts = + _lhsIopts + -- copy rule (chain) + _altsOuniq = + _exprIuniq + -- copy rule (down) + _dfltOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _dfltOisTopApp = + _isTopApp + -- copy rule (from local) + _dfltOisTopTup = + _isTopTup + -- copy rule (down) + _dfltOlamMp = + _lhsIlamMp + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _dfltOopts = + _lhsIopts + -- copy rule (chain) + _dfltOuniq = + _altsIuniq + -- copy rule (from local) + _dfltOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + ( _altsIcTrf,_altsIdebugLamMp,_altsIuniq) = + alts_ _altsOevalCtx _altsOlamMp _altsOlev _altsOmbInStackTraceCtxt _altsOopts _altsOuniq + ( _dfltIcTrf,_dfltIdebugLamMp,_dfltIgathLamMp,_dfltIisTraceCandidate,_dfltItraceCandidateLamArgs,_dfltItraceCandidateLamBody,_dfltIuniq,_dfltIwhatBelow) = + dflt_ _dfltOevalCtx _dfltOisTopApp _dfltOisTopTup _dfltOlamMp _dfltOlev _dfltOmbInStackTraceCtxt _dfltOopts _dfltOuniq _dfltOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOgathLamMp :: LamMp + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _errorExprOevalCtx :: EvalCtx + _errorExprOisTopApp :: Bool + _errorExprOisTopTup :: Bool + _errorExprOlamMp :: LamMp + _errorExprOlev :: Int + _errorExprOmbInStackTraceCtxt :: (Maybe HsName) + _errorExprOopts :: EHCOpts + _errorExprOuniq :: Int + _errorExprOwhatAbove :: WhatExpr + _errorExprIcTrf :: CExpr + _errorExprIdebugLamMp :: LamMp + _errorExprIgathLamMp :: LamMp + _errorExprIisTraceCandidate :: Bool + _errorExprItraceCandidateLamArgs :: ([HsName]) + _errorExprItraceCandidateLamBody :: CExpr + _errorExprIuniq :: Int + _errorExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _errorExprIdebugLamMp + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgathLamMp = + _errorExprIgathLamMp + -- copy rule (up) + _lhsOuniq = + _errorExprIuniq + -- copy rule (up) + _lhsOwhatBelow = + _errorExprIwhatBelow + -- copy rule (down) + _errorExprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _errorExprOisTopApp = + _isTopApp + -- copy rule (from local) + _errorExprOisTopTup = + _isTopTup + -- copy rule (down) + _errorExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _errorExprOopts = + _lhsIopts + -- copy rule (down) + _errorExprOuniq = + _lhsIuniq + -- copy rule (from local) + _errorExprOwhatAbove = + _whatAbove + ( _errorExprIcTrf,_errorExprIdebugLamMp,_errorExprIgathLamMp,_errorExprIisTraceCandidate,_errorExprItraceCandidateLamArgs,_errorExprItraceCandidateLamBody,_errorExprIuniq,_errorExprIwhatBelow) = + errorExpr_ _errorExprOevalCtx _errorExprOisTopApp _errorExprOisTopTup _errorExprOlamMp _errorExprOlev _errorExprOmbInStackTraceCtxt _errorExprOopts _errorExprOuniq _errorExprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOmbInStackTraceCtxt :: (Maybe HsName) + _offsetOopts :: EHCOpts + _offsetOuniq :: Int + _offsetOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIdebugLamMp :: LamMp + _offsetIgathLamMp :: LamMp + _offsetIisTraceCandidate :: Bool + _offsetItraceCandidateLamArgs :: ([HsName]) + _offsetItraceCandidateLamBody :: CExpr + _offsetIuniq :: Int + _offsetIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp `Map.union` _offsetIdebugLamMp + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _offsetIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOuniq = + _exprIuniq + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + ( _offsetIcTrf,_offsetIdebugLamMp,_offsetIgathLamMp,_offsetIisTraceCandidate,_offsetItraceCandidateLamArgs,_offsetItraceCandidateLamBody,_offsetIuniq,_offsetIwhatBelow) = + offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmbInStackTraceCtxt _offsetOopts _offsetOuniq _offsetOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOmbInStackTraceCtxt :: (Maybe HsName) + _offsetOopts :: EHCOpts + _offsetOuniq :: Int + _offsetOwhatAbove :: WhatExpr + _fldExprOevalCtx :: EvalCtx + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamMp :: LamMp + _fldExprOlev :: Int + _fldExprOmbInStackTraceCtxt :: (Maybe HsName) + _fldExprOopts :: EHCOpts + _fldExprOuniq :: Int + _fldExprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIdebugLamMp :: LamMp + _offsetIgathLamMp :: LamMp + _offsetIisTraceCandidate :: Bool + _offsetItraceCandidateLamArgs :: ([HsName]) + _offsetItraceCandidateLamBody :: CExpr + _offsetIuniq :: Int + _offsetIwhatBelow :: WhatExpr + _fldExprIcTrf :: CExpr + _fldExprIdebugLamMp :: LamMp + _fldExprIgathLamMp :: LamMp + _fldExprIisTraceCandidate :: Bool + _fldExprItraceCandidateLamArgs :: ([HsName]) + _fldExprItraceCandidateLamBody :: CExpr + _fldExprIuniq :: Int + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp `Map.union` _offsetIdebugLamMp `Map.union` _fldExprIdebugLamMp + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _fldExprIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOuniq = + _exprIuniq + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _fldExprOopts = + _lhsIopts + -- copy rule (chain) + _fldExprOuniq = + _offsetIuniq + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + ( _offsetIcTrf,_offsetIdebugLamMp,_offsetIgathLamMp,_offsetIisTraceCandidate,_offsetItraceCandidateLamArgs,_offsetItraceCandidateLamBody,_offsetIuniq,_offsetIwhatBelow) = + offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmbInStackTraceCtxt _offsetOopts _offsetOuniq _offsetOwhatAbove + ( _fldExprIcTrf,_fldExprIdebugLamMp,_fldExprIgathLamMp,_fldExprIisTraceCandidate,_fldExprItraceCandidateLamArgs,_fldExprItraceCandidateLamBody,_fldExprIuniq,_fldExprIwhatBelow) = + fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamMp _fldExprOlev _fldExprOmbInStackTraceCtxt _fldExprOopts _fldExprOuniq _fldExprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOmbInStackTraceCtxt :: (Maybe HsName) + _offsetOopts :: EHCOpts + _offsetOuniq :: Int + _offsetOwhatAbove :: WhatExpr + _fldExprOevalCtx :: EvalCtx + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamMp :: LamMp + _fldExprOlev :: Int + _fldExprOmbInStackTraceCtxt :: (Maybe HsName) + _fldExprOopts :: EHCOpts + _fldExprOuniq :: Int + _fldExprOwhatAbove :: WhatExpr + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + _offsetIcTrf :: CExpr + _offsetIdebugLamMp :: LamMp + _offsetIgathLamMp :: LamMp + _offsetIisTraceCandidate :: Bool + _offsetItraceCandidateLamArgs :: ([HsName]) + _offsetItraceCandidateLamBody :: CExpr + _offsetIuniq :: Int + _offsetIwhatBelow :: WhatExpr + _fldExprIcTrf :: CExpr + _fldExprIdebugLamMp :: LamMp + _fldExprIgathLamMp :: LamMp + _fldExprIisTraceCandidate :: Bool + _fldExprItraceCandidateLamArgs :: ([HsName]) + _fldExprItraceCandidateLamBody :: CExpr + _fldExprIuniq :: Int + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp `Map.union` _offsetIdebugLamMp `Map.union` _fldExprIdebugLamMp + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _fldExprIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (chain) + _offsetOuniq = + _exprIuniq + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _fldExprOopts = + _lhsIopts + -- copy rule (chain) + _fldExprOuniq = + _offsetIuniq + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + ( _offsetIcTrf,_offsetIdebugLamMp,_offsetIgathLamMp,_offsetIisTraceCandidate,_offsetItraceCandidateLamArgs,_offsetItraceCandidateLamBody,_offsetIuniq,_offsetIwhatBelow) = + offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmbInStackTraceCtxt _offsetOopts _offsetOuniq _offsetOwhatAbove + ( _fldExprIcTrf,_fldExprIdebugLamMp,_fldExprIgathLamMp,_fldExprIisTraceCandidate,_fldExprItraceCandidateLamArgs,_fldExprItraceCandidateLamBody,_fldExprIuniq,_fldExprIwhatBelow) = + fldExpr_ _fldExprOevalCtx _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamMp _fldExprOlev _fldExprOmbInStackTraceCtxt _fldExprOopts _fldExprOuniq _fldExprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 56, column 25) + _whatBelow = + ExprIsFFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOevalCtx :: EvalCtx + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOmbInStackTraceCtxt :: (Maybe HsName) + _bodyOopts :: EHCOpts + _bodyOuniq :: Int + _bodyOwhatAbove :: WhatExpr + _bodyIcTrf :: CExpr + _bodyIdebugLamMp :: LamMp + _bodyIgathLamMp :: LamMp + _bodyIisTraceCandidate :: Bool + _bodyItraceCandidateLamArgs :: ([HsName]) + _bodyItraceCandidateLamBody :: CExpr + _bodyIuniq :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _bodyIdebugLamMp + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _bodyIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (down) + _bodyOuniq = + _lhsIuniq + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIcTrf,_bodyIdebugLamMp,_bodyIgathLamMp,_bodyIisTraceCandidate,_bodyItraceCandidateLamArgs,_bodyItraceCandidateLamBody,_bodyIuniq,_bodyIwhatBelow) = + body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmbInStackTraceCtxt _bodyOopts _bodyOuniq _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOevalCtx :: EvalCtx + _funcOisTopApp :: Bool + _funcOisTopTup :: Bool + _funcOlamMp :: LamMp + _funcOlev :: Int + _funcOmbInStackTraceCtxt :: (Maybe HsName) + _funcOopts :: EHCOpts + _funcOuniq :: Int + _funcOwhatAbove :: WhatExpr + _funcIcTrf :: CExpr + _funcIdebugLamMp :: LamMp + _funcIgathLamMp :: LamMp + _funcIisTraceCandidate :: Bool + _funcItraceCandidateLamArgs :: ([HsName]) + _funcItraceCandidateLamBody :: CExpr + _funcIuniq :: Int + _funcIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _funcIdebugLamMp + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _funcIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _funcOisTopApp = + _isTopApp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _funcOopts = + _lhsIopts + -- copy rule (down) + _funcOuniq = + _lhsIuniq + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + ( _funcIcTrf,_funcIdebugLamMp,_funcIgathLamMp,_funcIisTraceCandidate,_funcItraceCandidateLamArgs,_funcItraceCandidateLamBody,_funcIuniq,_funcIwhatBelow) = + func_ _funcOevalCtx _funcOisTopApp _funcOisTopTup _funcOlamMp _funcOlev _funcOmbInStackTraceCtxt _funcOopts _funcOuniq _funcOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOgathLamMp :: LamMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOevalCtx :: EvalCtx + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamMp :: LamMp + _bodyOlev :: Int + _bodyOmbInStackTraceCtxt :: (Maybe HsName) + _bodyOopts :: EHCOpts + _bodyOuniq :: Int + _bodyOwhatAbove :: WhatExpr + _bodyIcTrf :: CExpr + _bodyIdebugLamMp :: LamMp + _bodyIgathLamMp :: LamMp + _bodyIisTraceCandidate :: Bool + _bodyItraceCandidateLamArgs :: ([HsName]) + _bodyItraceCandidateLamBody :: CExpr + _bodyIuniq :: Int + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _bodyIdebugLamMp + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _bodyIuniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bodyOopts = + _lhsIopts + -- copy rule (down) + _bodyOuniq = + _lhsIuniq + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIcTrf,_bodyIdebugLamMp,_bodyIgathLamMp,_bodyIisTraceCandidate,_bodyItraceCandidateLamArgs,_bodyItraceCandidateLamBody,_bodyIuniq,_bodyIwhatBelow) = + body_ _bodyOevalCtx _bodyOisTopApp _bodyOisTopTup _bodyOlamMp _bodyOlev _bodyOmbInStackTraceCtxt _bodyOopts _bodyOuniq _bodyOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq + _lhsIwhatAbove -> + (let _lhsOisTraceCandidate :: Bool + _lhsOtraceCandidateLamArgs :: ([HsName]) + _lhsOtraceCandidateLamBody :: CExpr + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOgathLamMp :: LamMp + _lhsOuniq :: Int + _lhsOwhatBelow :: WhatExpr + _annOlamMp :: LamMp + _annOlev :: Int + _annOmbInStackTraceCtxt :: (Maybe HsName) + _annOopts :: EHCOpts + _annOuniq :: Int + _exprOevalCtx :: EvalCtx + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _annIcTrf :: CExprAnn + _annIdebugLamMp :: LamMp + _annIuniq :: Int + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOisTraceCandidate = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamArgs = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 71, column 17) + _lhsOtraceCandidateLamBody = + _cTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _annIdebugLamMp `Map.union` _exprIdebugLamMp + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (up) + _lhsOuniq = + _exprIuniq + -- copy rule (up) + _lhsOwhatBelow = + _exprIwhatBelow + -- copy rule (down) + _annOlamMp = + _lhsIlamMp + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _annOopts = + _lhsIopts + -- copy rule (down) + _annOuniq = + _lhsIuniq + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (chain) + _exprOuniq = + _annIuniq + -- copy rule (down) + _exprOwhatAbove = + _lhsIwhatAbove + ( _annIcTrf,_annIdebugLamMp,_annIuniq) = + ann_ _annOlamMp _annOlev _annOmbInStackTraceCtxt _annOopts _annOuniq + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOisTraceCandidate,_lhsOtraceCandidateLamArgs,_lhsOtraceCandidateLamBody,_lhsOuniq,_lhsOwhatBelow))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CExprAnn + debugLamMp : LamMp + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CExprAnn,LamMp,Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExprAnn + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExprAnn + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CExprAnn + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CMetaBind + debugLamMp : LamMp + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CMetaBind,LamMp,Int) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaBind + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaBind + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaBind + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaBind + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CMetaVal + debugLamMp : LamMp + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CMetaVal,LamMp,Int) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaVal + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaVal + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaVal + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaVal + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetaVal + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CMetas + debugLamMp : LamMp + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CMetas,LamMp,Int) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CMetas + _lhsOuniq :: Int + _x1OlamMp :: LamMp + _x1Olev :: Int + _x1OmbInStackTraceCtxt :: (Maybe HsName) + _x1Oopts :: EHCOpts + _x1Ouniq :: Int + _x2OlamMp :: LamMp + _x2Olev :: Int + _x2OmbInStackTraceCtxt :: (Maybe HsName) + _x2Oopts :: EHCOpts + _x2Ouniq :: Int + _x1IcTrf :: CMetaBind + _x1IdebugLamMp :: LamMp + _x1Iuniq :: Int + _x2IcTrf :: CMetaVal + _x2IdebugLamMp :: LamMp + _x2Iuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _x1IdebugLamMp `Map.union` _x2IdebugLamMp + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _x2Iuniq + -- copy rule (down) + _x1OlamMp = + _lhsIlamMp + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1OmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _x1Oopts = + _lhsIopts + -- copy rule (down) + _x1Ouniq = + _lhsIuniq + -- copy rule (down) + _x2OlamMp = + _lhsIlamMp + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2OmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _x2Oopts = + _lhsIopts + -- copy rule (chain) + _x2Ouniq = + _x1Iuniq + ( _x1IcTrf,_x1IdebugLamMp,_x1Iuniq) = + x1_ _x1OlamMp _x1Olev _x1OmbInStackTraceCtxt _x1Oopts _x1Ouniq + ( _x2IcTrf,_x2IdebugLamMp,_x2Iuniq) = + x2_ _x2OlamMp _x2Olev _x2OmbInStackTraceCtxt _x2Oopts _x2Ouniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CModule + debugLamMp : LamMp + gathLamMp : LamMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local mbInStackTraceCtxt : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = LamMp -> + Int -> + EHCOpts -> + Int -> + ( CModule,LamMp,LamMp,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlamMp + _lhsIlev + _lhsIopts + _lhsIuniq -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOevalCtx :: EvalCtx + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CModule + _lhsOgathLamMp :: LamMp + _lhsOuniq :: Int + _exprOlamMp :: LamMp + _exprOlev :: Int + _exprOmbInStackTraceCtxt :: (Maybe HsName) + _exprOopts :: EHCOpts + _exprOuniq :: Int + _exprOwhatAbove :: WhatExpr + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIcTrf :: CExpr + _exprIdebugLamMp :: LamMp + _exprIgathLamMp :: LamMp + _exprIisTraceCandidate :: Bool + _exprItraceCandidateLamArgs :: ([HsName]) + _exprItraceCandidateLamBody :: CExpr + _exprIuniq :: Int + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 90, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 99, column 17) + _exprOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 85, column 17) + _mbInStackTraceCtxt = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _exprIdebugLamMp + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (up) + _lhsOuniq = + _exprIuniq + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (from local) + _exprOmbInStackTraceCtxt = + _mbInStackTraceCtxt + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _exprOuniq = + _lhsIuniq + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIcTrf,_exprIdebugLamMp,_exprIgathLamMp,_exprIisTraceCandidate,_exprItraceCandidateLamArgs,_exprItraceCandidateLamBody,_exprIuniq,_exprIwhatBelow) = + expr_ _exprOevalCtx _exprOisTopApp _exprOisTopTup _exprOlamMp _exprOlev _exprOmbInStackTraceCtxt _exprOopts _exprOuniq _exprOwhatAbove + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp,_lhsOuniq))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CPat + debugLamMp : LamMp + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CPat,LamMp,([HsName]),Int) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOuniq :: Int + _restOlamMp :: LamMp + _restOlev :: Int + _restOmbInStackTraceCtxt :: (Maybe HsName) + _restOopts :: EHCOpts + _restOuniq :: Int + _bindsOlamMp :: LamMp + _bindsOlev :: Int + _bindsOmbInStackTraceCtxt :: (Maybe HsName) + _bindsOopts :: EHCOpts + _bindsOuniq :: Int + _restIcTrf :: CPatRest + _restIdebugLamMp :: LamMp + _restIuniq :: Int + _bindsIcTrf :: CPatFldL + _bindsIdebugLamMp :: LamMp + _bindsIfldNmL :: ([HsName]) + _bindsIuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _restIdebugLamMp `Map.union` _bindsIdebugLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _bindsIuniq + -- copy rule (down) + _restOlamMp = + _lhsIlamMp + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _restOopts = + _lhsIopts + -- copy rule (down) + _restOuniq = + _lhsIuniq + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bindsOopts = + _lhsIopts + -- copy rule (chain) + _bindsOuniq = + _restIuniq + ( _restIcTrf,_restIdebugLamMp,_restIuniq) = + rest_ _restOlamMp _restOlev _restOmbInStackTraceCtxt _restOopts _restOuniq + ( _bindsIcTrf,_bindsIdebugLamMp,_bindsIfldNmL,_bindsIuniq) = + binds_ _bindsOlamMp _bindsOlev _bindsOmbInStackTraceCtxt _bindsOopts _bindsOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CPatFld + debugLamMp : LamMp + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CPatFld,LamMp,([HsName]),Int) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOfldNmL :: ([HsName]) + _bindOletBindingsCateg :: CBindCateg + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _whatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _bindOevalCtx :: EvalCtx + _bindOisGlobal :: Bool + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CPatFld + _lhsOuniq :: Int + _offsetOlamMp :: LamMp + _offsetOlev :: Int + _offsetOmbInStackTraceCtxt :: (Maybe HsName) + _offsetOopts :: EHCOpts + _offsetOuniq :: Int + _offsetOwhatAbove :: WhatExpr + _bindOlamMp :: LamMp + _bindOlev :: Int + _bindOmbInStackTraceCtxt :: (Maybe HsName) + _bindOopts :: EHCOpts + _bindOuniq :: Int + _fldAnnsOlamMp :: LamMp + _fldAnnsOlev :: Int + _fldAnnsOmbInStackTraceCtxt :: (Maybe HsName) + _fldAnnsOopts :: EHCOpts + _fldAnnsOuniq :: Int + _offsetIcTrf :: CExpr + _offsetIdebugLamMp :: LamMp + _offsetIgathLamMp :: LamMp + _offsetIisTraceCandidate :: Bool + _offsetItraceCandidateLamArgs :: ([HsName]) + _offsetItraceCandidateLamBody :: CExpr + _offsetIuniq :: Int + _offsetIwhatBelow :: WhatExpr + _bindIbindCTrfL :: ([CBind]) + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindIdebugLamMp :: LamMp + _bindInm :: HsName + _bindIuniq :: Int + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIdebugLamMp :: LamMp + _fldAnnsIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 9, column 17) + _bindOletBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 84, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) + _offsetOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 103, column 33) + _bindOevalCtx = + EvalCtx_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _offsetIdebugLamMp `Map.union` _bindIdebugLamMp `Map.union` _fldAnnsIdebugLamMp + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _fldAnnsIuniq + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (down) + _offsetOuniq = + _lhsIuniq + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (chain) + _bindOuniq = + _offsetIuniq + -- copy rule (down) + _fldAnnsOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _fldAnnsOopts = + _lhsIopts + -- copy rule (chain) + _fldAnnsOuniq = + _bindIuniq + ( _offsetIcTrf,_offsetIdebugLamMp,_offsetIgathLamMp,_offsetIisTraceCandidate,_offsetItraceCandidateLamArgs,_offsetItraceCandidateLamBody,_offsetIuniq,_offsetIwhatBelow) = + offset_ _offsetOevalCtx _offsetOisTopApp _offsetOisTopTup _offsetOlamMp _offsetOlev _offsetOmbInStackTraceCtxt _offsetOopts _offsetOuniq _offsetOwhatAbove + ( _bindIbindCTrfL,_bindIbindLamMp,_bindIcTrf,_bindIdebugLamMp,_bindInm,_bindIuniq) = + bind_ _bindOevalCtx _bindOisGlobal _bindOlamMp _bindOletBindingsCateg _bindOlev _bindOmbInStackTraceCtxt _bindOopts _bindOuniq + ( _fldAnnsIcTrf,_fldAnnsIdebugLamMp,_fldAnnsIuniq) = + fldAnns_ _fldAnnsOlamMp _fldAnnsOlev _fldAnnsOmbInStackTraceCtxt _fldAnnsOopts _fldAnnsOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CPatFldL + debugLamMp : LamMp + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CPatFldL,LamMp,([HsName]),Int) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOuniq :: Int + _hdOlamMp :: LamMp + _hdOlev :: Int + _hdOmbInStackTraceCtxt :: (Maybe HsName) + _hdOopts :: EHCOpts + _hdOuniq :: Int + _tlOlamMp :: LamMp + _tlOlev :: Int + _tlOmbInStackTraceCtxt :: (Maybe HsName) + _tlOopts :: EHCOpts + _tlOuniq :: Int + _hdIcTrf :: CPatFld + _hdIdebugLamMp :: LamMp + _hdIfldNmL :: ([HsName]) + _hdIuniq :: Int + _tlIcTrf :: CPatFldL + _tlIdebugLamMp :: LamMp + _tlIfldNmL :: ([HsName]) + _tlIuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _hdIdebugLamMp `Map.union` _tlIdebugLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOuniq = + _tlIuniq + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOuniq = + _lhsIuniq + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOmbInStackTraceCtxt = + _lhsImbInStackTraceCtxt + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOuniq = + _hdIuniq + ( _hdIcTrf,_hdIdebugLamMp,_hdIfldNmL,_hdIuniq) = + hd_ _hdOlamMp _hdOlev _hdOmbInStackTraceCtxt _hdOopts _hdOuniq + ( _tlIcTrf,_tlIdebugLamMp,_tlIfldNmL,_tlIuniq) = + tl_ _tlOlamMp _tlOlev _tlOmbInStackTraceCtxt _tlOopts _tlOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOfldNmL,_lhsOuniq))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + lev : Int + mbInStackTraceCtxt : Maybe HsName + opts : EHCOpts + chained attribute: + uniq : Int + synthesized attributes: + cTrf : CPatRest + debugLamMp : LamMp + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = LamMp -> + Int -> + (Maybe HsName) -> + EHCOpts -> + Int -> + ( CPatRest,LamMp,Int) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CPatRest + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlamMp + _lhsIlev + _lhsImbInStackTraceCtxt + _lhsIopts + _lhsIuniq -> + (let _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CPatRest + _lhsOuniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + Map.empty + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOuniq = + _lhsIuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOuniq))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + debugLamMp : LamMp + gathLamMp : LamMp + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local gathLamMp : _ + local howUnionGathLamInfo : _ + local howMergeLamInfo : _ + local uniq : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = LamMp -> + EHCOpts -> + ( CModule,LamMp,LamMp) +data Inh_CodeAGItf = Inh_CodeAGItf {lamMp_Inh_CodeAGItf :: !(LamMp),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule),debugLamMp_Syn_CodeAGItf :: !(LamMp),gathLamMp_Syn_CodeAGItf :: !(LamMp)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIlamMp _lhsIopts) = + (let ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp) = sem _lhsIlamMp _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf _lhsOdebugLamMp _lhsOgathLamMp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _moduleOlamMp :: LamMp + _moduleOlev :: Int + _lhsOdebugLamMp :: LamMp + _lhsOcTrf :: CModule + _lhsOgathLamMp :: LamMp + _moduleOopts :: EHCOpts + _moduleOuniq :: Int + _moduleIcTrf :: CModule + _moduleIdebugLamMp :: LamMp + _moduleIgathLamMp :: LamMp + _moduleIuniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 15, column 17) + _gathLamMp = + lamMpMergeInto _howMergeLamInfo const _moduleIgathLamMp _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 16, column 17) + _moduleOlamMp = + _howUnionGathLamInfo _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 53, column 17) + _howUnionGathLamInfo = + Map.union _gathLamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 57, column 17) + _howMergeLamInfo = + (\(LamInfo {laminfoStackTrace=t}) i -> i {laminfoStackTrace=t}) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 104, column 17) + _uniq = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.ag"(line 149, column 22) + _lhsOdebugLamMp = + _moduleIdebugLamMp + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + -- copy rule (from local) + _lhsOgathLamMp = + _gathLamMp + -- copy rule (down) + _moduleOopts = + _lhsIopts + -- copy rule (from local) + _moduleOuniq = + _uniq + ( _moduleIcTrf,_moduleIdebugLamMp,_moduleIgathLamMp,_moduleIuniq) = + module_ _moduleOlamMp _moduleOlev _moduleOopts _moduleOuniq + in ( _lhsOcTrf,_lhsOdebugLamMp,_lhsOgathLamMp))) diff --git a/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs b/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs @@ -0,0 +1,1768 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/FixAf) +module UHC.Light.Compiler.Core.Trf.FixAfterParse(cmodTrfFixAfterParse) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore + + + + + + + +cmodTrfFixAfterParse + :: DataGam + -> CModule + -> CModule +cmodTrfFixAfterParse dataGam cmod + = ( cTrf_Syn_CodeAGItf t + ) + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { dataGam_Inh_CodeAGItf = dataGam + }) + + + + +fixCTag :: DataGam -> CTag -> CTag +fixCTag g (t@(CTag {ctagTyNm=tn, ctagNm=cn})) = maybe t id $ dataGamLookupTag tn cn g +fixCTag _ t = t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = DataGam -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _patOdataGam | _patOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (pat_ _patOdataGam) of + { ( _patIcTrf) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = DataGam -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (tl_ _tlOdataGam) of + { ( _tlIcTrf) | True -> + (case (hd_ _hdOdataGam) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIdataGam -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = DataGam -> + ( CBind) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bindAspectsOdataGam | _bindAspectsOdataGam `seq` (True) -> + (case (bindAspects_ _bindAspectsOdataGam) of + { ( _bindAspectsIcTrf) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = DataGam -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIdataGam -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = DataGam -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (tl_ _tlOdataGam) of + { ( _tlIcTrf) | True -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (hd_ _hdOdataGam) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIdataGam -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = DataGam -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (tl_ _tlOdataGam) of + { ( _tlIcTrf) | True -> + (case (hd_ _hdOdataGam) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIdataGam -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBound + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = DataGam -> + ( CBound) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (_lhsIdataGam) of + { _bindMetaOdataGam | _bindMetaOdataGam `seq` (True) -> + (case (bindMeta_ _bindMetaOdataGam) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _cmetasOdataGam | _cmetasOdataGam `seq` (True) -> + (case (cmetas_ _cmetasOdataGam) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIdataGam -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIdataGam -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CBoundL + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = DataGam -> + ( CBoundL) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (tl_ _tlOdataGam) of + { ( _tlIcTrf) | True -> + (case (hd_ _hdOdataGam) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIdataGam -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = DataGam -> + ( CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIdataGam -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIdataGam -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIdataGam -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIdataGam -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIdataGam -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIdataGam -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf {tag_CExpr_Tup = fixCTag _lhsIdataGam tag_}) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bodyOdataGam | _bodyOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _bindsOdataGam | _bindsOdataGam `seq` (True) -> + (case (body_ _bodyOdataGam) of + { ( _bodyIcTrf) | True -> + (case (binds_ _bindsOdataGam) of + { ( _bindsIcTrf) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _argOdataGam | _argOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _funcOdataGam | _funcOdataGam `seq` (True) -> + (case (arg_ _argOdataGam) of + { ( _argIcTrf) | True -> + (case (func_ _funcOdataGam) of + { ( _funcIcTrf) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bodyOdataGam | _bodyOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _bindOdataGam | _bindOdataGam `seq` (True) -> + (case (body_ _bodyOdataGam) of + { ( _bodyIcTrf) | True -> + (case (bind_ _bindOdataGam) of + { ( _bindIcTrf) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _dfltOdataGam | _dfltOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _altsOdataGam | _altsOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (dflt_ _dfltOdataGam) of + { ( _dfltIcTrf) | True -> + (case (alts_ _altsOdataGam) of + { ( _altsIcTrf) | True -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _errorExprOdataGam | _errorExprOdataGam `seq` (True) -> + (case (errorExpr_ _errorExprOdataGam) of + { ( _errorExprIcTrf) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _offsetOdataGam | _offsetOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (offset_ _offsetOdataGam) of + { ( _offsetIcTrf) | True -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _fldExprOdataGam | _fldExprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _offsetOdataGam | _offsetOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (fldExpr_ _fldExprOdataGam) of + { ( _fldExprIcTrf) | True -> + (case (offset_ _offsetOdataGam) of + { ( _offsetIcTrf) | True -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _fldExprOdataGam | _fldExprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _offsetOdataGam | _offsetOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (fldExpr_ _fldExprOdataGam) of + { ( _fldExprIcTrf) | True -> + (case (offset_ _offsetOdataGam) of + { ( _offsetIcTrf) | True -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIdataGam -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIdataGam -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIdataGam -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bodyOdataGam | _bodyOdataGam `seq` (True) -> + (case (body_ _bodyOdataGam) of + { ( _bodyIcTrf) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIdataGam -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _funcOdataGam | _funcOdataGam `seq` (True) -> + (case (func_ _funcOdataGam) of + { ( _funcIcTrf) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bodyOdataGam | _bodyOdataGam `seq` (True) -> + (case (body_ _bodyOdataGam) of + { ( _bodyIcTrf) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (_lhsIdataGam) of + { _annOdataGam | _annOdataGam `seq` (True) -> + (case (ann_ _annOdataGam) of + { ( _annIcTrf) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = DataGam -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIdataGam -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIdataGam -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIdataGam -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = DataGam -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIdataGam -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIdataGam -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIdataGam -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIdataGam -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = DataGam -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIdataGam -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIdataGam -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIdataGam -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIdataGam -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIdataGam -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = DataGam -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _x2OdataGam | _x2OdataGam `seq` (True) -> + (case (x2_ _x2OdataGam) of + { ( _x2IcTrf) | True -> + (case (_lhsIdataGam) of + { _x1OdataGam | _x1OdataGam `seq` (True) -> + (case (x1_ _x1OdataGam) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = DataGam -> + ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_ _exprOdataGam) of + { ( _exprIcTrf) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = DataGam -> + ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIdataGam -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bindsOdataGam | _bindsOdataGam `seq` (True) -> + (case (binds_ _bindsOdataGam) of + { ( _bindsIcTrf) | True -> + (case (_lhsIdataGam) of + { _restOdataGam | _restOdataGam `seq` (True) -> + (case (rest_ _restOdataGam) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf {tag_CPat_Con = fixCTag _lhsIdataGam tag_}) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIdataGam -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIdataGam -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIdataGam -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = DataGam -> + ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _bindOdataGam | _bindOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _offsetOdataGam | _offsetOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _fldAnnsOdataGam | _fldAnnsOdataGam `seq` (True) -> + (case (fldAnns_ _fldAnnsOdataGam) of + { ( _fldAnnsIcTrf) | True -> + (case (bind_ _bindOdataGam) of + { ( _bindIcTrf) | True -> + (case (offset_ _offsetOdataGam) of + { ( _offsetIcTrf) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = DataGam -> + ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (tl_ _tlOdataGam) of + { ( _tlIcTrf) | True -> + (case (hd_ _hdOdataGam) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIdataGam -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = DataGam -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIdataGam -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIdataGam -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + dataGam : DataGam + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = DataGam -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {dataGam_Inh_CodeAGItf :: !(DataGam)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIdataGam) = + (let ( _lhsOcTrf) | True = sem _lhsIdataGam + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIdataGam -> + (case (_lhsIdataGam) of + { _moduleOdataGam | _moduleOdataGam `seq` (True) -> + (case (module_ _moduleOdataGam) of + { ( _moduleIcTrf) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs b/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs @@ -0,0 +1,3379 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Float) +module UHC.Light.Compiler.Core.Trf.FloatToGlobal(cmodTrfFloatToGlobal) where + +import UHC.Util.Utils +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List (partition) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Debug.Trace + + + + + + + + + + + + + + + +cmodTrfFloatToGlobal :: CModule -> CModule +cmodTrfFloatToGlobal cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf) + in cTrf_Syn_CodeAGItf t + + + +flatten :: Seq.FastSeq (Seq.FastSeq a) -> Seq.FastSeq a +flatten = Seq.unions . Seq.toList + + + +move insflt@(ins,flt) + = insflt + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CAlt + fvS : FvS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local lev : _ + local whatAbove : {WhatExpr} + local cTrf : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = EvalCtx -> + Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CAlt,FvS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIevalCtx + _lhsIlev -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (False) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (pat_ _patOlev) of + { ( _patIcFloatedBindGrps,_patIcTrf,_patIfldNmL,_patIfvS,_patInmL) | True -> + (case (_patIcFloatedBindGrps `Seq.union` _exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CAltL + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = EvalCtx -> + Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CAltL,FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOlev) of + { ( _tlIcFloatedBindGrps,_tlIcTrf,_tlIfvS) | True -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOlev) of + { ( _hdIcFloatedBindGrps,_hdIcTrf,_hdIfvS) | True -> + (case (_hdIcFloatedBindGrps `Seq.union` _tlIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIevalCtx + _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isLocalInInstance : Bool + letBindingsCateg : CBindCateg + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cLamBinds : Seq.FastSeq CBind + cLargeCAFBinds : Seq.FastSeq CBind + cSmallCAFBinds : Seq.FastSeq CBind + cTrf : CBind + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = EvalCtx -> + Bool -> + Bool -> + CBindCateg -> + Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),(Seq.FastSeq CBind),(Seq.FastSeq CBind),(Seq.FastSeq CBind),CBind,FvS,FvSMp,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIletBindingsCateg + _lhsIlev -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _bindAspectsOisLocalInInstance | _bindAspectsOisLocalInInstance `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _bindAspectsOletBindingsCateg | _bindAspectsOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindAspectsOevalCtx | _bindAspectsOevalCtx `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOevalCtx _bindAspectsOisGlobal _bindAspectsOisLocalInInstance _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm) of + { ( _bindAspectsIcFloatedBindGrps,_bindAspectsIcLamBinds,_bindAspectsIcLargeCAFBinds,_bindAspectsIcSmallCAFBinds,_bindAspectsIcTrf,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) | True -> + (case (_bindAspectsIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (_bindAspectsIcLamBinds) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (_bindAspectsIcLargeCAFBinds) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (_bindAspectsIcSmallCAFBinds) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CBindAnn + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CBindAnn,FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CBindAnnL + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CBindAnnL,FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcFloatedBindGrps,_tlIcTrf,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcFloatedBindGrps,_hdIcTrf,_hdIfvS,_hdInmL) | True -> + (case (_hdIcFloatedBindGrps `Seq.union` _tlIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isLocalInInstance : Bool + letBindingsCateg : CBindCateg + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cLamBinds : Seq.FastSeq CBind + cLargeCAFBinds : Seq.FastSeq CBind + cSmallCAFBinds : Seq.FastSeq CBind + cTrf : CBindL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = EvalCtx -> + Bool -> + Bool -> + CBindCateg -> + Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),(Seq.FastSeq CBind),(Seq.FastSeq CBind),(Seq.FastSeq CBind),CBindL,FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIletBindingsCateg + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _tlOisLocalInInstance | _tlOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _hdOisLocalInInstance | _hdOisLocalInInstance `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOisLocalInInstance _tlOletBindingsCateg _tlOlev) of + { ( _tlIcFloatedBindGrps,_tlIcLamBinds,_tlIcLargeCAFBinds,_tlIcSmallCAFBinds,_tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisLocalInInstance _hdOletBindingsCateg _hdOlev) of + { ( _hdIcFloatedBindGrps,_hdIcLamBinds,_hdIcLargeCAFBinds,_hdIcSmallCAFBinds,_hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL) | True -> + (case (_hdIcFloatedBindGrps `Seq.union` _tlIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (_hdIcLamBinds `Seq.union` _tlIcLamBinds) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (_hdIcLargeCAFBinds `Seq.union` _tlIcLargeCAFBinds) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (_hdIcSmallCAFBinds `Seq.union` _tlIcSmallCAFBinds) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIletBindingsCateg + _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isLocalInInstance : Bool + isTopApp : Bool + isTopTup : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cLamBinds : Seq.FastSeq CBind + cLargeCAFBinds : Seq.FastSeq CBind + cSmallCAFBinds : Seq.FastSeq CBind + cTrf : CBound + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + local cBindTrf : _ + local isClosurableBind : _ + local _tup1 : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = EvalCtx -> + Bool -> + Bool -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),(Seq.FastSeq CBind),(Seq.FastSeq CBind),(Seq.FastSeq CBind),CBound,FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev) of + { ( _bindMetaIcFloatedBindGrps,_bindMetaIcTrf,_bindMetaIfvS,_bindMetaIisInstance) | True -> + (case (_bindMetaIisInstance || _lhsIisLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_bindMetaIcFloatedBindGrps `Seq.union` _exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (acoreBind1Asp1 _lhsInm _cTrf) of + { _cBindTrf | _cBindTrf `seq` (True) -> + (case (( _lhsIletBindingsCateg /= CBindCateg_Strict + && _exprIisClosurableExpr + )) of + { _isClosurableBind | _isClosurableBind `seq` (True) -> + (case (if isJust _exprImbLam + then ( Seq.singleton _cBindTrf + , Seq.empty + , Seq.empty + ) + else if _isClosurableBind + || _lhsIisLocalInInstance + then ( Seq.empty + , Seq.singleton _cBindTrf + , Seq.empty + ) + else ( Seq.empty + , Seq.empty + , Seq.singleton _cBindTrf + )) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_lhsOcLamBinds,_,_) | _lhsOcLamBinds `seq` (True) -> + (case (__tup1) of + { (_,_lhsOcLargeCAFBinds,_) | _lhsOcLargeCAFBinds `seq` (True) -> + (case (__tup1) of + { (_,_,_lhsOcSmallCAFBinds) | _lhsOcSmallCAFBinds `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev) of + { ( _cmetasIcFloatedBindGrps,_cmetasIcTrf,_cmetasIfvS,_cmetasIisInstance) | True -> + (case (_cmetasIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cmetasIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsBind) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsLam 0) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (Seq.singleton (acoreBind1Asp1 _lhsInm _cTrf)) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isGlobal : Bool + isLocalInInstance : Bool + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cLamBinds : Seq.FastSeq CBind + cLargeCAFBinds : Seq.FastSeq CBind + cSmallCAFBinds : Seq.FastSeq CBind + cTrf : CBoundL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = EvalCtx -> + Bool -> + Bool -> + CBindCateg -> + Int -> + HsName -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),(Seq.FastSeq CBind),(Seq.FastSeq CBind),(Seq.FastSeq CBind),CBoundL,FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _tlOisLocalInInstance | _tlOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _hdOisLocalInInstance | _hdOisLocalInInstance `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _tlOletBindingsCateg | _tlOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _tlOevalCtx | _tlOevalCtx `seq` (True) -> + (case (tl_ _tlOevalCtx _tlOisGlobal _tlOisLocalInInstance _tlOletBindingsCateg _tlOlev _tlOnm) of + { ( _tlIcFloatedBindGrps,_tlIcLamBinds,_tlIcLargeCAFBinds,_tlIcSmallCAFBinds,_tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIletBindingsCateg) of + { _hdOletBindingsCateg | _hdOletBindingsCateg `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _hdOevalCtx | _hdOevalCtx `seq` (True) -> + (case (True) of + { _hdOisTopTup | _hdOisTopTup `seq` (True) -> + (case (True) of + { _hdOisTopApp | _hdOisTopApp `seq` (True) -> + (case (hd_ _hdOevalCtx _hdOisGlobal _hdOisLocalInInstance _hdOisTopApp _hdOisTopTup _hdOletBindingsCateg _hdOlev _hdOnm) of + { ( _hdIcFloatedBindGrps,_hdIcLamBinds,_hdIcLargeCAFBinds,_hdIcSmallCAFBinds,_hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInmL) | True -> + (case (_hdIcFloatedBindGrps `Seq.union` _tlIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (_hdIcLamBinds `Seq.union` _tlIcLamBinds) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (_hdIcLargeCAFBinds `Seq.union` _tlIcLargeCAFBinds) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (_hdIcSmallCAFBinds `Seq.union` _tlIcSmallCAFBinds) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIevalCtx + _lhsIisGlobal + _lhsIisLocalInInstance + _lhsIletBindingsCateg + _lhsIlev + _lhsInm -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLamBinds | _lhsOcLamBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcLargeCAFBinds | _lhsOcLargeCAFBinds `seq` (True) -> + (case (Seq.empty) of + { _lhsOcSmallCAFBinds | _lhsOcSmallCAFBinds `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcLamBinds,_lhsOcLargeCAFBinds,_lhsOcSmallCAFBinds,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + evalCtx : EvalCtx + isLocalInInstance : Bool + isTopApp : Bool + isTopTup : Bool + lev : Int + whatAbove : WhatExpr + synthesized attributes: + appFunKind : AppFunKind + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CExpr + fvS : FvS + isClosurableExpr : Bool + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + local mbVar : {Maybe HsName} + local whatBelow : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local letBindingsCateg : _ + local isGlobal : _ + local evalCtx : _ + local _tup2 : _ + local bindingsToFloat : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local bindingGroupsToPossiblyFloat : _ + local bindingsToKeep : _ + local bindingGroupsToCertainlyInsert : _ + local _tup3 : _ + local bindingGroupsToFloat : _ + local bindingGroupsToInsert : _ + local fvS : _ + local whatBelow : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isLocalInInstance : _ + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local fvS : _ + local whatBelow : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local lev : _ + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local letBindingsCateg : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local fvS : _ + local whatBelow : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local isLocalInInstance : _ + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local whatBelow : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local whatBelow : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isLocalInInstance : _ + local whatAbove : {WhatExpr} + local isTopTup : _ + local isTopApp : {Bool} + local cTrf : _ + local whatBelow : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local isLocalInInstance : _ + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = EvalCtx -> + Bool -> + Bool -> + Bool -> + Int -> + WhatExpr -> + ( AppFunKind,(Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CExpr,FvS,Bool,(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_Fun ref_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Set.singleton _nm) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Just _nm) of + { _mbVar | _mbVar `seq` (True) -> + (case (_mbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsVar _nm) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsInt int_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOtherWHNF) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_Tag tag_) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsTup tag_) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (categ_) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindsOletBindingsCateg | _bindsOletBindingsCateg `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _bindsOisLocalInInstance | _bindsOisLocalInInstance `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_lhsIlev + 1) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk) of + { _evalCtx | _evalCtx `seq` (True) -> + (case (_evalCtx) of + { _bindsOevalCtx | _bindsOevalCtx `seq` (True) -> + (case (binds_ _bindsOevalCtx _bindsOisGlobal _bindsOisLocalInInstance _bindsOletBindingsCateg _bindsOlev) of + { ( _bindsIcFloatedBindGrps,_bindsIcLamBinds,_bindsIcLargeCAFBinds,_bindsIcSmallCAFBinds,_bindsIcTrf,_bindsIfvS,_bindsIfvSMp,_bindsInmL) | True -> + (case (if _isGlobal + then ( _bindsIcLargeCAFBinds `Seq.union` _bindsIcSmallCAFBinds `Seq.union` _bindsIcLamBinds + , Seq.empty + ) + else if categ_ == CBindCateg_Strict + then ( _bindsIcLargeCAFBinds `Seq.union` _bindsIcSmallCAFBinds + , _bindsIcLamBinds + ) + else ( _bindsIcSmallCAFBinds + , _bindsIcLamBinds `Seq.union` _bindsIcLargeCAFBinds + )) of + { __tup2 | __tup2 `seq` (True) -> + (case (__tup2) of + { (_,_bindingsToFloat) | _bindingsToFloat `seq` (True) -> + (case (_lhsIisLocalInInstance) of + { _bodyOisLocalInInstance | _bodyOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_evalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisLocalInInstance _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcFloatedBindGrps,_bodyIcTrf,_bodyIfvS,_bodyIisClosurableExpr,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (if _isGlobal + then Seq.empty + else (Seq.singleton (categ_, _bindingsToFloat ) `Seq.union` _bindsIcFloatedBindGrps `Seq.union` _bodyIcFloatedBindGrps)) of + { _bindingGroupsToPossiblyFloat | _bindingGroupsToPossiblyFloat `seq` (True) -> + (case (__tup2) of + { (_bindingsToKeep,_) | _bindingsToKeep `seq` (True) -> + (case (if _isGlobal + then + case categ_ of + CBindCateg_Rec -> Seq.singleton (categ_, (flatten $ Seq.map snd _bindsIcFloatedBindGrps) `Seq.union` _bindingsToKeep ) + _ -> _bindsIcFloatedBindGrps `Seq.union` Seq.singleton (categ_, _bindingsToKeep ) + else Seq.singleton (categ_, _bindingsToKeep )) of + { _bindingGroupsToCertainlyInsert | _bindingGroupsToCertainlyInsert `seq` (True) -> + (case (move (_bindingGroupsToCertainlyInsert , _bindingGroupsToPossiblyFloat )) of + { __tup3 | __tup3 `seq` (True) -> + (case (__tup3) of + { (_,_bindingGroupsToFloat) | _bindingGroupsToFloat `seq` (True) -> + (case (if _isGlobal + then Seq.empty + else _bindingGroupsToFloat) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (__tup3) of + { (_bindingGroupsToInsert,_) | _bindingGroupsToInsert `seq` (True) -> + (case (foldr (\(c,b) r -> acoreLet c (Seq.toList b) r) _bodyIcTrf + $ Seq.toList _bindingGroupsToInsert) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _funcOisLocalInInstance | _funcOisLocalInInstance `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (False) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisLocalInInstance _funcOisTopApp _funcOisTopTup _funcOlev _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIcFloatedBindGrps,_funcIcTrf,_funcIfvS,_funcIisClosurableExpr,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (_funcIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _argOisLocalInInstance | _argOisLocalInInstance `seq` (True) -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _argOletBindingsCateg | _argOletBindingsCateg `seq` (True) -> + (case (_isTopTup) of + { _argOisTopTup | _argOisTopTup `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (EvalCtx_Thunk) of + { _argOevalCtx | _argOevalCtx `seq` (True) -> + (case (True) of + { _argOisTopApp | _argOisTopApp `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOevalCtx _argOisGlobal _argOisLocalInInstance _argOisTopApp _argOisTopTup _argOletBindingsCateg _argOlev _argOnm) of + { ( _argIcFloatedBindGrps,_argIcLamBinds,_argIcLargeCAFBinds,_argIcSmallCAFBinds,_argIcTrf,_argIfvS,_argIfvSMp,_argInmL) | True -> + (case (_funcIcFloatedBindGrps `Seq.union` _argIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _bodyOisLocalInInstance | _bodyOisLocalInInstance `seq` (True) -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _bindOisLocalInInstance | _bindOisLocalInInstance `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisLocalInInstance _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcFloatedBindGrps,_bodyIcTrf,_bodyIfvS,_bodyIisClosurableExpr,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (acoreBindcategPlain) of + { _letBindingsCateg | _letBindingsCateg `seq` (True) -> + (case (_letBindingsCateg) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (_lhsIevalCtx) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOisLocalInInstance _bindOletBindingsCateg _bindOlev) of + { ( _bindIcFloatedBindGrps,_bindIcLamBinds,_bindIcLargeCAFBinds,_bindIcSmallCAFBinds,_bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (_bindIcFloatedBindGrps `Seq.union` _bodyIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Just $ maybe [_argNm] (_argNm:) _bodyImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _dfltOisLocalInInstance | _dfltOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _dfltOwhatAbove | _dfltOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _dfltOisTopTup | _dfltOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _dfltOisTopApp | _dfltOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _dfltOevalCtx | _dfltOevalCtx `seq` (True) -> + (case (dflt_ _dfltOevalCtx _dfltOisLocalInInstance _dfltOisTopApp _dfltOisTopTup _dfltOlev _dfltOwhatAbove) of + { ( _dfltIappFunKind,_dfltIcFloatedBindGrps,_dfltIcTrf,_dfltIfvS,_dfltIisClosurableExpr,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) | True -> + (case (_lhsIevalCtx) of + { _altsOevalCtx | _altsOevalCtx `seq` (True) -> + (case (alts_ _altsOevalCtx _altsOlev) of + { ( _altsIcFloatedBindGrps,_altsIcTrf,_altsIfvS) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_isTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps `Seq.union` _altsIcFloatedBindGrps `Seq.union` _dfltIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _errorExprOwhatAbove | _errorExprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _errorExprOisTopTup | _errorExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _errorExprOisTopApp | _errorExprOisTopApp `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _errorExprOisLocalInInstance | _errorExprOisLocalInInstance `seq` (True) -> + (case (_lhsIevalCtx) of + { _errorExprOevalCtx | _errorExprOevalCtx `seq` (True) -> + (case (errorExpr_ _errorExprOevalCtx _errorExprOisLocalInInstance _errorExprOisTopApp _errorExprOisTopTup _errorExprOlev _errorExprOwhatAbove) of + { ( _errorExprIappFunKind,_errorExprIcFloatedBindGrps,_errorExprIcTrf,_errorExprIfvS,_errorExprIisClosurableExpr,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) | True -> + (case (_errorExprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_errorExprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (_errorExprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_errorExprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_errorExprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _offsetOisLocalInInstance | _offsetOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisLocalInInstance _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcFloatedBindGrps,_offsetIcTrf,_offsetIfvS,_offsetIisClosurableExpr,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps `Seq.union` _offsetIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _fldExprOisLocalInInstance | _fldExprOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _offsetOisLocalInInstance | _offsetOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisLocalInInstance _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIcFloatedBindGrps,_fldExprIcTrf,_fldExprIfvS,_fldExprIisClosurableExpr,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisLocalInInstance _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcFloatedBindGrps,_offsetIcTrf,_offsetIfvS,_offsetIisClosurableExpr,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps `Seq.union` _offsetIcFloatedBindGrps `Seq.union` _fldExprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _fldExprOisLocalInInstance | _fldExprOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _offsetOisLocalInInstance | _offsetOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_isLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _fldExprOwhatAbove | _fldExprOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _fldExprOisTopTup | _fldExprOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _fldExprOisTopApp | _fldExprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _fldExprOevalCtx | _fldExprOevalCtx `seq` (True) -> + (case (fldExpr_ _fldExprOevalCtx _fldExprOisLocalInInstance _fldExprOisTopApp _fldExprOisTopTup _fldExprOlev _fldExprOwhatAbove) of + { ( _fldExprIappFunKind,_fldExprIcFloatedBindGrps,_fldExprIcTrf,_fldExprIfvS,_fldExprIisClosurableExpr,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) | True -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (_isTopTup) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (_isTopApp) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisLocalInInstance _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcFloatedBindGrps,_offsetIcTrf,_offsetIfvS,_offsetIisClosurableExpr,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_isTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (False) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps `Seq.union` _offsetIcFloatedBindGrps `Seq.union` _fldExprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_FFI) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsFFI) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _bodyOisLocalInInstance | _bodyOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisLocalInInstance _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcFloatedBindGrps,_bodyIcTrf,_bodyIfvS,_bodyIisClosurableExpr,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_bodyIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _funcOisLocalInInstance | _funcOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _funcOwhatAbove | _funcOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _funcOisTopTup | _funcOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _funcOisTopApp | _funcOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _funcOevalCtx | _funcOevalCtx `seq` (True) -> + (case (func_ _funcOevalCtx _funcOisLocalInInstance _funcOisTopApp _funcOisTopTup _funcOlev _funcOwhatAbove) of + { ( _funcIappFunKind,_funcIcFloatedBindGrps,_funcIcTrf,_funcIfvS,_funcIisClosurableExpr,_funcImbLam,_funcImbVar,_funcIwhatBelow) | True -> + (case (_funcIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (AppFunKind_NoApp) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _bodyOisLocalInInstance | _bodyOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _bodyOwhatAbove | _bodyOwhatAbove `seq` (True) -> + (case (True) of + { _isTopTup | _isTopTup `seq` (True) -> + (case (_isTopTup) of + { _bodyOisTopTup | _bodyOisTopTup `seq` (True) -> + (case (True) of + { _isTopApp | _isTopApp `seq` (True) -> + (case (_isTopApp) of + { _bodyOisTopApp | _bodyOisTopApp `seq` (True) -> + (case (_lhsIevalCtx) of + { _bodyOevalCtx | _bodyOevalCtx `seq` (True) -> + (case (body_ _bodyOevalCtx _bodyOisLocalInInstance _bodyOisTopApp _bodyOisTopTup _bodyOlev _bodyOwhatAbove) of + { ( _bodyIappFunKind,_bodyIcFloatedBindGrps,_bodyIcTrf,_bodyIfvS,_bodyIisClosurableExpr,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) | True -> + (case (_bodyIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (Nothing) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (Nothing) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (ExprIsOther) of + { _whatBelow | _whatBelow `seq` (True) -> + (case (_whatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIevalCtx + _lhsIisLocalInInstance + _lhsIisTopApp + _lhsIisTopTup + _lhsIlev + _lhsIwhatAbove -> + (case (_lhsIwhatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIisTopTup) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (_lhsIisTopApp) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (False) of + { _isLocalInInstance | _isLocalInInstance `seq` (True) -> + (case (_isLocalInInstance) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (_lhsIevalCtx) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIappFunKind) of + { _lhsOappFunKind | _lhsOappFunKind `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev) of + { ( _annIcFloatedBindGrps,_annIcTrf,_annIfvS) | True -> + (case (_annIcFloatedBindGrps `Seq.union` _exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIisClosurableExpr) of + { _lhsOisClosurableExpr | _lhsOisClosurableExpr `seq` (True) -> + (case (_exprImbLam) of + { _lhsOmbLam | _lhsOmbLam `seq` (True) -> + (case (_exprImbVar) of + { _lhsOmbVar | _lhsOmbVar `seq` (True) -> + (case (_exprIwhatBelow) of + { _lhsOwhatBelow | _lhsOwhatBelow `seq` (True) -> + ( _lhsOappFunKind,_lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisClosurableExpr,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CExprAnn + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CExprAnn,FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CMetaBind + fvS : FvS + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CMetaBind,FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CMetaVal + fvS : FvS + isInstance : Bool + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CMetaVal,FvS,Bool) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (True) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (False) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CMetas + fvS : FvS + isInstance : Bool + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CMetas,FvS,Bool) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev) of + { ( _x2IcFloatedBindGrps,_x2IcTrf,_x2IfvS,_x2IisInstance) | True -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev) of + { ( _x1IcFloatedBindGrps,_x1IcTrf,_x1IfvS) | True -> + (case (_x1IcFloatedBindGrps `Seq.union` _x2IcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_x2IisInstance) of + { _lhsOisInstance | _lhsOisInstance `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOisInstance) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CModule + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CModule,FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (False) of + { _exprOisLocalInInstance | _exprOisLocalInInstance `seq` (True) -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _exprOwhatAbove | _exprOwhatAbove `seq` (True) -> + (case (EvalCtx_Eval) of + { _exprOevalCtx | _exprOevalCtx `seq` (True) -> + (case (True) of + { _exprOisTopTup | _exprOisTopTup `seq` (True) -> + (case (True) of + { _exprOisTopApp | _exprOisTopApp `seq` (True) -> + (case (expr_ _exprOevalCtx _exprOisLocalInInstance _exprOisTopApp _exprOisTopTup _exprOlev _exprOwhatAbove) of + { ( _exprIappFunKind,_exprIcFloatedBindGrps,_exprIcTrf,_exprIfvS,_exprIisClosurableExpr,_exprImbLam,_exprImbVar,_exprIwhatBelow) | True -> + (case (_exprIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CPat,([HsName]),FvS,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev) of + { ( _bindsIcFloatedBindGrps,_bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsInmL) | True -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev) of + { ( _restIcFloatedBindGrps,_restIcTrf,_restIfvS,_restInmL) | True -> + (case (_restIcFloatedBindGrps `Seq.union` _bindsIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CPatFld,([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (False) of + { _bindOisLocalInInstance | _bindOisLocalInInstance `seq` (True) -> + (case (False) of + { _offsetOisLocalInInstance | _offsetOisLocalInInstance `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev) of + { ( _fldAnnsIcFloatedBindGrps,_fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsInmL) | True -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (EvalCtx_None) of + { _bindOevalCtx | _bindOevalCtx `seq` (True) -> + (case (acoreBindcategPlain) of + { _bindOletBindingsCateg | _bindOletBindingsCateg `seq` (True) -> + (case (bind_ _bindOevalCtx _bindOisGlobal _bindOisLocalInInstance _bindOletBindingsCateg _bindOlev) of + { ( _bindIcFloatedBindGrps,_bindIcLamBinds,_bindIcLargeCAFBinds,_bindIcSmallCAFBinds,_bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (ExprIsOther) of + { _whatAbove | _whatAbove `seq` (True) -> + (case (_whatAbove) of + { _offsetOwhatAbove | _offsetOwhatAbove `seq` (True) -> + (case (EvalCtx_Eval) of + { _offsetOevalCtx | _offsetOevalCtx `seq` (True) -> + (case (True) of + { _offsetOisTopTup | _offsetOisTopTup `seq` (True) -> + (case (True) of + { _offsetOisTopApp | _offsetOisTopApp `seq` (True) -> + (case (offset_ _offsetOevalCtx _offsetOisLocalInInstance _offsetOisTopApp _offsetOisTopTup _offsetOlev _offsetOwhatAbove) of + { ( _offsetIappFunKind,_offsetIcFloatedBindGrps,_offsetIcTrf,_offsetIfvS,_offsetIisClosurableExpr,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) | True -> + (case (_offsetIcFloatedBindGrps `Seq.union` _bindIcFloatedBindGrps `Seq.union` _fldAnnsIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CPatFldL,([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcFloatedBindGrps,_tlIcTrf,_tlIfldNmL,_tlIfvS,_tlInmL) | True -> + (case (hd_ _hdOlev) of + { ( _hdIcFloatedBindGrps,_hdIcTrf,_hdIfldNmL,_hdIfvS,_hdInmL) | True -> + (case (_hdIcFloatedBindGrps `Seq.union` _tlIcFloatedBindGrps) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cFloatedBindGrps : Seq.FastSeq (CBindCateg,Seq.FastSeq CBind) + cTrf : CPatRest + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CPatRest,FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev -> + (case (Seq.empty) of + { _lhsOcFloatedBindGrps | _lhsOcFloatedBindGrps `seq` (True) -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcFloatedBindGrps,_lhsOcTrf,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) | True = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev) of + { ( _moduleIcFloatedBindGrps,_moduleIcTrf,_moduleIfvS) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) diff --git a/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs b/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs @@ -0,0 +1,5489 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Inlin) +module UHC.Light.Compiler.Core.Trf.InlineLetAlias(cmodTrfInlineLetAlias) where + +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import UHC.Util.Utils +import qualified Data.Set as Set + + + + + + + + + + + +cmodTrfInlineLetAlias :: HsNameS -> CModule -> CModule +cmodTrfInlineLetAlias globNmS cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf {noTrfNmS_Inh_CodeAGItf = globNmS}) + in cTrf_Syn_CodeAGItf t + + + +type NmMp = Map.Map HsName CExpr + + + +trackNames :: Track -> [HsName] +trackNames (TrackSelect n t) = trackNames t +trackNames (TrackVarApply x ts) = x : concatMap trackNames ts +trackNames _ = [] + +substTrack :: NmMp -> Track -> Track +substTrack m (TrackSelect n t) = TrackSelect n (substTrack m t) +substTrack m (TrackVarApply x ts) = TrackVarApply (maybe x (fromJust . cexprMbVar) (Map.lookup x m)) (map (substTrack m) ts) +substTrack _ t = t +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + noTrfToConNmS : HsNameS + synthesized attributes: + cTrf : CAlt + fvS : FvS + levOf : Int + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cvi : _ + local fvS : _ + local lev : _ + local noTrfNmS : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = Bool -> + CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + HsNameS -> + ( CAlt,FvS,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfToConNmS -> + (let _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _lhsOlevOf :: Int + _exprOnmMp :: NmMp + _lhsOfvS :: FvS + _lhsOcTrf :: CAlt + _patOcvarIntroMp :: CVarIntroMp + _patOintroCVarIntroMp :: CVarIntroMp + _patOlev :: Int + _patOnmMp :: NmMp + _exprOallowTrfToCon :: Bool + _exprOlev :: Int + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _patIfvS :: FvS + _patIlevOf :: Int + _patInmL :: ([HsName]) + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 15, column 17) + _cvi = + emptyCVarIntro { cviLev = _lev } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 36, column 17) + _exprOcvarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 48, column 17) + _exprOintroCVarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 70, column 17) + _lhsOlevOf = + fvsLev _lhsIcvarIntroMp cLevModule _exprIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 14, column 17) + _fvS = + _exprIfvS `Set.difference` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 45, column 17) + _noTrfNmS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 88, column 17) + _exprOnmMp = + foldr Map.delete _lhsInmMp _patInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _patOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _patOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (from local) + _exprOnoTrfNmS = + _noTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _patIcTrf,_patIfldNmL,_patIfvS,_patIlevOf,_patInmL) = + pat_ _patOcvarIntroMp _patOintroCVarIntroMp _patOlev _patOnmMp + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + noTrfToConNmS : HsNameS + synthesized attributes: + cTrf : CAltL + fvS : FvS + levOf : Int + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = Bool -> + CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + HsNameS -> + ( CAltL,FvS,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfToConNmS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _hdOallowTrfToCon :: Bool + _hdOcvarIntroMp :: CVarIntroMp + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOnmMp :: NmMp + _hdOnoTrfToConNmS :: HsNameS + _tlOallowTrfToCon :: Bool + _tlOcvarIntroMp :: CVarIntroMp + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOnmMp :: NmMp + _tlOnoTrfToConNmS :: HsNameS + _hdIcTrf :: CAlt + _hdIfvS :: FvS + _hdIlevOf :: Int + _tlIcTrf :: CAltL + _tlIfvS :: FvS + _tlIlevOf :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnmMp = + _lhsInmMp + -- copy rule (down) + _hdOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _tlOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnmMp = + _lhsInmMp + -- copy rule (down) + _tlOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _hdIcTrf,_hdIfvS,_hdIlevOf) = + hd_ _hdOallowTrfToCon _hdOcvarIntroMp _hdOintroCVarIntroMp _hdOlev _hdOnmMp _hdOnoTrfToConNmS + ( _tlIcTrf,_tlIfvS,_tlIlevOf) = + tl_ _tlOallowTrfToCon _tlOcvarIntroMp _tlOintroCVarIntroMp _tlOlev _tlOnmMp _tlOnoTrfToConNmS + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfToConNmS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lev : Int + nmMp : NmMp + noTrfNmS : HsNameS + noTrfToConNmS : HsNameS + synthesized attributes: + bindL : [(HsName,CBind)] + bindNmMp : NmMp + bindsIntroCVarIntroMp : CVarIntroMp + bindsNoTrfNmS : HsNameS + cTrf : CBind + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levOf : Int + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local aspBindNmMp : _ + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = Bool -> + CVarIntroMp -> + CVarIntroMp -> + Bool -> + Int -> + NmMp -> + HsNameS -> + HsNameS -> + ( ([(HsName,CBind)]),NmMp,CVarIntroMp,HsNameS,CBind,CVarIntroMp,FvS,FvSMp,Int,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOfvSMp :: FvSMp + _lhsOnmL :: ([HsName]) + _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CBind + _bindAspectsOallowTrfToCon :: Bool + _bindAspectsOaspBindNmMp :: (ACoreBindAspMp NmMp) + _bindAspectsOcvarIntroMp :: CVarIntroMp + _bindAspectsOintroCVarIntroMp :: CVarIntroMp + _bindAspectsOisGlobal :: Bool + _bindAspectsOlev :: Int + _bindAspectsOnmMp :: NmMp + _bindAspectsOnoTrfNmS :: HsNameS + _bindAspectsOnoTrfToConNmS :: HsNameS + _bindAspectsIbindL :: ([(HsName,CBind)]) + _bindAspectsIbindNmMp :: NmMp + _bindAspectsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindAspectsIbindsNoTrfNmS :: HsNameS + _bindAspectsIcTrf :: CBoundL + _bindAspectsIcvarIntroExprMp :: CVarIntroMp + _bindAspectsIfvS :: FvS + _bindAspectsIfvSMp :: FvSMp + _bindAspectsIgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _bindAspectsIlevOf :: Int + _bindAspectsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 11, column 17) + _lhsOfvSMp = + Map.singleton nm_ _bindAspectsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 19, column 17) + _lhsOnmL = + [nm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 148, column 25) + _aspBindNmMp = + _bindAspectsIgathAspBindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + _bindAspectsIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + _bindAspectsIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _bindAspectsIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + _bindAspectsIbindsNoTrfNmS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _bindAspectsIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindAspectsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindAspectsIlevOf + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindAspectsOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (from local) + _bindAspectsOaspBindNmMp = + _aspBindNmMp + -- copy rule (down) + _bindAspectsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindAspectsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOnmMp = + _lhsInmMp + -- copy rule (down) + _bindAspectsOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bindAspectsOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _bindAspectsIbindL,_bindAspectsIbindNmMp,_bindAspectsIbindsIntroCVarIntroMp,_bindAspectsIbindsNoTrfNmS,_bindAspectsIcTrf,_bindAspectsIcvarIntroExprMp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsIgathAspBindNmMp,_bindAspectsIlevOf,_bindAspectsInmL) = + bindAspects_ _bindAspectsOallowTrfToCon _bindAspectsOaspBindNmMp _bindAspectsOcvarIntroMp _bindAspectsOintroCVarIntroMp _bindAspectsOisGlobal _bindAspectsOlev _bindAspectsOnm _bindAspectsOnmMp _bindAspectsOnoTrfNmS _bindAspectsOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOlevOf,_lhsOnm,_lhsOnmL))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CBindAnn,FvS,Int,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnn + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CBindAnnL,FvS,Int,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _hdOcvarIntroMp :: CVarIntroMp + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOnmMp :: NmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOnmMp :: NmMp + _hdIcTrf :: CBindAnn + _hdIfvS :: FvS + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CBindAnnL + _tlIfvS :: FvS + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnmMp = + _lhsInmMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnmMp = + _lhsInmMp + ( _hdIcTrf,_hdIfvS,_hdIlevOf,_hdInmL) = + hd_ _hdOcvarIntroMp _hdOintroCVarIntroMp _hdOlev _hdOnmMp + ( _tlIcTrf,_tlIfvS,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOintroCVarIntroMp _tlOlev _tlOnmMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lev : Int + nmMp : NmMp + noTrfNmS : HsNameS + noTrfToConNmS : HsNameS + synthesized attributes: + bindL : [(HsName,CBind)] + bindNmMp : NmMp + bindsIntroCVarIntroMp : CVarIntroMp + bindsNoTrfNmS : HsNameS + cTrf : CBindL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = Bool -> + CVarIntroMp -> + CVarIntroMp -> + Bool -> + Int -> + NmMp -> + HsNameS -> + HsNameS -> + ( ([(HsName,CBind)]),NmMp,CVarIntroMp,HsNameS,CBindL,CVarIntroMp,FvS,FvSMp,Int,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + _hdOallowTrfToCon :: Bool + _hdOcvarIntroMp :: CVarIntroMp + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlev :: Int + _hdOnmMp :: NmMp + _hdOnoTrfNmS :: HsNameS + _hdOnoTrfToConNmS :: HsNameS + _tlOallowTrfToCon :: Bool + _tlOcvarIntroMp :: CVarIntroMp + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlev :: Int + _tlOnmMp :: NmMp + _tlOnoTrfNmS :: HsNameS + _tlOnoTrfToConNmS :: HsNameS + _hdIbindL :: ([(HsName,CBind)]) + _hdIbindNmMp :: NmMp + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIbindsNoTrfNmS :: HsNameS + _hdIcTrf :: CBind + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIlevOf :: Int + _hdInm :: HsName + _hdInmL :: ([HsName]) + _tlIbindL :: ([(HsName,CBind)]) + _tlIbindNmMp :: NmMp + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIbindsNoTrfNmS :: HsNameS + _tlIcTrf :: CBindL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + _hdIbindL ++ _tlIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + _hdIbindNmMp `Map.union` _tlIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + _hdIbindsNoTrfNmS `Set.union` _tlIbindsNoTrfNmS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnmMp = + _lhsInmMp + -- copy rule (down) + _hdOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _hdOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _tlOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnmMp = + _lhsInmMp + -- copy rule (down) + _tlOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _tlOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _hdIbindL,_hdIbindNmMp,_hdIbindsIntroCVarIntroMp,_hdIbindsNoTrfNmS,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIlevOf,_hdInm,_hdInmL) = + hd_ _hdOallowTrfToCon _hdOcvarIntroMp _hdOintroCVarIntroMp _hdOisGlobal _hdOlev _hdOnmMp _hdOnoTrfNmS _hdOnoTrfToConNmS + ( _tlIbindL,_tlIbindNmMp,_tlIbindsIntroCVarIntroMp,_tlIbindsNoTrfNmS,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIlevOf,_tlInmL) = + tl_ _tlOallowTrfToCon _tlOcvarIntroMp _tlOintroCVarIntroMp _tlOisGlobal _tlOlev _tlOnmMp _tlOnoTrfNmS _tlOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOlevOf,_lhsOnmL))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOlevOf,_lhsOnmL))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + aspBindNmMp : ACoreBindAspMp NmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lev : Int + nm : HsName + nmMp : NmMp + noTrfNmS : HsNameS + noTrfToConNmS : HsNameS + synthesized attributes: + bindL : [(HsName,CBind)] + bindNmMp : NmMp + bindsIntroCVarIntroMp : CVarIntroMp + bindsNoTrfNmS : HsNameS + cTrf : CBound + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + gathAspBindNmMp : ACoreBindAspMp NmMp + levOf : Int + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cmetaVal : _ + local cvi : _ + local cviExpr : _ + local _tup1 : _ + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local bindsNoTrfNmS : _ + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = Bool -> + (ACoreBindAspMp NmMp) -> + CVarIntroMp -> + CVarIntroMp -> + Bool -> + Int -> + HsName -> + NmMp -> + HsNameS -> + HsNameS -> + ( ([(HsName,CBind)]),NmMp,CVarIntroMp,HsNameS,CBound,CVarIntroMp,FvS,FvSMp,(ACoreBindAspMp NmMp),Int,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsObindNmMp :: NmMp + _lhsObindL :: ([(HsName,CBind)]) + _exprOallowTrfToCon :: Bool + _exprOnoTrfToConNmS :: HsNameS + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _bindMetaObindNmMp :: NmMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _bindMetaOcvarIntroMp :: CVarIntroMp + _bindMetaOintroCVarIntroMp :: CVarIntroMp + _bindMetaOlev :: Int + _bindMetaOnmMp :: NmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _bindMetaIcTrf :: CMetas + _bindMetaIfvS :: FvS + _bindMetaIlevOf :: Int + _bindMetaInameS :: HsNameS + _bindMetaIself :: CMetas + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cmetaVal = + cmetasVal _bindMetaIself + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cvi = + emptyCVarIntro { cviLev = _lhsIlev , cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cviExpr = + emptyCVarIntro { cviLev = _exprIlevOf, cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 53, column 17) + _lhsObindsIntroCVarIntroMp = + Map.singleton _lhsInm _cvi + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 75, column 17) + _lhsOcvarIntroExprMp = + Map.singleton _lhsInm _cviExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 111, column 33) + __tup1 = + case _exprImbRepl of + Just r | _lhsInm /= hsnMain + && not (_lhsInm `Set.member` _lhsInoTrfNmS) + -> (_lhsInm `Map.singleton` r,[(_lhsInm,acoreBind1Asp1 _lhsInm _cTrf)]) + _ -> (Map.empty,[(_lhsInm,acoreBind1Asp1 _lhsInm _cTrf)]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 111, column 33) + (_lhsObindNmMp,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 111, column 33) + (_,_lhsObindL) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 141, column 11) + _exprOallowTrfToCon = + not (_lhsInm `Set.member` _lhsInoTrfToConNmS) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 142, column 11) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS `Set.union` _bindMetaInameS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 151, column 25) + _lhsOgathAspBindNmMp = + Map.singleton acbaspkeyDefault _exprIbindNmMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 179, column 25) + _bindMetaObindNmMp = + _exprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindMetaIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindMetaIlevOf `max` _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindMetaOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindMetaOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (down) + _bindMetaOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIlevOf,_bindMetaInameS,_bindMetaIself) = + bindMeta_ _bindMetaObindNmMp _bindMetaOcvarIntroMp _bindMetaOintroCVarIntroMp _bindMetaOlev _bindMetaOnmMp + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _cmetasObindNmMp :: NmMp + _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _cmetasOcvarIntroMp :: CVarIntroMp + _cmetasOintroCVarIntroMp :: CVarIntroMp + _cmetasOlev :: Int + _cmetasOnmMp :: NmMp + _cmetasIcTrf :: CMetas + _cmetasIfvS :: FvS + _cmetasIlevOf :: Int + _cmetasInameS :: HsNameS + _cmetasIself :: CMetas + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 180, column 25) + _cmetasObindNmMp = + panicJust "InlineLetAlias.CBound.Meta.aspBindNmMp" $ Map.lookup acbaspkeyDefault _lhsIaspBindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _cmetasIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _cmetasIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _cmetasOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _cmetasOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOnmMp = + _lhsInmMp + ( _cmetasIcTrf,_cmetasIfvS,_cmetasIlevOf,_cmetasInameS,_cmetasIself) = + cmetas_ _cmetasObindNmMp _cmetasOcvarIntroMp _cmetasOintroCVarIntroMp _cmetasOlev _cmetasOnmMp + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + _exprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 171, column 17) + _bindsNoTrfNmS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + _exprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + _bindsNoTrfNmS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + aspBindNmMp : ACoreBindAspMp NmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lev : Int + nm : HsName + nmMp : NmMp + noTrfNmS : HsNameS + noTrfToConNmS : HsNameS + synthesized attributes: + bindL : [(HsName,CBind)] + bindNmMp : NmMp + bindsIntroCVarIntroMp : CVarIntroMp + bindsNoTrfNmS : HsNameS + cTrf : CBoundL + cvarIntroExprMp : CVarIntroMp + fvS : FvS + fvSMp : FvSMp + gathAspBindNmMp : ACoreBindAspMp NmMp + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = Bool -> + (ACoreBindAspMp NmMp) -> + CVarIntroMp -> + CVarIntroMp -> + Bool -> + Int -> + HsName -> + NmMp -> + HsNameS -> + HsNameS -> + ( ([(HsName,CBind)]),NmMp,CVarIntroMp,HsNameS,CBoundL,CVarIntroMp,FvS,FvSMp,(ACoreBindAspMp NmMp),Int,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + _hdOallowTrfToCon :: Bool + _hdOaspBindNmMp :: (ACoreBindAspMp NmMp) + _hdOcvarIntroMp :: CVarIntroMp + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlev :: Int + _hdOnm :: HsName + _hdOnmMp :: NmMp + _hdOnoTrfNmS :: HsNameS + _hdOnoTrfToConNmS :: HsNameS + _tlOallowTrfToCon :: Bool + _tlOaspBindNmMp :: (ACoreBindAspMp NmMp) + _tlOcvarIntroMp :: CVarIntroMp + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlev :: Int + _tlOnm :: HsName + _tlOnmMp :: NmMp + _tlOnoTrfNmS :: HsNameS + _tlOnoTrfToConNmS :: HsNameS + _hdIbindL :: ([(HsName,CBind)]) + _hdIbindNmMp :: NmMp + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIbindsNoTrfNmS :: HsNameS + _hdIcTrf :: CBound + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIbindL :: ([(HsName,CBind)]) + _tlIbindNmMp :: NmMp + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIbindsNoTrfNmS :: HsNameS + _tlIcTrf :: CBoundL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + _hdIbindL ++ _tlIbindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + _hdIbindNmMp `Map.union` _tlIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + _hdIbindsNoTrfNmS `Set.union` _tlIbindsNoTrfNmS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + _hdIgathAspBindNmMp `Map.union` _tlIgathAspBindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _hdOaspBindNmMp = + _lhsIaspBindNmMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOnmMp = + _lhsInmMp + -- copy rule (down) + _hdOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _hdOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _tlOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _tlOaspBindNmMp = + _lhsIaspBindNmMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOnmMp = + _lhsInmMp + -- copy rule (down) + _tlOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _tlOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _hdIbindL,_hdIbindNmMp,_hdIbindsIntroCVarIntroMp,_hdIbindsNoTrfNmS,_hdIcTrf,_hdIcvarIntroExprMp,_hdIfvS,_hdIfvSMp,_hdIgathAspBindNmMp,_hdIlevOf,_hdInmL) = + hd_ _hdOallowTrfToCon _hdOaspBindNmMp _hdOcvarIntroMp _hdOintroCVarIntroMp _hdOisGlobal _hdOlev _hdOnm _hdOnmMp _hdOnoTrfNmS _hdOnoTrfToConNmS + ( _tlIbindL,_tlIbindNmMp,_tlIbindsIntroCVarIntroMp,_tlIbindsNoTrfNmS,_tlIcTrf,_tlIcvarIntroExprMp,_tlIfvS,_tlIfvSMp,_tlIgathAspBindNmMp,_tlIlevOf,_tlInmL) = + tl_ _tlOallowTrfToCon _tlOaspBindNmMp _tlOcvarIntroMp _tlOintroCVarIntroMp _tlOisGlobal _tlOlev _tlOnm _tlOnmMp _tlOnoTrfNmS _tlOnoTrfToConNmS + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIallowTrfToCon + _lhsIaspBindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlev + _lhsInm + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindL :: ([(HsName,CBind)]) + _lhsObindNmMp :: NmMp + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsObindsNoTrfNmS :: HsNameS + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 107, column 26) + _lhsObindL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 106, column 29) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 104, column 34) + _lhsObindsNoTrfNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 145, column 74) + _lhsOgathAspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindL,_lhsObindNmMp,_lhsObindsIntroCVarIntroMp,_lhsObindsNoTrfNmS,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOfvS,_lhsOfvSMp,_lhsOgathAspBindNmMp,_lhsOlevOf,_lhsOnmL))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allowTrfToCon : Bool + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + noTrfNmS : HsNameS + noTrfToConNmS : HsNameS + synthesized attributes: + bindNmMp : NmMp + cTrf : CExpr + fvS : FvS + levOf : Int + mbRepl : Maybe CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + local nmAsp : {HsName} + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local levOf : _ + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local maxBindLev : _ + local _tup2 : _ + local strLev : _ + local introCVarIntroMp : _ + local levOf : _ + local fvS : _ + local isGlobal : _ + local allowTrf : _ + local allowStrTrf : _ + local nmMpNew : _ + local nmMp : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local levOf : _ + local fvS : _ + local isGlobal : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cvi : _ + local levOf : _ + local fvS : _ + local argNm : _ + local lev : _ + local isGlobal : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local levOf : _ + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local levOf : _ + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = Bool -> + CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + HsNameS -> + HsNameS -> + ( NmMp,CExpr,FvS,Int,(Maybe CExpr)) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOlevOf :: Int + _lhsOfvS :: FvS + _nm :: HsName + _nmAsp :: HsName + _lhsOmbRepl :: (Maybe CExpr) + _lhsOcTrf :: CExpr + _lhsObindNmMp :: NmMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 59, column 17) + _lhsOlevOf = + fvLev _nm _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 7, column 17) + _lhsOfvS = + Set.singleton _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 94, column 17) + _lhsOmbRepl = + Just _cTrf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 168, column 17) + _lhsOcTrf = + maybe _cTrf id $ Map.lookup _nm $ _lhsInmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- self rule + _cTrf = + CExpr_Var ref_ + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 96, column 17) + _lhsOmbRepl = + if _lhsIallowTrfToCon + then Just _cTrf + else Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 96, column 17) + _lhsOmbRepl = + if _lhsIallowTrfToCon + then Just _cTrf + else Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 67, column 17) + _levOf = + cLevIntern + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _bindsOcvarIntroMp :: CVarIntroMp + _bodyOcvarIntroMp :: CVarIntroMp + _lhsOmbRepl :: (Maybe CExpr) + _lhsOcTrf :: CExpr + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _bindsOallowTrfToCon :: Bool + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOisGlobal :: Bool + _bindsOlev :: Int + _bindsOnmMp :: NmMp + _bindsOnoTrfNmS :: HsNameS + _bindsOnoTrfToConNmS :: HsNameS + _bodyOallowTrfToCon :: Bool + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOlev :: Int + _bodyOnmMp :: NmMp + _bodyOnoTrfNmS :: HsNameS + _bodyOnoTrfToConNmS :: HsNameS + _bindsIbindL :: ([(HsName,CBind)]) + _bindsIbindNmMp :: NmMp + _bindsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindsIbindsNoTrfNmS :: HsNameS + _bindsIcTrf :: CBindL + _bindsIcvarIntroExprMp :: CVarIntroMp + _bindsIfvS :: FvS + _bindsIfvSMp :: FvSMp + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + _bodyIbindNmMp :: NmMp + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIlevOf :: Int + _bodyImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 24, column 17) + _maxBindLev = + fvsLev _lhsIcvarIntroMp cLevModule _bindsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + __tup2 = + case categ_ of + CBindCateg_Strict -> (const _lhsIlev,_lhsIcvarIntroMp) + CBindCateg_Rec -> ( const _maxBindLev + , Map.map (\cvi -> cvi {cviLev = _maxBindLev}) _bindsIcvarIntroExprMp + `Map.union` _lhsIcvarIntroMp + ) + _ -> (id,_lhsIcvarIntroMp) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_strLev,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_,_bindsOcvarIntroMp) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 33, column 17) + _bodyOcvarIntroMp = + Map.map (\cvi -> cvi {cviLev = _strLev $ cviLev cvi}) _bindsIcvarIntroExprMp `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 45, column 17) + _introCVarIntroMp = + Map.map (\cvi -> cvi {cviLev = _lhsIlev}) _bindsIbindsIntroCVarIntroMp `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 66, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _fvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 6, column 17) + _fvS = + (_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 60, column 17) + _allowTrf = + categ_ /= CBindCateg_Strict + && categ_ /= CBindCateg_FFI + && categ_ /= CBindCateg_FFE + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 60, column 17) + _allowStrTrf = + categ_ /= CBindCateg_FFI + && categ_ /= CBindCateg_FFE + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 60, column 17) + _nmMpNew = + Map.foldrWithKey + (\n r m + -> case r of + CExpr_Var ref + | nm `Map.member` _bindsIbindNmMp + -> m + | _allowTrf || (_allowStrTrf && cexprIsEvaluated r') + -> Map.insert n r' m + where nm = acbrefNm ref + r' = maybe r id . Map.lookup nm $ _lhsInmMp + _ | _allowTrf + -> Map.insert n r m + CExpr_Int i + | _allowStrTrf + -> Map.insert n r m + _ -> m + ) + Map.empty + _bindsIbindNmMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 60, column 17) + _nmMp = + Map.union _nmMpNew $ Map.difference _lhsInmMp _bindsIcvarIntroExprMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 161, column 17) + _lhsOcTrf = + if Map.null _nmMpNew + then _cTrf + else acoreLet categ_ + [ b | (n,b) <- _bindsIbindL + , not (n `Map.member` _nmMpNew) + || n `Set.member` _bindsIbindsNoTrfNmS + ] _bodyIcTrf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _bindsIbindNmMp `Map.union` _bodyIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- copy rule (down) + _bindsOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (from local) + _bindsOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (from local) + _bindsOnmMp = + _nmMp + -- copy rule (down) + _bindsOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bindsOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _bodyOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (from local) + _bodyOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (from local) + _bodyOnmMp = + _nmMp + -- copy rule (down) + _bodyOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bodyOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _bindsIbindL,_bindsIbindNmMp,_bindsIbindsIntroCVarIntroMp,_bindsIbindsNoTrfNmS,_bindsIcTrf,_bindsIcvarIntroExprMp,_bindsIfvS,_bindsIfvSMp,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOallowTrfToCon _bindsOcvarIntroMp _bindsOintroCVarIntroMp _bindsOisGlobal _bindsOlev _bindsOnmMp _bindsOnoTrfNmS _bindsOnoTrfToConNmS + ( _bodyIbindNmMp,_bodyIcTrf,_bodyIfvS,_bodyIlevOf,_bodyImbRepl) = + body_ _bodyOallowTrfToCon _bodyOcvarIntroMp _bodyOintroCVarIntroMp _bodyOlev _bodyOnmMp _bodyOnoTrfNmS _bodyOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _argOnm :: HsName + _lhsOmbRepl :: (Maybe CExpr) + _argOaspBindNmMp :: (ACoreBindAspMp NmMp) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _funcOallowTrfToCon :: Bool + _funcOcvarIntroMp :: CVarIntroMp + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOlev :: Int + _funcOnmMp :: NmMp + _funcOnoTrfNmS :: HsNameS + _funcOnoTrfToConNmS :: HsNameS + _argOallowTrfToCon :: Bool + _argOcvarIntroMp :: CVarIntroMp + _argOintroCVarIntroMp :: CVarIntroMp + _argOisGlobal :: Bool + _argOlev :: Int + _argOnmMp :: NmMp + _argOnoTrfNmS :: HsNameS + _argOnoTrfToConNmS :: HsNameS + _funcIbindNmMp :: NmMp + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIlevOf :: Int + _funcImbRepl :: (Maybe CExpr) + _argIbindL :: ([(HsName,CBind)]) + _argIbindNmMp :: NmMp + _argIbindsIntroCVarIntroMp :: CVarIntroMp + _argIbindsNoTrfNmS :: HsNameS + _argIcTrf :: CBound + _argIcvarIntroExprMp :: CVarIntroMp + _argIfvS :: FvS + _argIfvSMp :: FvSMp + _argIgathAspBindNmMp :: (ACoreBindAspMp NmMp) + _argIlevOf :: Int + _argInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 60, column 17) + _levOf = + _funcIlevOf `max` _argIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 8, column 17) + _fvS = + _funcIfvS `Set.union` _argIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 155, column 25) + _argOaspBindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _funcIbindNmMp `Map.union` _argIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _funcOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOnmMp = + _lhsInmMp + -- copy rule (down) + _funcOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _funcOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _argOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _argOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _argOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOnmMp = + _lhsInmMp + -- copy rule (down) + _argOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _argOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _funcIbindNmMp,_funcIcTrf,_funcIfvS,_funcIlevOf,_funcImbRepl) = + func_ _funcOallowTrfToCon _funcOcvarIntroMp _funcOintroCVarIntroMp _funcOlev _funcOnmMp _funcOnoTrfNmS _funcOnoTrfToConNmS + ( _argIbindL,_argIbindNmMp,_argIbindsIntroCVarIntroMp,_argIbindsNoTrfNmS,_argIcTrf,_argIcvarIntroExprMp,_argIfvS,_argIfvSMp,_argIgathAspBindNmMp,_argIlevOf,_argInmL) = + arg_ _argOallowTrfToCon _argOaspBindNmMp _argOcvarIntroMp _argOintroCVarIntroMp _argOisGlobal _argOlev _argOnm _argOnmMp _argOnoTrfNmS _argOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOnmMp :: NmMp + _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _bindOallowTrfToCon :: Bool + _bindOcvarIntroMp :: CVarIntroMp + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOisGlobal :: Bool + _bindOlev :: Int + _bindOnmMp :: NmMp + _bindOnoTrfNmS :: HsNameS + _bindOnoTrfToConNmS :: HsNameS + _bodyOallowTrfToCon :: Bool + _bodyOlev :: Int + _bodyOnoTrfNmS :: HsNameS + _bodyOnoTrfToConNmS :: HsNameS + _bindIbindL :: ([(HsName,CBind)]) + _bindIbindNmMp :: NmMp + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIbindsNoTrfNmS :: HsNameS + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bodyIbindNmMp :: NmMp + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIlevOf :: Int + _bodyImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 4, column 17) + _cvi = + CVarIntro + { cviLev = _lev + , cviMeta = CMetaVal_Val + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 23, column 17) + _bodyOcvarIntroMp = + Map.insert _argNm _cvi _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 44, column 17) + _bodyOintroCVarIntroMp = + Map.insert _argNm _cvi _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 65, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 5, column 17) + _fvS = + _argNm `Set.delete` _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 85, column 25) + _bodyOnmMp = + Map.delete _argNm _lhsInmMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _bindIbindNmMp `Map.union` _bodyIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (down) + _bindOnmMp = + _lhsInmMp + -- copy rule (down) + _bindOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bindOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _bodyOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (down) + _bodyOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bodyOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _bindIbindL,_bindIbindNmMp,_bindIbindsIntroCVarIntroMp,_bindIbindsNoTrfNmS,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOallowTrfToCon _bindOcvarIntroMp _bindOintroCVarIntroMp _bindOisGlobal _bindOlev _bindOnmMp _bindOnoTrfNmS _bindOnoTrfToConNmS + ( _bodyIbindNmMp,_bodyIcTrf,_bodyIfvS,_bodyIlevOf,_bodyImbRepl) = + body_ _bodyOallowTrfToCon _bodyOcvarIntroMp _bodyOintroCVarIntroMp _bodyOlev _bodyOnmMp _bodyOnoTrfNmS _bodyOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _altsOallowTrfToCon :: Bool + _altsOcvarIntroMp :: CVarIntroMp + _altsOintroCVarIntroMp :: CVarIntroMp + _altsOlev :: Int + _altsOnmMp :: NmMp + _altsOnoTrfToConNmS :: HsNameS + _dfltOallowTrfToCon :: Bool + _dfltOcvarIntroMp :: CVarIntroMp + _dfltOintroCVarIntroMp :: CVarIntroMp + _dfltOlev :: Int + _dfltOnmMp :: NmMp + _dfltOnoTrfNmS :: HsNameS + _dfltOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + _altsIcTrf :: CAltL + _altsIfvS :: FvS + _altsIlevOf :: Int + _dfltIbindNmMp :: NmMp + _dfltIcTrf :: CExpr + _dfltIfvS :: FvS + _dfltIlevOf :: Int + _dfltImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 61, column 17) + _levOf = + _exprIlevOf `max` _altsIlevOf `max` _dfltIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _exprIbindNmMp `Map.union` _dfltIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _altsOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _altsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _altsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOnmMp = + _lhsInmMp + -- copy rule (down) + _altsOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _dfltOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _dfltOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _dfltOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOnmMp = + _lhsInmMp + -- copy rule (down) + _dfltOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _dfltOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + ( _altsIcTrf,_altsIfvS,_altsIlevOf) = + alts_ _altsOallowTrfToCon _altsOcvarIntroMp _altsOintroCVarIntroMp _altsOlev _altsOnmMp _altsOnoTrfToConNmS + ( _dfltIbindNmMp,_dfltIcTrf,_dfltIfvS,_dfltIlevOf,_dfltImbRepl) = + dflt_ _dfltOallowTrfToCon _dfltOcvarIntroMp _dfltOintroCVarIntroMp _dfltOlev _dfltOnmMp _dfltOnoTrfNmS _dfltOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _errorExprOallowTrfToCon :: Bool + _errorExprOcvarIntroMp :: CVarIntroMp + _errorExprOintroCVarIntroMp :: CVarIntroMp + _errorExprOlev :: Int + _errorExprOnmMp :: NmMp + _errorExprOnoTrfNmS :: HsNameS + _errorExprOnoTrfToConNmS :: HsNameS + _errorExprIbindNmMp :: NmMp + _errorExprIcTrf :: CExpr + _errorExprIfvS :: FvS + _errorExprIlevOf :: Int + _errorExprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _errorExprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _errorExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _errorExprIlevOf + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _errorExprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _errorExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _errorExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOnmMp = + _lhsInmMp + -- copy rule (down) + _errorExprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _errorExprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _errorExprIbindNmMp,_errorExprIcTrf,_errorExprIfvS,_errorExprIlevOf,_errorExprImbRepl) = + errorExpr_ _errorExprOallowTrfToCon _errorExprOcvarIntroMp _errorExprOintroCVarIntroMp _errorExprOlev _errorExprOnmMp _errorExprOnoTrfNmS _errorExprOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _offsetOallowTrfToCon :: Bool + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlev :: Int + _offsetOnmMp :: NmMp + _offsetOnoTrfNmS :: HsNameS + _offsetOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + _offsetIbindNmMp :: NmMp + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIlevOf :: Int + _offsetImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 62, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _exprIbindNmMp `Map.union` _offsetIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _offsetOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOnmMp = + _lhsInmMp + -- copy rule (down) + _offsetOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _offsetOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + ( _offsetIbindNmMp,_offsetIcTrf,_offsetIfvS,_offsetIlevOf,_offsetImbRepl) = + offset_ _offsetOallowTrfToCon _offsetOcvarIntroMp _offsetOintroCVarIntroMp _offsetOlev _offsetOnmMp _offsetOnoTrfNmS _offsetOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _offsetOallowTrfToCon :: Bool + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlev :: Int + _offsetOnmMp :: NmMp + _offsetOnoTrfNmS :: HsNameS + _offsetOnoTrfToConNmS :: HsNameS + _fldExprOallowTrfToCon :: Bool + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOlev :: Int + _fldExprOnmMp :: NmMp + _fldExprOnoTrfNmS :: HsNameS + _fldExprOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + _offsetIbindNmMp :: NmMp + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIlevOf :: Int + _offsetImbRepl :: (Maybe CExpr) + _fldExprIbindNmMp :: NmMp + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIlevOf :: Int + _fldExprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _exprIbindNmMp `Map.union` _offsetIbindNmMp `Map.union` _fldExprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _offsetOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOnmMp = + _lhsInmMp + -- copy rule (down) + _offsetOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _offsetOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _fldExprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOnmMp = + _lhsInmMp + -- copy rule (down) + _fldExprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _fldExprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + ( _offsetIbindNmMp,_offsetIcTrf,_offsetIfvS,_offsetIlevOf,_offsetImbRepl) = + offset_ _offsetOallowTrfToCon _offsetOcvarIntroMp _offsetOintroCVarIntroMp _offsetOlev _offsetOnmMp _offsetOnoTrfNmS _offsetOnoTrfToConNmS + ( _fldExprIbindNmMp,_fldExprIcTrf,_fldExprIfvS,_fldExprIlevOf,_fldExprImbRepl) = + fldExpr_ _fldExprOallowTrfToCon _fldExprOcvarIntroMp _fldExprOintroCVarIntroMp _fldExprOlev _fldExprOnmMp _fldExprOnoTrfNmS _fldExprOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _offsetOallowTrfToCon :: Bool + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlev :: Int + _offsetOnmMp :: NmMp + _offsetOnoTrfNmS :: HsNameS + _offsetOnoTrfToConNmS :: HsNameS + _fldExprOallowTrfToCon :: Bool + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOlev :: Int + _fldExprOnmMp :: NmMp + _fldExprOnoTrfNmS :: HsNameS + _fldExprOnoTrfToConNmS :: HsNameS + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + _offsetIbindNmMp :: NmMp + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIlevOf :: Int + _offsetImbRepl :: (Maybe CExpr) + _fldExprIbindNmMp :: NmMp + _fldExprIcTrf :: CExpr + _fldExprIfvS :: FvS + _fldExprIlevOf :: Int + _fldExprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _exprIbindNmMp `Map.union` _offsetIbindNmMp `Map.union` _fldExprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _offsetOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOnmMp = + _lhsInmMp + -- copy rule (down) + _offsetOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _offsetOnoTrfToConNmS = + _lhsInoTrfToConNmS + -- copy rule (down) + _fldExprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOnmMp = + _lhsInmMp + -- copy rule (down) + _fldExprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _fldExprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + ( _offsetIbindNmMp,_offsetIcTrf,_offsetIfvS,_offsetIlevOf,_offsetImbRepl) = + offset_ _offsetOallowTrfToCon _offsetOcvarIntroMp _offsetOintroCVarIntroMp _offsetOlev _offsetOnmMp _offsetOnoTrfNmS _offsetOnoTrfToConNmS + ( _fldExprIbindNmMp,_fldExprIcTrf,_fldExprIfvS,_fldExprIlevOf,_fldExprImbRepl) = + fldExpr_ _fldExprOallowTrfToCon _fldExprOcvarIntroMp _fldExprOintroCVarIntroMp _fldExprOlev _fldExprOnmMp _fldExprOnoTrfNmS _fldExprOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _bodyOallowTrfToCon :: Bool + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOlev :: Int + _bodyOnmMp :: NmMp + _bodyOnoTrfNmS :: HsNameS + _bodyOnoTrfToConNmS :: HsNameS + _bodyIbindNmMp :: NmMp + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIlevOf :: Int + _bodyImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _bodyIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bodyOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOnmMp = + _lhsInmMp + -- copy rule (down) + _bodyOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bodyOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _bodyIbindNmMp,_bodyIcTrf,_bodyIfvS,_bodyIlevOf,_bodyImbRepl) = + body_ _bodyOallowTrfToCon _bodyOcvarIntroMp _bodyOintroCVarIntroMp _bodyOlev _bodyOnmMp _bodyOnoTrfNmS _bodyOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _funcOallowTrfToCon :: Bool + _funcOcvarIntroMp :: CVarIntroMp + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOlev :: Int + _funcOnmMp :: NmMp + _funcOnoTrfNmS :: HsNameS + _funcOnoTrfToConNmS :: HsNameS + _funcIbindNmMp :: NmMp + _funcIcTrf :: CExpr + _funcIfvS :: FvS + _funcIlevOf :: Int + _funcImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _funcIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _funcIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _funcIlevOf + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _funcOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOnmMp = + _lhsInmMp + -- copy rule (down) + _funcOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _funcOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _funcIbindNmMp,_funcIcTrf,_funcIfvS,_funcIlevOf,_funcImbRepl) = + func_ _funcOallowTrfToCon _funcOcvarIntroMp _funcOintroCVarIntroMp _funcOlev _funcOnmMp _funcOnoTrfNmS _funcOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsOmbRepl :: (Maybe CExpr) + _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _bodyOallowTrfToCon :: Bool + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOlev :: Int + _bodyOnmMp :: NmMp + _bodyOnoTrfNmS :: HsNameS + _bodyOnoTrfToConNmS :: HsNameS + _bodyIbindNmMp :: NmMp + _bodyIcTrf :: CExpr + _bodyIfvS :: FvS + _bodyIlevOf :: Int + _bodyImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 102, column 17) + _lhsOmbRepl = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _bodyIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bodyOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOnmMp = + _lhsInmMp + -- copy rule (down) + _bodyOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _bodyOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _bodyIbindNmMp,_bodyIcTrf,_bodyIfvS,_bodyIlevOf,_bodyImbRepl) = + body_ _bodyOallowTrfToCon _bodyOcvarIntroMp _bodyOintroCVarIntroMp _bodyOlev _bodyOnmMp _bodyOnoTrfNmS _bodyOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIallowTrfToCon + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS + _lhsInoTrfToConNmS -> + (let _lhsObindNmMp :: NmMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOmbRepl :: (Maybe CExpr) + _annOcvarIntroMp :: CVarIntroMp + _annOintroCVarIntroMp :: CVarIntroMp + _annOlev :: Int + _annOnmMp :: NmMp + _exprOallowTrfToCon :: Bool + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _exprOnoTrfToConNmS :: HsNameS + _annIcTrf :: CExprAnn + _annIfvS :: FvS + _annIlevOf :: Int + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 174, column 41) + _lhsObindNmMp = + _exprIbindNmMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _annIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _annIlevOf `max` _exprIlevOf + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOmbRepl = + _exprImbRepl + -- copy rule (down) + _annOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _annOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOallowTrfToCon = + _lhsIallowTrfToCon + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + -- copy rule (down) + _exprOnoTrfToConNmS = + _lhsInoTrfToConNmS + ( _annIcTrf,_annIfvS,_annIlevOf) = + ann_ _annOcvarIntroMp _annOintroCVarIntroMp _annOlev _annOnmMp + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsObindNmMp,_lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOmbRepl))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + levOf : Int + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CExprAnn,FvS,Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + levOf : Int + self : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + local self : _ + alternative Function0: + visit 0: + local cTrf : _ + local self : _ + alternative Function1: + visit 0: + local cTrf : _ + local self : _ + alternative Apply0: + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CMetaBind,FvS,Int,CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _self = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _self = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _self = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _self = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOself))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + bindNmMp : NmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + levOf : Int + nameS : HsNameS + self : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + local self : _ + alternative Dict: + visit 0: + local cTrf : _ + local self : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = NmMp -> + CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CMetaVal,FvS,Int,HsNameS,CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnameS :: HsNameS + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 184, column 21) + _lhsOnameS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _self = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnameS :: HsNameS + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 184, column 21) + _lhsOnameS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _self = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnameS :: HsNameS + _lhsOcTrf :: CMetaVal + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOself :: CMetaVal + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 186, column 21) + _lhsOnameS = + Set.fromList (concatMap trackNames tracks_) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 191, column 21) + _lhsOcTrf = + CMetaVal_DictClass (map (substTrack _lhsIbindNmMp) tracks_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _self = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnameS :: HsNameS + _lhsOcTrf :: CMetaVal + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOself :: CMetaVal + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 186, column 21) + _lhsOnameS = + Set.fromList (concatMap trackNames tracks_) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 192, column 21) + _lhsOcTrf = + CMetaVal_DictInstance (map (substTrack _lhsIbindNmMp) tracks_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _self = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnameS :: HsNameS + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 188, column 41) + _lhsOnameS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _self = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + bindNmMp : NmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CMetas + fvS : FvS + levOf : Int + nameS : HsNameS + self : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = NmMp -> + CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CMetas,FvS,Int,HsNameS,CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIbindNmMp + _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetas + _lhsOself :: CMetas + _lhsOnameS :: HsNameS + _x1OcvarIntroMp :: CVarIntroMp + _x1OintroCVarIntroMp :: CVarIntroMp + _x1Olev :: Int + _x1OnmMp :: NmMp + _x2ObindNmMp :: NmMp + _x2OcvarIntroMp :: CVarIntroMp + _x2OintroCVarIntroMp :: CVarIntroMp + _x2Olev :: Int + _x2OnmMp :: NmMp + _x1IcTrf :: CMetaBind + _x1IfvS :: FvS + _x1IlevOf :: Int + _x1Iself :: CMetaBind + _x2IcTrf :: CMetaVal + _x2IfvS :: FvS + _x2IlevOf :: Int + _x2InameS :: HsNameS + _x2Iself :: CMetaVal + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _x1IfvS `Set.union` _x2IfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _x1IlevOf `max` _x2IlevOf + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _self = + (_x1Iself,_x2Iself) + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOnameS = + _x2InameS + -- copy rule (down) + _x1OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x1OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1OnmMp = + _lhsInmMp + -- copy rule (down) + _x2ObindNmMp = + _lhsIbindNmMp + -- copy rule (down) + _x2OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x2OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2OnmMp = + _lhsInmMp + ( _x1IcTrf,_x1IfvS,_x1IlevOf,_x1Iself) = + x1_ _x1OcvarIntroMp _x1OintroCVarIntroMp _x1Olev _x1OnmMp + ( _x2IcTrf,_x2IfvS,_x2IlevOf,_x2InameS,_x2Iself) = + x2_ _x2ObindNmMp _x2OcvarIntroMp _x2OintroCVarIntroMp _x2Olev _x2OnmMp + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnameS,_lhsOself))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + noTrfNmS : HsNameS + synthesized attributes: + cTrf : CModule + fvS : FvS + levOf : Int + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + HsNameS -> + ( CModule,FvS,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp + _lhsInoTrfNmS -> + (let _exprOallowTrfToCon :: Bool + _exprOnoTrfToConNmS :: HsNameS + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CModule + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlev :: Int + _exprOnmMp :: NmMp + _exprOnoTrfNmS :: HsNameS + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIbindNmMp :: NmMp + _exprIcTrf :: CExpr + _exprIfvS :: FvS + _exprIlevOf :: Int + _exprImbRepl :: (Maybe CExpr) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 122, column 11) + _exprOallowTrfToCon = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 133, column 11) + _exprOnoTrfToConNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOnmMp = + _lhsInmMp + -- copy rule (down) + _exprOnoTrfNmS = + _lhsInoTrfNmS + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIbindNmMp,_exprIcTrf,_exprIfvS,_exprIlevOf,_exprImbRepl) = + expr_ _exprOallowTrfToCon _exprOcvarIntroMp _exprOintroCVarIntroMp _exprOlev _exprOnmMp _exprOnoTrfNmS _exprOnoTrfToConNmS + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CPat,([HsName]),FvS,Int,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 28, column 17) + _lhsOnmL = + [pnm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _restOcvarIntroMp :: CVarIntroMp + _restOintroCVarIntroMp :: CVarIntroMp + _restOlev :: Int + _restOnmMp :: NmMp + _bindsOcvarIntroMp :: CVarIntroMp + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOlev :: Int + _bindsOnmMp :: NmMp + _restIcTrf :: CPatRest + _restIfvS :: FvS + _restIlevOf :: Int + _restInmL :: ([HsName]) + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + _bindsIfvS :: FvS + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 29, column 17) + _lhsOnmL = + _restInmL ++ _bindsInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _restIfvS `Set.union` _bindsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _restIlevOf `max` _bindsIlevOf + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _restOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _restOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOnmMp = + _lhsInmMp + -- copy rule (down) + _bindsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOnmMp = + _lhsInmMp + ( _restIcTrf,_restIfvS,_restIlevOf,_restInmL) = + rest_ _restOcvarIntroMp _restOintroCVarIntroMp _restOlev _restOnmMp + ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOcvarIntroMp _bindsOintroCVarIntroMp _bindsOlev _bindsOnmMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local noTrfNmS : _ + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CPatFld,([HsName]),FvS,Int,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _bindOisGlobal :: Bool + _offsetOallowTrfToCon :: Bool + _bindOallowTrfToCon :: Bool + _offsetOnoTrfToConNmS :: HsNameS + _bindOnoTrfToConNmS :: HsNameS + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatFld + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlev :: Int + _offsetOnmMp :: NmMp + _offsetOnoTrfNmS :: HsNameS + _bindOcvarIntroMp :: CVarIntroMp + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOlev :: Int + _bindOnmMp :: NmMp + _bindOnoTrfNmS :: HsNameS + _fldAnnsOcvarIntroMp :: CVarIntroMp + _fldAnnsOintroCVarIntroMp :: CVarIntroMp + _fldAnnsOlev :: Int + _fldAnnsOnmMp :: NmMp + _offsetIbindNmMp :: NmMp + _offsetIcTrf :: CExpr + _offsetIfvS :: FvS + _offsetIlevOf :: Int + _offsetImbRepl :: (Maybe CExpr) + _bindIbindL :: ([(HsName,CBind)]) + _bindIbindNmMp :: NmMp + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIbindsNoTrfNmS :: HsNameS + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIfvS :: FvS + _fldAnnsIlevOf :: Int + _fldAnnsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 22, column 17) + _lhsOnmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 48, column 17) + _noTrfNmS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 125, column 11) + _offsetOallowTrfToCon = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 126, column 19) + _bindOallowTrfToCon = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 136, column 11) + _offsetOnoTrfToConNmS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 137, column 19) + _bindOnoTrfToConNmS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _offsetIlevOf `max` _bindIlevOf `max` _fldAnnsIlevOf + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOnmMp = + _lhsInmMp + -- copy rule (from local) + _offsetOnoTrfNmS = + _noTrfNmS + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOnmMp = + _lhsInmMp + -- copy rule (from local) + _bindOnoTrfNmS = + _noTrfNmS + -- copy rule (down) + _fldAnnsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldAnnsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOnmMp = + _lhsInmMp + ( _offsetIbindNmMp,_offsetIcTrf,_offsetIfvS,_offsetIlevOf,_offsetImbRepl) = + offset_ _offsetOallowTrfToCon _offsetOcvarIntroMp _offsetOintroCVarIntroMp _offsetOlev _offsetOnmMp _offsetOnoTrfNmS _offsetOnoTrfToConNmS + ( _bindIbindL,_bindIbindNmMp,_bindIbindsIntroCVarIntroMp,_bindIbindsNoTrfNmS,_bindIcTrf,_bindIcvarIntroExprMp,_bindIfvS,_bindIfvSMp,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOallowTrfToCon _bindOcvarIntroMp _bindOintroCVarIntroMp _bindOisGlobal _bindOlev _bindOnmMp _bindOnoTrfNmS _bindOnoTrfToConNmS + ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsIlevOf,_fldAnnsInmL) = + fldAnns_ _fldAnnsOcvarIntroMp _fldAnnsOintroCVarIntroMp _fldAnnsOlev _fldAnnsOnmMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CPatFldL,([HsName]),FvS,Int,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _hdOcvarIntroMp :: CVarIntroMp + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlev :: Int + _hdOnmMp :: NmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlev :: Int + _tlOnmMp :: NmMp + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _hdIfvS :: FvS + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + _tlIfvS :: FvS + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnmMp = + _lhsInmMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnmMp = + _lhsInmMp + ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdIlevOf,_hdInmL) = + hd_ _hdOcvarIntroMp _hdOintroCVarIntroMp _hdOlev _hdOnmMp + ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlIlevOf,_tlInmL) = + tl_ _tlOcvarIntroMp _tlOintroCVarIntroMp _tlOlev _tlOnmMp + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lev : Int + nmMp : NmMp + synthesized attributes: + cTrf : CPatRest + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = CVarIntroMp -> + CVarIntroMp -> + Int -> + NmMp -> + ( CPatRest,FvS,Int,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOnmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatRest + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 25, column 17) + _lhsOnmL = + [nm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIcvarIntroMp + _lhsIintroCVarIntroMp + _lhsIlev + _lhsInmMp -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatRest + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfvS,_lhsOlevOf,_lhsOnmL))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attribute: + noTrfNmS : HsNameS + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = HsNameS -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {noTrfNmS_Inh_CodeAGItf :: !(HsNameS)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsInoTrfNmS) = + (let ( _lhsOcTrf) = sem _lhsInoTrfNmS + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsInoTrfNmS -> + (let _moduleOcvarIntroMp :: CVarIntroMp + _moduleOintroCVarIntroMp :: CVarIntroMp + _moduleOlev :: Int + _moduleOnmMp :: NmMp + _lhsOcTrf :: CModule + _moduleOnoTrfNmS :: HsNameS + _moduleIcTrf :: CModule + _moduleIfvS :: FvS + _moduleIlevOf :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 20, column 17) + _moduleOcvarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 41, column 17) + _moduleOintroCVarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/InlineLetAlias.ag"(line 57, column 17) + _moduleOnmMp = + Map.empty + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + -- copy rule (down) + _moduleOnoTrfNmS = + _lhsInoTrfNmS + ( _moduleIcTrf,_moduleIfvS,_moduleIlevOf) = + module_ _moduleOcvarIntroMp _moduleOintroCVarIntroMp _moduleOlev _moduleOnmMp _moduleOnoTrfNmS + in ( _lhsOcTrf))) diff --git a/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs b/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs @@ -0,0 +1,8718 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGl) +module UHC.Light.Compiler.Core.Trf.LamGlobalAsArg(cmodTrfLamGlobalAsArg) where + +import UHC.Util.Utils +import Data.Maybe +import qualified Data.Set as Set +import Data.List +import qualified Data.Map as Map +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Debug.Trace + + + + + + + + + + + + + + + +cmodTrfLamGlobalAsArg :: CModule -> CModule +cmodTrfLamGlobalAsArg cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf) + in cTrf_Syn_CodeAGItf t + + + +type AspBindLamArgInfo = (LamArgMp,Env) + + + +type LamArgMp = Map.Map HsName CVarIntroL + + + + +type Env = Map.Map HsName Track + +metaExtendTrack :: LamArgMp -> Env -> Track -> Track +metaExtendTrack mp env (TrackVarApply nm ps) = let r = Map.lookup nm mp + xs = maybe [] assocLKeys r + ts = map (\x -> Map.findWithDefault (TrackVarApply x []) x env) xs + in -- trace (show nm ++ " extended with " ++ show ts) $ + (TrackVarApply nm (ts++ps)) +metaExtendTrack _ _ t = t + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CAlt + fvS : FvS + levOf : Int + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local cvi : _ + local fvS : _ + local whatAbove : {WhatExpr} + local lev : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CAlt,FvS,Int,Int) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _exprOvarS :: FvS + _exprOcvarIntroMp :: CVarIntroMp + _exprOintroCVarIntroMp :: CVarIntroMp + _lhsOlevOf :: Int + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOmbCtxCount :: (Maybe Int) + _exprOisDictClass :: Bool + _lhsOfvS :: FvS + _lhsOcTrf :: CAlt + _lhsOgUniq :: Int + _patOargMp :: CVarReplNmMp + _patOcvarIntroMp :: CVarIntroMp + _patOgUniq :: Int + _patOintroCVarIntroMp :: CVarIntroMp + _patOlamArgMp :: LamArgMp + _patOlamFvSMp :: FvSMp + _patOlamS :: FvS + _patOlev :: Int + _patOvarS :: FvS + _exprOargMp :: CVarReplNmMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOwhatAbove :: WhatExpr + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _patIfvS :: FvS + _patIgUniq :: Int + _patIlevOf :: Int + _patInmL :: ([HsName]) + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 23, column 17) + _exprOvarS = + _lhsIvarS `Set.union` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 15, column 17) + _cvi = + emptyCVarIntro { cviLev = _lev } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 36, column 17) + _exprOcvarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 48, column 17) + _exprOintroCVarIntroMp = + Map.fromList (zip _patInmL (repeat _cvi)) `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 70, column 17) + _lhsOlevOf = + fvsLev _lhsIcvarIntroMp cLevModule _exprIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 14, column 17) + _fvS = + _exprIfvS `Set.difference` Set.fromList _patInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 45, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 87, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevAlt.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 188, column 10) + _exprOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 189, column 10) + _exprOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _patOargMp = + _lhsIargMp + -- copy rule (down) + _patOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _patOgUniq = + _lhsIgUniq + -- copy rule (down) + _patOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _patOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _patOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _patOlamS = + _lhsIlamS + -- copy rule (from local) + _patOlev = + _lev + -- copy rule (down) + _patOvarS = + _lhsIvarS + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _exprOgUniq = + _patIgUniq + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (from local) + _exprOlev = + _lev + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _patIcTrf,_patIfldNmL,_patIfvS,_patIgUniq,_patIlevOf,_patInmL) = + pat_ _patOargMp _patOcvarIntroMp _patOgUniq _patOintroCVarIntroMp _patOlamArgMp _patOlamFvSMp _patOlamS _patOlev _patOvarS + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CAltL + fvS : FvS + levOf : Int + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CAltL,FvS,Int,Int) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamArgMp :: LamArgMp + _hdOlamFvSMp :: FvSMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamArgMp :: LamArgMp + _tlOlamFvSMp :: FvSMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CAlt + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _tlIcTrf :: CAltL + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _hdOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _tlOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevOf) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOlamArgMp _hdOlamFvSMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevOf) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOlamArgMp _tlOlamFvSMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CAltL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamArgMp : LamArgMp + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBind + cvarIntroExprMp : CVarIntroMp + envUp : Env + fvS : FvS + fvSMp : FvSMp + levOf : Int + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local aspBindLamArgMp : _ + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + Bool -> + LamArgMp -> + FvSMp -> + FvS -> + CBindCateg -> + Int -> + FvS -> + ( LamArgMp,FvS,FvS,CVarIntroMp,CBind,CVarIntroMp,Env,FvS,FvSMp,Int,Int,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsOfvSMp :: FvSMp + _lhsOnmL :: ([HsName]) + _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CBind + _lhsOgUniq :: Int + _bindAspectsOargMp :: CVarReplNmMp + _bindAspectsOaspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _bindAspectsOcvarIntroMp :: CVarIntroMp + _bindAspectsOevalCtx :: EvalCtx + _bindAspectsOgUniq :: Int + _bindAspectsOintroCVarIntroMp :: CVarIntroMp + _bindAspectsOisGlobal :: Bool + _bindAspectsOlamArgMp :: LamArgMp + _bindAspectsOlamFvSMp :: FvSMp + _bindAspectsOlamS :: FvS + _bindAspectsOletBindingsCateg :: CBindCateg + _bindAspectsOlev :: Int + _bindAspectsOvarS :: FvS + _bindAspectsIbindLamArgMp :: LamArgMp + _bindAspectsIbindLamS :: FvS + _bindAspectsIbindVarS :: FvS + _bindAspectsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIcvarIntroExprMp :: CVarIntroMp + _bindAspectsIenvUp :: Env + _bindAspectsIfvS :: FvS + _bindAspectsIfvSMp :: FvSMp + _bindAspectsIgUniq :: Int + _bindAspectsIgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _bindAspectsIlevOf :: Int + _bindAspectsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 11, column 17) + _lhsOfvSMp = + Map.singleton nm_ _bindAspectsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 19, column 17) + _lhsOnmL = + [nm_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 92, column 25) + _aspBindLamArgMp = + _bindAspectsIgathAspBindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bindAspectsIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _bindAspectsIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _bindAspectsIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _bindAspectsIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _bindAspectsIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + _bindAspectsIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindAspectsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindAspectsIlevOf + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindAspectsIgUniq + -- copy rule (down) + _bindAspectsOargMp = + _lhsIargMp + -- copy rule (from local) + _bindAspectsOaspBindLamArgMp = + _aspBindLamArgMp + -- copy rule (down) + _bindAspectsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindAspectsOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindAspectsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindAspectsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindAspectsOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _bindAspectsOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bindAspectsOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bindAspectsOlamS = + _lhsIlamS + -- copy rule (down) + _bindAspectsOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _bindAspectsOlev = + _lhsIlev + -- copy rule (down) + _bindAspectsOvarS = + _lhsIvarS + ( _bindAspectsIbindLamArgMp,_bindAspectsIbindLamS,_bindAspectsIbindVarS,_bindAspectsIbindsIntroCVarIntroMp,_bindAspectsIcTrf,_bindAspectsIcvarIntroExprMp,_bindAspectsIenvUp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsIgUniq,_bindAspectsIgathAspBindLamArgMp,_bindAspectsIlevOf,_bindAspectsInmL) = + bindAspects_ _bindAspectsOargMp _bindAspectsOaspBindLamArgMp _bindAspectsOcvarIntroMp _bindAspectsOevalCtx _bindAspectsOgUniq _bindAspectsOintroCVarIntroMp _bindAspectsOisGlobal _bindAspectsOlamArgMp _bindAspectsOlamFvSMp _bindAspectsOlamS _bindAspectsOletBindingsCateg _bindAspectsOlev _bindAspectsOnm _bindAspectsOvarS + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevOf,_lhsOnm,_lhsOnmL))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CBindAnn,FvS,Int,Int,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CBindAnnL,FvS,Int,Int,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamArgMp :: LamArgMp + _hdOlamFvSMp :: FvSMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamArgMp :: LamArgMp + _tlOlamFvSMp :: FvSMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CBindAnn + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CBindAnnL + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _hdOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _tlOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfvS,_hdIgUniq,_hdIlevOf,_hdInmL) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOgUniq _hdOintroCVarIntroMp _hdOlamArgMp _hdOlamFvSMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfvS,_tlIgUniq,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOgUniq _tlOintroCVarIntroMp _tlOlamArgMp _tlOlamFvSMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindAnnL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamArgMp : LamArgMp + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBindL + cvarIntroExprMp : CVarIntroMp + envUp : Env + fvS : FvS + fvSMp : FvSMp + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + Bool -> + LamArgMp -> + FvSMp -> + FvS -> + CBindCateg -> + Int -> + FvS -> + ( LamArgMp,FvS,FvS,CVarIntroMp,CBindL,CVarIntroMp,Env,FvS,FvSMp,Int,Int,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlamArgMp :: LamArgMp + _hdOlamFvSMp :: FvSMp + _hdOlamS :: FvS + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlamArgMp :: LamArgMp + _tlOlamFvSMp :: FvSMp + _tlOlamS :: FvS + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOvarS :: FvS + _hdIbindLamArgMp :: LamArgMp + _hdIbindLamS :: FvS + _hdIbindVarS :: FvS + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBind + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIenvUp :: Env + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: Int + _hdIlevOf :: Int + _hdInm :: HsName + _hdInmL :: ([HsName]) + _tlIbindLamArgMp :: LamArgMp + _tlIbindLamS :: FvS + _tlIbindVarS :: FvS + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBindL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIenvUp :: Env + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: Int + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _hdIbindLamArgMp `Map.union` _tlIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _hdIbindLamS `Set.union` _tlIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _hdIbindVarS `Set.union` _tlIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + _hdIenvUp `Map.union` _tlIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _hdOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _tlOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIbindLamArgMp,_hdIbindLamS,_hdIbindVarS,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIenvUp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIlevOf,_hdInm,_hdInmL) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOisGlobal _hdOlamArgMp _hdOlamFvSMp _hdOlamS _hdOletBindingsCateg _hdOlev _hdOvarS + ( _tlIbindLamArgMp,_tlIbindLamS,_tlIbindVarS,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIenvUp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOlamArgMp _tlOlamFvSMp _tlOlamS _tlOletBindingsCateg _tlOlev _tlOvarS + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsIvarS -> + (let _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBindL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + aspBindLamArgMp : ACoreBindAspMp AspBindLamArgInfo + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isDictClass : Bool + isGlobal : Bool + isTopApp : Bool + isTopTup : Bool + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + mbCtxCount : Maybe Int + nm : HsName + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamArgMp : LamArgMp + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBound + cvarIntroExprMp : CVarIntroMp + envUp : Env + fvS : FvS + fvSMp : FvSMp + gathAspBindLamArgMp : ACoreBindAspMp AspBindLamArgInfo + levOf : Int + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local _tup1 : _ + local cmetaVal : _ + local cvi : _ + local cviExpr : _ + local whatAbove : {WhatExpr} + local _tup2 : _ + local argNewL : _ + local argMpNew : _ + local bindLamArgMp : _ + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local _tup3 : _ + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = CVarReplNmMp -> + (ACoreBindAspMp AspBindLamArgInfo) -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + Bool -> + Bool -> + Bool -> + Bool -> + LamArgMp -> + FvSMp -> + FvS -> + CBindCateg -> + Int -> + (Maybe Int) -> + HsName -> + FvS -> + ( LamArgMp,FvS,FvS,CVarIntroMp,CBound,CVarIntroMp,Env,FvS,FvSMp,Int,(ACoreBindAspMp AspBindLamArgInfo),Int,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _lhsObindVarS :: FvS + _lhsObindLamS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOcTrf :: CBound + _bindMetaObindLamArgMp :: LamArgMp + _exprOmbCtxCount :: (Maybe Int) + _exprOisDictClass :: Bool + _bindMetaOenvFinal :: Env + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOgUniq :: Int + _bindMetaOargMp :: CVarReplNmMp + _bindMetaOcvarIntroMp :: CVarIntroMp + _bindMetaOgUniq :: Int + _bindMetaOintroCVarIntroMp :: CVarIntroMp + _bindMetaOlamArgMp :: LamArgMp + _bindMetaOlamFvSMp :: FvSMp + _bindMetaOlamS :: FvS + _bindMetaOlev :: Int + _bindMetaOvarS :: FvS + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _bindMetaIcTrf :: CMetas + _bindMetaIfvS :: FvS + _bindMetaIgUniq :: Int + _bindMetaIisDictClass :: Bool + _bindMetaIisDictInstance :: Bool + _bindMetaIisInstance :: Bool + _bindMetaIlevOf :: Int + _bindMetaImbTrack :: (Maybe Track) + _bindMetaIself :: CMetas + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + __tup1 = + if isJust _exprImbLam + then (Set.empty,Set.singleton _lhsInm) + else (Set.singleton _lhsInm,Set.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + (_lhsObindVarS,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 6, column 33) + (_,_lhsObindLamS) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cmetaVal = + cmetasVal _bindMetaIself + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cvi = + emptyCVarIntro { cviLev = _lhsIlev , cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 10, column 17) + _cviExpr = + emptyCVarIntro { cviLev = _exprIlevOf, cviMeta = _cmetaVal } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 53, column 17) + _lhsObindsIntroCVarIntroMp = + Map.singleton _lhsInm _cvi + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 75, column 17) + _lhsOcvarIntroExprMp = + Map.singleton _lhsInm _cviExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 58, column 17) + _exprOgUniq = + _lhsIgUniq + Map.size _argMpNew + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 83, column 17) + _exprOargMp = + _argMpNew `Map.union` _lhsIargMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 96, column 25) + _lhsOgathAspBindLamArgMp = + Map.singleton acbaspkeyDefault + ( _exprIbindLamArgMp + , _exprIenvUp + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 136, column 33) + __tup2 = + if isJust _exprImbLam + then let argLevL = fvLAsArg _lhsIintroCVarIntroMp $ panicJust "LamGlobalAsArg.CBind.Bind.argLevL" $ Map.lookup _lhsInm $ _lhsIlamFvSMp + (argOL,argNL,argONMp) = fvLArgRepl _lhsIgUniq $ argLevL + in (argNL, argONMp, _lhsInm `Map.singleton` argOL) + else ([],Map.empty, Map.empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 136, column 33) + (_argNewL,_,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 136, column 33) + (_,_argMpNew,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 136, column 33) + (_,_,_bindLamArgMp) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 144, column 17) + _lhsOcTrf = + (acoreBoundVal1Metas _lhsInm _bindMetaIcTrf $ acoreLam [(n) | (n,cvi) <- _argNewL] _exprIcTrf) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 148, column 17) + _bindMetaObindLamArgMp = + _exprIbindLamArgMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 196, column 11) + _exprOmbCtxCount = + if _bindMetaIisDictInstance + then Just 0 + else Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 199, column 11) + _exprOisDictClass = + _bindMetaIisDictClass + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 230, column 11) + _bindMetaOenvFinal = + _exprIenvUp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 236, column 12) + _lhsOenvUp = + maybe (Map.empty) + (\t -> Map.singleton _lhsInm t) + _bindMetaImbTrack + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bindMetaIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bindMetaIlevOf `max` _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _bindMetaOargMp = + _lhsIargMp + -- copy rule (down) + _bindMetaOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindMetaOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindMetaOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindMetaOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bindMetaOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bindMetaOlamS = + _lhsIlamS + -- copy rule (down) + _bindMetaOlev = + _lhsIlev + -- copy rule (down) + _bindMetaOvarS = + _lhsIvarS + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIgUniq,_bindMetaIisDictClass,_bindMetaIisDictInstance,_bindMetaIisInstance,_bindMetaIlevOf,_bindMetaImbTrack,_bindMetaIself) = + bindMeta_ _bindMetaOargMp _bindMetaObindLamArgMp _bindMetaOcvarIntroMp _bindMetaOenvFinal _bindMetaOgUniq _bindMetaOintroCVarIntroMp _bindMetaOlamArgMp _bindMetaOlamFvSMp _bindMetaOlamS _bindMetaOlev _bindMetaOvarS + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _cmetasObindLamArgMp :: LamArgMp + _cmetasOenvFinal :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _cmetasOargMp :: CVarReplNmMp + _cmetasOcvarIntroMp :: CVarIntroMp + _cmetasOgUniq :: Int + _cmetasOintroCVarIntroMp :: CVarIntroMp + _cmetasOlamArgMp :: LamArgMp + _cmetasOlamFvSMp :: FvSMp + _cmetasOlamS :: FvS + _cmetasOlev :: Int + _cmetasOvarS :: FvS + _cmetasIcTrf :: CMetas + _cmetasIfvS :: FvS + _cmetasIgUniq :: Int + _cmetasIisDictClass :: Bool + _cmetasIisDictInstance :: Bool + _cmetasIisInstance :: Bool + _cmetasIlevOf :: Int + _cmetasImbTrack :: (Maybe Track) + _cmetasIself :: CMetas + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 114, column 49) + __tup3 = + panicJust "LamGlobalAsArg.CBound.Meta.aspBindLamArgMp" $ Map.lookup acbaspkeyDefault _lhsIaspBindLamArgMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 114, column 49) + (_cmetasObindLamArgMp,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 114, column 49) + (_,_cmetasOenvFinal) = + __tup3 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _cmetasIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _cmetasIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _cmetasIgUniq + -- copy rule (down) + _cmetasOargMp = + _lhsIargMp + -- copy rule (down) + _cmetasOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _cmetasOgUniq = + _lhsIgUniq + -- copy rule (down) + _cmetasOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _cmetasOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _cmetasOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _cmetasOlamS = + _lhsIlamS + -- copy rule (down) + _cmetasOlev = + _lhsIlev + -- copy rule (down) + _cmetasOvarS = + _lhsIvarS + ( _cmetasIcTrf,_cmetasIfvS,_cmetasIgUniq,_cmetasIisDictClass,_cmetasIisDictInstance,_cmetasIisInstance,_cmetasIlevOf,_cmetasImbTrack,_cmetasIself) = + cmetas_ _cmetasOargMp _cmetasObindLamArgMp _cmetasOcvarIntroMp _cmetasOenvFinal _cmetasOgUniq _cmetasOintroCVarIntroMp _cmetasOlamArgMp _cmetasOlamFvSMp _cmetasOlamS _cmetasOlev _cmetasOvarS + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _whatAbove :: WhatExpr + _exprOmbCtxCount :: (Maybe Int) + _exprOisDictClass :: Bool + _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 80, column 17) + _whatAbove = + ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 200, column 11) + _exprOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 201, column 11) + _exprOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + _exprIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisGlobal + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsImbCtxCount + _lhsInm + _lhsIvarS -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOmbCtxCount :: (Maybe Int) + _exprOisDictClass :: Bool + _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBound + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 37, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 81, column 17) + _whatAbove = + ExprIsLam 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 184, column 10) + _exprOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 185, column 10) + _exprOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + _exprIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + aspBindLamArgMp : ACoreBindAspMp AspBindLamArgInfo + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isGlobal : Bool + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + letBindingsCateg : CBindCateg + lev : Int + nm : HsName + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + bindLamArgMp : LamArgMp + bindLamS : FvS + bindVarS : FvS + bindsIntroCVarIntroMp : CVarIntroMp + cTrf : CBoundL + cvarIntroExprMp : CVarIntroMp + envUp : Env + fvS : FvS + fvSMp : FvSMp + gathAspBindLamArgMp : ACoreBindAspMp AspBindLamArgInfo + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = CVarReplNmMp -> + (ACoreBindAspMp AspBindLamArgInfo) -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + Bool -> + LamArgMp -> + FvSMp -> + FvS -> + CBindCateg -> + Int -> + HsName -> + FvS -> + ( LamArgMp,FvS,FvS,CVarIntroMp,CBoundL,CVarIntroMp,Env,FvS,FvSMp,Int,(ACoreBindAspMp AspBindLamArgInfo),Int,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _hdOisTopApp :: Bool + _hdOisTopTup :: Bool + _hdOmbCtxCount :: (Maybe Int) + _hdOisDictClass :: Bool + _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOaspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _hdOcvarIntroMp :: CVarIntroMp + _hdOevalCtx :: EvalCtx + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOisGlobal :: Bool + _hdOlamArgMp :: LamArgMp + _hdOlamFvSMp :: FvSMp + _hdOlamS :: FvS + _hdOletBindingsCateg :: CBindCateg + _hdOlev :: Int + _hdOnm :: HsName + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOaspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _tlOcvarIntroMp :: CVarIntroMp + _tlOevalCtx :: EvalCtx + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOisGlobal :: Bool + _tlOlamArgMp :: LamArgMp + _tlOlamFvSMp :: FvSMp + _tlOlamS :: FvS + _tlOletBindingsCateg :: CBindCateg + _tlOlev :: Int + _tlOnm :: HsName + _tlOvarS :: FvS + _hdIbindLamArgMp :: LamArgMp + _hdIbindLamS :: FvS + _hdIbindVarS :: FvS + _hdIbindsIntroCVarIntroMp :: CVarIntroMp + _hdIcTrf :: CBound + _hdIcvarIntroExprMp :: CVarIntroMp + _hdIenvUp :: Env + _hdIfvS :: FvS + _hdIfvSMp :: FvSMp + _hdIgUniq :: Int + _hdIgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIbindLamArgMp :: LamArgMp + _tlIbindLamS :: FvS + _tlIbindVarS :: FvS + _tlIbindsIntroCVarIntroMp :: CVarIntroMp + _tlIcTrf :: CBoundL + _tlIcvarIntroExprMp :: CVarIntroMp + _tlIenvUp :: Env + _tlIfvS :: FvS + _tlIfvSMp :: FvSMp + _tlIgUniq :: Int + _tlIgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 31, column 25) + _hdOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 180, column 10) + _hdOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 181, column 10) + _hdOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _hdIbindLamArgMp `Map.union` _tlIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + _hdIbindLamS `Set.union` _tlIbindLamS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + _hdIbindVarS `Set.union` _tlIbindVarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + _hdIbindsIntroCVarIntroMp `Map.union` _tlIbindsIntroCVarIntroMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + _hdIcvarIntroExprMp `Map.union` _tlIcvarIntroExprMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + _hdIenvUp `Map.union` _tlIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + _hdIfvSMp `Map.union` _tlIfvSMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + _hdIgathAspBindLamArgMp `Map.union` _tlIgathAspBindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOaspBindLamArgMp = + _lhsIaspBindLamArgMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _hdOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _hdOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOaspBindLamArgMp = + _lhsIaspBindLamArgMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _tlOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOisGlobal = + _lhsIisGlobal + -- copy rule (down) + _tlOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _tlOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOletBindingsCateg = + _lhsIletBindingsCateg + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIbindLamArgMp,_hdIbindLamS,_hdIbindVarS,_hdIbindsIntroCVarIntroMp,_hdIcTrf,_hdIcvarIntroExprMp,_hdIenvUp,_hdIfvS,_hdIfvSMp,_hdIgUniq,_hdIgathAspBindLamArgMp,_hdIlevOf,_hdInmL) = + hd_ _hdOargMp _hdOaspBindLamArgMp _hdOcvarIntroMp _hdOevalCtx _hdOgUniq _hdOintroCVarIntroMp _hdOisDictClass _hdOisGlobal _hdOisTopApp _hdOisTopTup _hdOlamArgMp _hdOlamFvSMp _hdOlamS _hdOletBindingsCateg _hdOlev _hdOmbCtxCount _hdOnm _hdOvarS + ( _tlIbindLamArgMp,_tlIbindLamS,_tlIbindVarS,_tlIbindsIntroCVarIntroMp,_tlIcTrf,_tlIcvarIntroExprMp,_tlIenvUp,_tlIfvS,_tlIfvSMp,_tlIgUniq,_tlIgathAspBindLamArgMp,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOaspBindLamArgMp _tlOcvarIntroMp _tlOevalCtx _tlOgUniq _tlOintroCVarIntroMp _tlOisGlobal _tlOlamArgMp _tlOlamFvSMp _tlOlamS _tlOletBindingsCateg _tlOlev _tlOnm _tlOvarS + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIargMp + _lhsIaspBindLamArgMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisGlobal + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIletBindingsCateg + _lhsIlev + _lhsInm + _lhsIvarS -> + (let _lhsObindLamArgMp :: LamArgMp + _lhsObindLamS :: FvS + _lhsObindVarS :: FvS + _lhsObindsIntroCVarIntroMp :: CVarIntroMp + _lhsOcvarIntroExprMp :: CVarIntroMp + _lhsOenvUp :: Env + _lhsOfvS :: FvS + _lhsOfvSMp :: FvSMp + _lhsOgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CBoundL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindLamS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 3, column 39) + _lhsObindVarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 50, column 42) + _lhsObindsIntroCVarIntroMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 72, column 36) + _lhsOcvarIntroExprMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 233, column 32) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 2, column 26) + _lhsOfvSMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 89, column 95) + _lhsOgathAspBindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsObindLamArgMp,_lhsObindLamS,_lhsObindVarS,_lhsObindsIntroCVarIntroMp,_lhsOcTrf,_lhsOcvarIntroExprMp,_lhsOenvUp,_lhsOfvS,_lhsOfvSMp,_lhsOgUniq,_lhsOgathAspBindLamArgMp,_lhsOlevOf,_lhsOnmL))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + evalCtx : EvalCtx + introCVarIntroMp : CVarIntroMp + isDictClass : Bool + isTopApp : Bool + isTopTup : Bool + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + mbCtxCount : Maybe Int + varS : FvS + whatAbove : WhatExpr + chained attribute: + gUniq : Int + synthesized attributes: + appFunKind : AppFunKind + bindLamArgMp : LamArgMp + cTrf : CExpr + envUp : Env + fvS : FvS + levOf : Int + mbLam : Maybe [HsName] + mbVar : Maybe HsName + whatBelow : WhatExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local mbVar : {Maybe HsName} + local nm : {HsName} + local nmAsp : {HsName} + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local varS : _ + local lamS : _ + local maxBindLev : _ + local _tup4 : _ + local strLev : _ + local introCVarIntroMp : _ + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLet : _ + local evalCtx : _ + local isGlobal : _ + local lamFvSMp : _ + local lamArgMp : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local levOf : _ + local fvS : _ + local letBindingsCateg : _ + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopApp' : _ + local isGlobal : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local varS : _ + local cvi : _ + local levOf : _ + local fvS : _ + local argNm : _ + local letBindingsCateg : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local isTopLam : _ + local lev : _ + local isGlobal : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local levOf : _ + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative CoeArg: + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local isTopApp : {Bool} + local isTopTup : _ + local whatBelow : _ + local whatAbove : {WhatExpr} + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = CVarReplNmMp -> + CVarIntroMp -> + EvalCtx -> + Int -> + CVarIntroMp -> + Bool -> + Bool -> + Bool -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + (Maybe Int) -> + FvS -> + WhatExpr -> + ( AppFunKind,LamArgMp,CExpr,Env,FvS,Int,Int,(Maybe [HsName]),(Maybe HsName),WhatExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _mbVar :: (Maybe HsName) + _lhsOlevOf :: Int + _lhsOfvS :: FvS + _nm :: HsName + _nmAsp :: HsName + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOcTrf :: CExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOgUniq :: Int + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 13, column 17) + _lhsOappFunKind = + AppFunKind_Fun ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 21, column 17) + _mbVar = + Just _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 59, column 17) + _lhsOlevOf = + fvLev _nm _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 7, column 17) + _lhsOfvS = + Set.singleton _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 52, column 17) + _whatBelow = + ExprIsVar _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 152, column 17) + _lhsOcTrf = + let r n = fvVarRepl _lhsIargMp n + v1 = r _nm + mk as = acoreApp v1 $ [(r a) | (a,cvi) <- as] + v2 = maybe v1 mk $ Map.lookup _nm $ _lhsIlamArgMp + in v2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- self rule + _cTrf = + CExpr_Var ref_ + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOmbVar = + _mbVar + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 53, column 17) + _whatBelow = + ExprIsInt int_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 67, column 17) + _levOf = + cLevIntern + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 59, column 25) + _whatBelow = + ExprIsOtherWHNF + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 11, column 17) + _lhsOappFunKind = + AppFunKind_Tag tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 55, column 25) + _whatBelow = + ExprIsTup tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _bindsOlev :: Int + _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _bindsOcvarIntroMp :: CVarIntroMp + _bodyOcvarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _bodyOmbCtxCount :: (Maybe Int) + _bodyOisDictClass :: Bool + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindsOargMp :: CVarReplNmMp + _bindsOevalCtx :: EvalCtx + _bindsOgUniq :: Int + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOisGlobal :: Bool + _bindsOlamArgMp :: LamArgMp + _bindsOlamFvSMp :: FvSMp + _bindsOlamS :: FvS + _bindsOletBindingsCateg :: CBindCateg + _bindsOvarS :: FvS + _bodyOargMp :: CVarReplNmMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamArgMp :: LamArgMp + _bodyOlamFvSMp :: FvSMp + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bindsIbindLamArgMp :: LamArgMp + _bindsIbindLamS :: FvS + _bindsIbindVarS :: FvS + _bindsIbindsIntroCVarIntroMp :: CVarIntroMp + _bindsIcTrf :: CBindL + _bindsIcvarIntroExprMp :: CVarIntroMp + _bindsIenvUp :: Env + _bindsIfvS :: FvS + _bindsIfvSMp :: FvSMp + _bindsIgUniq :: Int + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + _bodyIappFunKind :: AppFunKind + _bodyIbindLamArgMp :: LamArgMp + _bodyIcTrf :: CExpr + _bodyIenvUp :: Env + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLet.ag"(line 2, column 17) + _bindsOlev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 18, column 17) + _varS = + _lhsIvarS `Set.union` _bindsIbindVarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 18, column 17) + _lamS = + _lhsIlamS `Set.union` _bindsIbindLamS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 24, column 17) + _maxBindLev = + fvsLev _lhsIcvarIntroMp cLevModule _bindsIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + __tup4 = + case categ_ of + CBindCateg_Strict -> (const _lhsIlev,_lhsIcvarIntroMp) + CBindCateg_Rec -> ( const _maxBindLev + , Map.map (\cvi -> cvi {cviLev = _maxBindLev}) _bindsIcvarIntroExprMp + `Map.union` _lhsIcvarIntroMp + ) + _ -> (id,_lhsIcvarIntroMp) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_strLev,_) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 25, column 17) + (_,_bindsOcvarIntroMp) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 33, column 17) + _bodyOcvarIntroMp = + Map.map (\cvi -> cvi {cviLev = _strLev $ cviLev cvi}) _bindsIcvarIntroExprMp `Map.union` _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 45, column 17) + _introCVarIntroMp = + Map.map (\cvi -> cvi {cviLev = _lhsIlev}) _bindsIbindsIntroCVarIntroMp `Map.union` _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 66, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _fvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 6, column 17) + _fvS = + (_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 4, column 17) + _letBindingsCateg = + categ_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 75, column 17) + _isTopLet = + _lhsIwhatAbove == ExprIsBind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, column 17) + _evalCtx = + if categ_ == CBindCateg_Strict + then EvalCtx_Eval + else EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 10, column 17) + _isGlobal = + _lhsIlev == cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 67, column 17) + _lamFvSMp = + (let start varS = fvsClosure _bindsIbindLamS _lhsIlamS varS _lhsIlamFvSMp _bindsIfvSMp + in case categ_ of + CBindCateg_Rec + -> fvsTransClosure lm m + where (m,lm) = start (_lhsIvarS `Set.union` _bindsIbindVarS) + _ -> m + where (m,_) = start _lhsIvarS + ) + `Map.union` _lhsIlamFvSMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 124, column 17) + _lamArgMp = + _bindsIbindLamArgMp `Map.union` _lhsIlamArgMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 207, column 11) + _bodyOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 208, column 11) + _bodyOisDictClass = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 241, column 12) + _lhsOenvUp = + Map.union _bindsIenvUp _bodyIenvUp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bindsIbindLamArgMp `Map.union` _bodyIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindsOargMp = + _lhsIargMp + -- copy rule (from local) + _bindsOevalCtx = + _evalCtx + -- copy rule (down) + _bindsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _bindsOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bindsOisGlobal = + _isGlobal + -- copy rule (from local) + _bindsOlamArgMp = + _lamArgMp + -- copy rule (from local) + _bindsOlamFvSMp = + _lamFvSMp + -- copy rule (from local) + _bindsOlamS = + _lamS + -- copy rule (from local) + _bindsOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindsOvarS = + _varS + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (from local) + _bodyOevalCtx = + _evalCtx + -- copy rule (chain) + _bodyOgUniq = + _bindsIgUniq + -- copy rule (from local) + _bodyOintroCVarIntroMp = + _introCVarIntroMp + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (from local) + _bodyOlamArgMp = + _lamArgMp + -- copy rule (from local) + _bodyOlamFvSMp = + _lamFvSMp + -- copy rule (from local) + _bodyOlamS = + _lamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (from local) + _bodyOvarS = + _varS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindsIbindLamArgMp,_bindsIbindLamS,_bindsIbindVarS,_bindsIbindsIntroCVarIntroMp,_bindsIcTrf,_bindsIcvarIntroExprMp,_bindsIenvUp,_bindsIfvS,_bindsIfvSMp,_bindsIgUniq,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOargMp _bindsOcvarIntroMp _bindsOevalCtx _bindsOgUniq _bindsOintroCVarIntroMp _bindsOisGlobal _bindsOlamArgMp _bindsOlamFvSMp _bindsOlamS _bindsOletBindingsCateg _bindsOlev _bindsOvarS + ( _bodyIappFunKind,_bodyIbindLamArgMp,_bodyIcTrf,_bodyIenvUp,_bodyIfvS,_bodyIgUniq,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisDictClass _bodyOisTopApp _bodyOisTopTup _bodyOlamArgMp _bodyOlamFvSMp _bodyOlamS _bodyOlev _bodyOmbCtxCount _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _argOnm :: HsName + _funcOisTopApp :: Bool + _argOisTopApp :: Bool + _whatAbove :: WhatExpr + _argOevalCtx :: EvalCtx + _argOaspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOargMp :: CVarReplNmMp + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOgUniq :: Int + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisDictClass :: Bool + _funcOisTopTup :: Bool + _funcOlamArgMp :: LamArgMp + _funcOlamFvSMp :: FvSMp + _funcOlamS :: FvS + _funcOlev :: Int + _funcOmbCtxCount :: (Maybe Int) + _funcOvarS :: FvS + _funcOwhatAbove :: WhatExpr + _argOargMp :: CVarReplNmMp + _argOcvarIntroMp :: CVarIntroMp + _argOgUniq :: Int + _argOintroCVarIntroMp :: CVarIntroMp + _argOisDictClass :: Bool + _argOisGlobal :: Bool + _argOisTopTup :: Bool + _argOlamArgMp :: LamArgMp + _argOlamFvSMp :: FvSMp + _argOlamS :: FvS + _argOletBindingsCateg :: CBindCateg + _argOlev :: Int + _argOmbCtxCount :: (Maybe Int) + _argOvarS :: FvS + _funcIappFunKind :: AppFunKind + _funcIbindLamArgMp :: LamArgMp + _funcIcTrf :: CExpr + _funcIenvUp :: Env + _funcIfvS :: FvS + _funcIgUniq :: Int + _funcIlevOf :: Int + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIwhatBelow :: WhatExpr + _argIbindLamArgMp :: LamArgMp + _argIbindLamS :: FvS + _argIbindVarS :: FvS + _argIbindsIntroCVarIntroMp :: CVarIntroMp + _argIcTrf :: CBound + _argIcvarIntroExprMp :: CVarIntroMp + _argIenvUp :: Env + _argIfvS :: FvS + _argIfvSMp :: FvSMp + _argIgUniq :: Int + _argIgathAspBindLamArgMp :: (ACoreBindAspMp AspBindLamArgInfo) + _argIlevOf :: Int + _argInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 14, column 17) + _lhsOappFunKind = + _funcIappFunKind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 60, column 17) + _levOf = + _funcIlevOf `max` _argIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 8, column 17) + _fvS = + _funcIfvS `Set.union` _argIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 14, column 17) + _funcOisTopApp = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 15, column 17) + _argOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 54, column 17) + _whatBelow = + maybe (ExprIsApp 1 _funcIwhatBelow) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _funcIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 70, column 17) + _whatAbove = + maybe (ExprIsApp 1 ExprIsOther) (\(a,w) -> ExprIsApp (a + 1) w) $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 77, column 17) + _isTopApp' = + isNothing $ whatExprMbApp _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 112, column 17) + _argOevalCtx = + EvalCtx_Thunk + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 103, column 25) + _argOaspBindLamArgMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _funcIbindLamArgMp `Map.union` _argIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _argIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOargMp = + _lhsIargMp + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _funcOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _funcOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _funcOlamS = + _lhsIlamS + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _funcOvarS = + _lhsIvarS + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + -- copy rule (down) + _argOargMp = + _lhsIargMp + -- copy rule (down) + _argOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _argOgUniq = + _funcIgUniq + -- copy rule (down) + _argOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _argOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _argOisGlobal = + _isGlobal + -- copy rule (from local) + _argOisTopTup = + _isTopTup + -- copy rule (down) + _argOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _argOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _argOlamS = + _lhsIlamS + -- copy rule (from local) + _argOletBindingsCateg = + _letBindingsCateg + -- copy rule (down) + _argOlev = + _lhsIlev + -- copy rule (down) + _argOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _argOvarS = + _lhsIvarS + ( _funcIappFunKind,_funcIbindLamArgMp,_funcIcTrf,_funcIenvUp,_funcIfvS,_funcIgUniq,_funcIlevOf,_funcImbLam,_funcImbVar,_funcIwhatBelow) = + func_ _funcOargMp _funcOcvarIntroMp _funcOevalCtx _funcOgUniq _funcOintroCVarIntroMp _funcOisDictClass _funcOisTopApp _funcOisTopTup _funcOlamArgMp _funcOlamFvSMp _funcOlamS _funcOlev _funcOmbCtxCount _funcOvarS _funcOwhatAbove + ( _argIbindLamArgMp,_argIbindLamS,_argIbindVarS,_argIbindsIntroCVarIntroMp,_argIcTrf,_argIcvarIntroExprMp,_argIenvUp,_argIfvS,_argIfvSMp,_argIgUniq,_argIgathAspBindLamArgMp,_argIlevOf,_argInmL) = + arg_ _argOargMp _argOaspBindLamArgMp _argOcvarIntroMp _argOevalCtx _argOgUniq _argOintroCVarIntroMp _argOisDictClass _argOisGlobal _argOisTopApp _argOisTopTup _argOlamArgMp _argOlamFvSMp _argOlamS _argOletBindingsCateg _argOlev _argOmbCtxCount _argOnm _argOvarS + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOintroCVarIntroMp :: CVarIntroMp + _isTopApp :: Bool + _whatAbove :: WhatExpr + _bodyOmbCtxCount :: (Maybe Int) + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bindOargMp :: CVarReplNmMp + _bindOcvarIntroMp :: CVarIntroMp + _bindOevalCtx :: EvalCtx + _bindOgUniq :: Int + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOisGlobal :: Bool + _bindOlamArgMp :: LamArgMp + _bindOlamFvSMp :: FvSMp + _bindOlamS :: FvS + _bindOletBindingsCateg :: CBindCateg + _bindOlev :: Int + _bindOvarS :: FvS + _bodyOargMp :: CVarReplNmMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: Int + _bodyOisDictClass :: Bool + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamArgMp :: LamArgMp + _bodyOlamFvSMp :: FvSMp + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bindIbindLamArgMp :: LamArgMp + _bindIbindLamS :: FvS + _bindIbindVarS :: FvS + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIenvUp :: Env + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: Int + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _bodyIappFunKind :: AppFunKind + _bodyIbindLamArgMp :: LamArgMp + _bodyIcTrf :: CExpr + _bodyIenvUp :: Env + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 4, column 17) + _lhsOmbLam = + Just $ maybe [_argNm] (_argNm:) _bodyImbLam + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 20, column 17) + _varS = + _argNm `Set.insert` _lhsIvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 4, column 17) + _cvi = + CVarIntro + { cviLev = _lev + , cviMeta = CMetaVal_Val + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 23, column 17) + _bodyOcvarIntroMp = + Map.insert _argNm _cvi _lhsIcvarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 44, column 17) + _bodyOintroCVarIntroMp = + Map.insert _argNm _cvi _lhsIintroCVarIntroMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 65, column 17) + _levOf = + fvsLev _lhsIcvarIntroMp cLevModule _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 5, column 17) + _fvS = + _argNm `Set.delete` _bodyIfvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 6, column 33) + _letBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 51, column 17) + _whatBelow = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _bodyIwhatBelow + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) + _whatAbove = + maybe (ExprIsLam 1) (\a -> ExprIsLam $ a + 1) $ whatExprMbLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 76, column 17) + _isTopLam = + not $ whatExprIsLam _lhsIwhatAbove + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLevLamPer1Lam.ag"(line 2, column 17) + _lev = + _lhsIlev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 12, column 33) + _isGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 204, column 11) + _bodyOmbCtxCount = + do { n <- _lhsImbCtxCount + ; return (n+1) + } + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 242, column 12) + _lhsOenvUp = + maybe (if _lhsIisDictClass + then Map.insert _argNm TrackSelf _bodyIenvUp + else _bodyIenvUp + ) + (\n -> Map.insert _argNm (TrackCtx n) _bodyIenvUp) + _lhsImbCtxCount + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bindIbindLamArgMp `Map.union` _bodyIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _fvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bindOargMp = + _lhsIargMp + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bindOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bindOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (from local) + _bindOisGlobal = + _isGlobal + -- copy rule (down) + _bindOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bindOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bindOlamS = + _lhsIlamS + -- copy rule (from local) + _bindOletBindingsCateg = + _letBindingsCateg + -- copy rule (from local) + _bindOlev = + _lev + -- copy rule (from local) + _bindOvarS = + _varS + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _bodyOgUniq = + _bindIgUniq + -- copy rule (down) + _bodyOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bodyOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (from local) + _bodyOlev = + _lev + -- copy rule (from local) + _bodyOvarS = + _varS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bindIbindLamArgMp,_bindIbindLamS,_bindIbindVarS,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIenvUp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOargMp _bindOcvarIntroMp _bindOevalCtx _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOlamArgMp _bindOlamFvSMp _bindOlamS _bindOletBindingsCateg _bindOlev _bindOvarS + ( _bodyIappFunKind,_bodyIbindLamArgMp,_bodyIcTrf,_bodyIenvUp,_bodyIfvS,_bodyIgUniq,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisDictClass _bodyOisTopApp _bodyOisTopTup _bodyOlamArgMp _bodyOlamFvSMp _bodyOlamS _bodyOlev _bodyOmbCtxCount _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisDictClass :: Bool + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOmbCtxCount :: (Maybe Int) + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _altsOargMp :: CVarReplNmMp + _altsOcvarIntroMp :: CVarIntroMp + _altsOevalCtx :: EvalCtx + _altsOgUniq :: Int + _altsOintroCVarIntroMp :: CVarIntroMp + _altsOlamArgMp :: LamArgMp + _altsOlamFvSMp :: FvSMp + _altsOlamS :: FvS + _altsOlev :: Int + _altsOvarS :: FvS + _dfltOargMp :: CVarReplNmMp + _dfltOcvarIntroMp :: CVarIntroMp + _dfltOevalCtx :: EvalCtx + _dfltOgUniq :: Int + _dfltOintroCVarIntroMp :: CVarIntroMp + _dfltOisDictClass :: Bool + _dfltOisTopApp :: Bool + _dfltOisTopTup :: Bool + _dfltOlamArgMp :: LamArgMp + _dfltOlamFvSMp :: FvSMp + _dfltOlamS :: FvS + _dfltOlev :: Int + _dfltOmbCtxCount :: (Maybe Int) + _dfltOvarS :: FvS + _dfltOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _altsIcTrf :: CAltL + _altsIfvS :: FvS + _altsIgUniq :: Int + _altsIlevOf :: Int + _dfltIappFunKind :: AppFunKind + _dfltIbindLamArgMp :: LamArgMp + _dfltIcTrf :: CExpr + _dfltIenvUp :: Env + _dfltIfvS :: FvS + _dfltIgUniq :: Int + _dfltIlevOf :: Int + _dfltImbLam :: (Maybe [HsName]) + _dfltImbVar :: (Maybe HsName) + _dfltIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 61, column 17) + _levOf = + _exprIlevOf `max` _altsIlevOf `max` _dfltIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp `Map.union` _dfltIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _dfltIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (from local) + _exprOisTopTup = + _isTopTup + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _altsOargMp = + _lhsIargMp + -- copy rule (down) + _altsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _altsOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _altsOgUniq = + _exprIgUniq + -- copy rule (down) + _altsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _altsOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _altsOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _altsOlamS = + _lhsIlamS + -- copy rule (down) + _altsOlev = + _lhsIlev + -- copy rule (down) + _altsOvarS = + _lhsIvarS + -- copy rule (down) + _dfltOargMp = + _lhsIargMp + -- copy rule (down) + _dfltOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _dfltOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _dfltOgUniq = + _altsIgUniq + -- copy rule (down) + _dfltOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _dfltOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _dfltOisTopApp = + _isTopApp + -- copy rule (from local) + _dfltOisTopTup = + _isTopTup + -- copy rule (down) + _dfltOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _dfltOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _dfltOlamS = + _lhsIlamS + -- copy rule (down) + _dfltOlev = + _lhsIlev + -- copy rule (down) + _dfltOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _dfltOvarS = + _lhsIvarS + -- copy rule (from local) + _dfltOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + ( _altsIcTrf,_altsIfvS,_altsIgUniq,_altsIlevOf) = + alts_ _altsOargMp _altsOcvarIntroMp _altsOevalCtx _altsOgUniq _altsOintroCVarIntroMp _altsOlamArgMp _altsOlamFvSMp _altsOlamS _altsOlev _altsOvarS + ( _dfltIappFunKind,_dfltIbindLamArgMp,_dfltIcTrf,_dfltIenvUp,_dfltIfvS,_dfltIgUniq,_dfltIlevOf,_dfltImbLam,_dfltImbVar,_dfltIwhatBelow) = + dflt_ _dfltOargMp _dfltOcvarIntroMp _dfltOevalCtx _dfltOgUniq _dfltOintroCVarIntroMp _dfltOisDictClass _dfltOisTopApp _dfltOisTopTup _dfltOlamArgMp _dfltOlamFvSMp _dfltOlamS _dfltOlev _dfltOmbCtxCount _dfltOvarS _dfltOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOgUniq :: Int + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + _errorExprOargMp :: CVarReplNmMp + _errorExprOcvarIntroMp :: CVarIntroMp + _errorExprOevalCtx :: EvalCtx + _errorExprOgUniq :: Int + _errorExprOintroCVarIntroMp :: CVarIntroMp + _errorExprOisDictClass :: Bool + _errorExprOisTopApp :: Bool + _errorExprOisTopTup :: Bool + _errorExprOlamArgMp :: LamArgMp + _errorExprOlamFvSMp :: FvSMp + _errorExprOlamS :: FvS + _errorExprOlev :: Int + _errorExprOmbCtxCount :: (Maybe Int) + _errorExprOvarS :: FvS + _errorExprOwhatAbove :: WhatExpr + _errorExprIappFunKind :: AppFunKind + _errorExprIbindLamArgMp :: LamArgMp + _errorExprIcTrf :: CExpr + _errorExprIenvUp :: Env + _errorExprIfvS :: FvS + _errorExprIgUniq :: Int + _errorExprIlevOf :: Int + _errorExprImbLam :: (Maybe [HsName]) + _errorExprImbVar :: (Maybe HsName) + _errorExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _errorExprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _errorExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _errorExprIlevOf + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappFunKind = + _errorExprIappFunKind + -- copy rule (up) + _lhsOgUniq = + _errorExprIgUniq + -- copy rule (up) + _lhsOmbLam = + _errorExprImbLam + -- copy rule (up) + _lhsOmbVar = + _errorExprImbVar + -- copy rule (up) + _lhsOwhatBelow = + _errorExprIwhatBelow + -- copy rule (down) + _errorExprOargMp = + _lhsIargMp + -- copy rule (down) + _errorExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _errorExprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _errorExprOgUniq = + _lhsIgUniq + -- copy rule (down) + _errorExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _errorExprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _errorExprOisTopApp = + _isTopApp + -- copy rule (from local) + _errorExprOisTopTup = + _isTopTup + -- copy rule (down) + _errorExprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _errorExprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _errorExprOlamS = + _lhsIlamS + -- copy rule (down) + _errorExprOlev = + _lhsIlev + -- copy rule (down) + _errorExprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _errorExprOvarS = + _lhsIvarS + -- copy rule (from local) + _errorExprOwhatAbove = + _whatAbove + ( _errorExprIappFunKind,_errorExprIbindLamArgMp,_errorExprIcTrf,_errorExprIenvUp,_errorExprIfvS,_errorExprIgUniq,_errorExprIlevOf,_errorExprImbLam,_errorExprImbVar,_errorExprIwhatBelow) = + errorExpr_ _errorExprOargMp _errorExprOcvarIntroMp _errorExprOevalCtx _errorExprOgUniq _errorExprOintroCVarIntroMp _errorExprOisDictClass _errorExprOisTopApp _errorExprOisTopTup _errorExprOlamArgMp _errorExprOlamFvSMp _errorExprOlamS _errorExprOlev _errorExprOmbCtxCount _errorExprOvarS _errorExprOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisDictClass :: Bool + _exprOisTopApp :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOmbCtxCount :: (Maybe Int) + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisDictClass :: Bool + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamArgMp :: LamArgMp + _offsetOlamFvSMp :: FvSMp + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOmbCtxCount :: (Maybe Int) + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIbindLamArgMp :: LamArgMp + _offsetIcTrf :: CExpr + _offsetIenvUp :: Env + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 62, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp `Map.union` _offsetIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _offsetIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _offsetOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIbindLamArgMp,_offsetIcTrf,_offsetIenvUp,_offsetIfvS,_offsetIgUniq,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisDictClass _offsetOisTopApp _offsetOisTopTup _offsetOlamArgMp _offsetOlamFvSMp _offsetOlamS _offsetOlev _offsetOmbCtxCount _offsetOvarS _offsetOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisDictClass :: Bool + _exprOisTopApp :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOmbCtxCount :: (Maybe Int) + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisDictClass :: Bool + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamArgMp :: LamArgMp + _offsetOlamFvSMp :: FvSMp + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOmbCtxCount :: (Maybe Int) + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _fldExprOargMp :: CVarReplNmMp + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOgUniq :: Int + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisDictClass :: Bool + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamArgMp :: LamArgMp + _fldExprOlamFvSMp :: FvSMp + _fldExprOlamS :: FvS + _fldExprOlev :: Int + _fldExprOmbCtxCount :: (Maybe Int) + _fldExprOvarS :: FvS + _fldExprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIbindLamArgMp :: LamArgMp + _offsetIcTrf :: CExpr + _offsetIenvUp :: Env + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIbindLamArgMp :: LamArgMp + _fldExprIcTrf :: CExpr + _fldExprIenvUp :: Env + _fldExprIfvS :: FvS + _fldExprIgUniq :: Int + _fldExprIlevOf :: Int + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp `Map.union` _offsetIbindLamArgMp `Map.union` _fldExprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _offsetOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOargMp = + _lhsIargMp + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldExprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _fldExprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _fldExprOlamS = + _lhsIlamS + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _fldExprOvarS = + _lhsIvarS + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIbindLamArgMp,_offsetIcTrf,_offsetIenvUp,_offsetIfvS,_offsetIgUniq,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisDictClass _offsetOisTopApp _offsetOisTopTup _offsetOlamArgMp _offsetOlamFvSMp _offsetOlamS _offsetOlev _offsetOmbCtxCount _offsetOvarS _offsetOwhatAbove + ( _fldExprIappFunKind,_fldExprIbindLamArgMp,_fldExprIcTrf,_fldExprIenvUp,_fldExprIfvS,_fldExprIgUniq,_fldExprIlevOf,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) = + fldExpr_ _fldExprOargMp _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisDictClass _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamArgMp _fldExprOlamFvSMp _fldExprOlamS _fldExprOlev _fldExprOmbCtxCount _fldExprOvarS _fldExprOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisDictClass :: Bool + _exprOisTopApp :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOmbCtxCount :: (Maybe Int) + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOevalCtx :: EvalCtx + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOisDictClass :: Bool + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _offsetOlamArgMp :: LamArgMp + _offsetOlamFvSMp :: FvSMp + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOmbCtxCount :: (Maybe Int) + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _fldExprOargMp :: CVarReplNmMp + _fldExprOcvarIntroMp :: CVarIntroMp + _fldExprOevalCtx :: EvalCtx + _fldExprOgUniq :: Int + _fldExprOintroCVarIntroMp :: CVarIntroMp + _fldExprOisDictClass :: Bool + _fldExprOisTopApp :: Bool + _fldExprOisTopTup :: Bool + _fldExprOlamArgMp :: LamArgMp + _fldExprOlamFvSMp :: FvSMp + _fldExprOlamS :: FvS + _fldExprOlev :: Int + _fldExprOmbCtxCount :: (Maybe Int) + _fldExprOvarS :: FvS + _fldExprOwhatAbove :: WhatExpr + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + _offsetIappFunKind :: AppFunKind + _offsetIbindLamArgMp :: LamArgMp + _offsetIcTrf :: CExpr + _offsetIenvUp :: Env + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _fldExprIappFunKind :: AppFunKind + _fldExprIbindLamArgMp :: LamArgMp + _fldExprIcTrf :: CExpr + _fldExprIenvUp :: Env + _fldExprIfvS :: FvS + _fldExprIgUniq :: Int + _fldExprIlevOf :: Int + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + _fldExprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 64, column 17) + _levOf = + _exprIlevOf `max` _offsetIlevOf `max` _fldExprIlevOf + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 18, column 17) + _exprOisTopTup = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 19, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp `Map.union` _offsetIbindLamArgMp `Map.union` _fldExprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _levOf + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldExprIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _exprOisTopApp = + _isTopApp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _offsetOgUniq = + _exprIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _offsetOisTopApp = + _isTopApp + -- copy rule (from local) + _offsetOisTopTup = + _isTopTup + -- copy rule (down) + _offsetOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _offsetOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _fldExprOargMp = + _lhsIargMp + -- copy rule (down) + _fldExprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _fldExprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _fldExprOgUniq = + _offsetIgUniq + -- copy rule (down) + _fldExprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldExprOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _fldExprOisTopApp = + _isTopApp + -- copy rule (from local) + _fldExprOisTopTup = + _isTopTup + -- copy rule (down) + _fldExprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _fldExprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _fldExprOlamS = + _lhsIlamS + -- copy rule (down) + _fldExprOlev = + _lhsIlev + -- copy rule (down) + _fldExprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _fldExprOvarS = + _lhsIvarS + -- copy rule (from local) + _fldExprOwhatAbove = + _whatAbove + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + ( _offsetIappFunKind,_offsetIbindLamArgMp,_offsetIcTrf,_offsetIenvUp,_offsetIfvS,_offsetIgUniq,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisDictClass _offsetOisTopApp _offsetOisTopTup _offsetOlamArgMp _offsetOlamFvSMp _offsetOlamS _offsetOlev _offsetOmbCtxCount _offsetOvarS _offsetOwhatAbove + ( _fldExprIappFunKind,_fldExprIbindLamArgMp,_fldExprIcTrf,_fldExprIenvUp,_fldExprIfvS,_fldExprIgUniq,_fldExprIlevOf,_fldExprImbLam,_fldExprImbVar,_fldExprIwhatBelow) = + fldExpr_ _fldExprOargMp _fldExprOcvarIntroMp _fldExprOevalCtx _fldExprOgUniq _fldExprOintroCVarIntroMp _fldExprOisDictClass _fldExprOisTopApp _fldExprOisTopTup _fldExprOlamArgMp _fldExprOlamFvSMp _fldExprOlamS _fldExprOlev _fldExprOmbCtxCount _fldExprOvarS _fldExprOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 12, column 17) + _lhsOappFunKind = + AppFunKind_FFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 56, column 25) + _whatBelow = + ExprIsFFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOargMp :: CVarReplNmMp + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisDictClass :: Bool + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamArgMp :: LamArgMp + _bodyOlamFvSMp :: FvSMp + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOmbCtxCount :: (Maybe Int) + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bodyIappFunKind :: AppFunKind + _bodyIbindLamArgMp :: LamArgMp + _bodyIcTrf :: CExpr + _bodyIenvUp :: Env + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bodyIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bodyOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bodyOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _bodyOvarS = + _lhsIvarS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIappFunKind,_bodyIbindLamArgMp,_bodyIcTrf,_bodyIenvUp,_bodyIfvS,_bodyIgUniq,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisDictClass _bodyOisTopApp _bodyOisTopTup _bodyOlamArgMp _bodyOlamFvSMp _bodyOlamS _bodyOlev _bodyOmbCtxCount _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _funcOargMp :: CVarReplNmMp + _funcOcvarIntroMp :: CVarIntroMp + _funcOevalCtx :: EvalCtx + _funcOgUniq :: Int + _funcOintroCVarIntroMp :: CVarIntroMp + _funcOisDictClass :: Bool + _funcOisTopApp :: Bool + _funcOisTopTup :: Bool + _funcOlamArgMp :: LamArgMp + _funcOlamFvSMp :: FvSMp + _funcOlamS :: FvS + _funcOlev :: Int + _funcOmbCtxCount :: (Maybe Int) + _funcOvarS :: FvS + _funcOwhatAbove :: WhatExpr + _funcIappFunKind :: AppFunKind + _funcIbindLamArgMp :: LamArgMp + _funcIcTrf :: CExpr + _funcIenvUp :: Env + _funcIfvS :: FvS + _funcIgUniq :: Int + _funcIlevOf :: Int + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _funcIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _funcIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _funcIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _funcIlevOf + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _funcIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _funcOargMp = + _lhsIargMp + -- copy rule (down) + _funcOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _funcOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _funcOgUniq = + _lhsIgUniq + -- copy rule (down) + _funcOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _funcOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _funcOisTopApp = + _isTopApp + -- copy rule (from local) + _funcOisTopTup = + _isTopTup + -- copy rule (down) + _funcOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _funcOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _funcOlamS = + _lhsIlamS + -- copy rule (down) + _funcOlev = + _lhsIlev + -- copy rule (down) + _funcOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _funcOvarS = + _lhsIvarS + -- copy rule (from local) + _funcOwhatAbove = + _whatAbove + ( _funcIappFunKind,_funcIbindLamArgMp,_funcIcTrf,_funcIenvUp,_funcIfvS,_funcIgUniq,_funcIlevOf,_funcImbLam,_funcImbVar,_funcIwhatBelow) = + func_ _funcOargMp _funcOcvarIntroMp _funcOevalCtx _funcOgUniq _funcOintroCVarIntroMp _funcOisDictClass _funcOisTopApp _funcOisTopTup _funcOlamArgMp _funcOlamFvSMp _funcOlamS _funcOlev _funcOmbCtxCount _funcOvarS _funcOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _isTopApp :: Bool + _whatAbove :: WhatExpr + _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOgUniq :: Int + _lhsOwhatBelow :: WhatExpr + _bodyOargMp :: CVarReplNmMp + _bodyOcvarIntroMp :: CVarIntroMp + _bodyOevalCtx :: EvalCtx + _bodyOgUniq :: Int + _bodyOintroCVarIntroMp :: CVarIntroMp + _bodyOisDictClass :: Bool + _bodyOisTopApp :: Bool + _bodyOisTopTup :: Bool + _bodyOlamArgMp :: LamArgMp + _bodyOlamFvSMp :: FvSMp + _bodyOlamS :: FvS + _bodyOlev :: Int + _bodyOmbCtxCount :: (Maybe Int) + _bodyOvarS :: FvS + _bodyOwhatAbove :: WhatExpr + _bodyIappFunKind :: AppFunKind + _bodyIbindLamArgMp :: LamArgMp + _bodyIcTrf :: CExpr + _bodyIenvUp :: Env + _bodyIfvS :: FvS + _bodyIgUniq :: Int + _bodyIlevOf :: Int + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + _bodyIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 16, column 17) + _isTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 21, column 17) + _isTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 64, column 17) + _whatBelow = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 72, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _bodyIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _bodyIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _bodyIlevOf + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOwhatBelow = + _whatBelow + -- copy rule (down) + _bodyOargMp = + _lhsIargMp + -- copy rule (down) + _bodyOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _bodyOevalCtx = + _lhsIevalCtx + -- copy rule (down) + _bodyOgUniq = + _lhsIgUniq + -- copy rule (down) + _bodyOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bodyOisDictClass = + _lhsIisDictClass + -- copy rule (from local) + _bodyOisTopApp = + _isTopApp + -- copy rule (from local) + _bodyOisTopTup = + _isTopTup + -- copy rule (down) + _bodyOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bodyOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bodyOlamS = + _lhsIlamS + -- copy rule (down) + _bodyOlev = + _lhsIlev + -- copy rule (down) + _bodyOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _bodyOvarS = + _lhsIvarS + -- copy rule (from local) + _bodyOwhatAbove = + _whatAbove + ( _bodyIappFunKind,_bodyIbindLamArgMp,_bodyIcTrf,_bodyIenvUp,_bodyIfvS,_bodyIgUniq,_bodyIlevOf,_bodyImbLam,_bodyImbVar,_bodyIwhatBelow) = + body_ _bodyOargMp _bodyOcvarIntroMp _bodyOevalCtx _bodyOgUniq _bodyOintroCVarIntroMp _bodyOisDictClass _bodyOisTopApp _bodyOisTopTup _bodyOlamArgMp _bodyOlamFvSMp _bodyOlamS _bodyOlev _bodyOmbCtxCount _bodyOvarS _bodyOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIevalCtx + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIisDictClass + _lhsIisTopApp + _lhsIisTopTup + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsImbCtxCount + _lhsIvarS + _lhsIwhatAbove -> + (let _lhsOenvUp :: Env + _lhsObindLamArgMp :: LamArgMp + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOgUniq :: Int + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _lhsOwhatBelow :: WhatExpr + _annOargMp :: CVarReplNmMp + _annOcvarIntroMp :: CVarIntroMp + _annOgUniq :: Int + _annOintroCVarIntroMp :: CVarIntroMp + _annOlamArgMp :: LamArgMp + _annOlamFvSMp :: FvSMp + _annOlamS :: FvS + _annOlev :: Int + _annOvarS :: FvS + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOevalCtx :: EvalCtx + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOisDictClass :: Bool + _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOmbCtxCount :: (Maybe Int) + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _annIcTrf :: CExprAnn + _annIfvS :: FvS + _annIgUniq :: Int + _annIlevOf :: Int + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 249, column 12) + _lhsOenvUp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 110, column 39) + _lhsObindLamArgMp = + _exprIbindLamArgMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _annIfvS `Set.union` _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _annIlevOf `max` _exprIlevOf + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappFunKind = + _exprIappFunKind + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (up) + _lhsOmbLam = + _exprImbLam + -- copy rule (up) + _lhsOmbVar = + _exprImbVar + -- copy rule (up) + _lhsOwhatBelow = + _exprIwhatBelow + -- copy rule (down) + _annOargMp = + _lhsIargMp + -- copy rule (down) + _annOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _annOgUniq = + _lhsIgUniq + -- copy rule (down) + _annOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _annOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _annOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _annOlamS = + _lhsIlamS + -- copy rule (down) + _annOlev = + _lhsIlev + -- copy rule (down) + _annOvarS = + _lhsIvarS + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOevalCtx = + _lhsIevalCtx + -- copy rule (chain) + _exprOgUniq = + _annIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOisDictClass = + _lhsIisDictClass + -- copy rule (down) + _exprOisTopApp = + _lhsIisTopApp + -- copy rule (down) + _exprOisTopTup = + _lhsIisTopTup + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOmbCtxCount = + _lhsImbCtxCount + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (down) + _exprOwhatAbove = + _lhsIwhatAbove + ( _annIcTrf,_annIfvS,_annIgUniq,_annIlevOf) = + ann_ _annOargMp _annOcvarIntroMp _annOgUniq _annOintroCVarIntroMp _annOlamArgMp _annOlamFvSMp _annOlamS _annOlev _annOvarS + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsOappFunKind,_lhsObindLamArgMp,_lhsOcTrf,_lhsOenvUp,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOmbLam,_lhsOmbVar,_lhsOwhatBelow))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + levOf : Int + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CExprAnn,FvS,Int,Int) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CExprAnn + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + levOf : Int + self : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + local self : _ + alternative Function0: + visit 0: + local cTrf : _ + local self : _ + alternative Function1: + visit 0: + local cTrf : _ + local self : _ + alternative Apply0: + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CMetaBind,FvS,Int,Int,CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _self = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _self = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _self = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaBind + _lhsOself :: CMetaBind + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _self = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOself))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + bindLamArgMp : LamArgMp + cvarIntroMp : CVarIntroMp + envFinal : Env + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + isDictClass : Bool + isDictInstance : Bool + isInstance : Bool + levOf : Int + mbTrack : Maybe Track + self : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + local self : _ + alternative Dict: + visit 0: + local cTrf : _ + local self : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + local self : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = CVarReplNmMp -> + LamArgMp -> + CVarIntroMp -> + Env -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CMetaVal,FvS,Int,Bool,Bool,Bool,Int,(Maybe Track),CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOisInstance :: Bool + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 130, column 21) + _lhsOisInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 215, column 20) + _lhsOisDictClass = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 217, column 20) + _lhsOisDictInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 227, column 20) + _lhsOmbTrack = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _self = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOisInstance :: Bool + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 130, column 21) + _lhsOisInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 215, column 20) + _lhsOisDictClass = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 217, column 20) + _lhsOisDictInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 227, column 20) + _lhsOmbTrack = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _self = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOisInstance :: Bool + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _lhsOcTrf :: CMetaVal + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 130, column 21) + _lhsOisInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 214, column 20) + _lhsOisDictClass = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 217, column 20) + _lhsOisDictInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 227, column 20) + _lhsOmbTrack = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 253, column 22) + _lhsOcTrf = + CMetaVal_DictClass (map (metaExtendTrack _lhsIbindLamArgMp _lhsIenvFinal) tracks_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _self = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOisInstance :: Bool + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _lhsOcTrf :: CMetaVal + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 129, column 21) + _lhsOisInstance = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 215, column 20) + _lhsOisDictClass = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 216, column 20) + _lhsOisDictInstance = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 227, column 20) + _lhsOmbTrack = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 254, column 22) + _lhsOcTrf = + CMetaVal_DictInstance (map (metaExtendTrack _lhsIbindLamArgMp _lhsIenvFinal) tracks_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _self = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOisInstance :: Bool + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetaVal + _lhsOself :: CMetaVal + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 130, column 21) + _lhsOisInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 215, column 20) + _lhsOisDictClass = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 217, column 20) + _lhsOisDictInstance = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 226, column 20) + _lhsOmbTrack = + Just track_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _self = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + bindLamArgMp : LamArgMp + cvarIntroMp : CVarIntroMp + envFinal : Env + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CMetas + fvS : FvS + isDictClass : Bool + isDictInstance : Bool + isInstance : Bool + levOf : Int + mbTrack : Maybe Track + self : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ + local self : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = CVarReplNmMp -> + LamArgMp -> + CVarIntroMp -> + Env -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CMetas,FvS,Int,Bool,Bool,Bool,Int,(Maybe Track),CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIargMp + _lhsIbindLamArgMp + _lhsIcvarIntroMp + _lhsIenvFinal + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CMetas + _lhsOself :: CMetas + _lhsOgUniq :: Int + _lhsOisDictClass :: Bool + _lhsOisDictInstance :: Bool + _lhsOisInstance :: Bool + _lhsOmbTrack :: (Maybe Track) + _x1OargMp :: CVarReplNmMp + _x1OcvarIntroMp :: CVarIntroMp + _x1OgUniq :: Int + _x1OintroCVarIntroMp :: CVarIntroMp + _x1OlamArgMp :: LamArgMp + _x1OlamFvSMp :: FvSMp + _x1OlamS :: FvS + _x1Olev :: Int + _x1OvarS :: FvS + _x2OargMp :: CVarReplNmMp + _x2ObindLamArgMp :: LamArgMp + _x2OcvarIntroMp :: CVarIntroMp + _x2OenvFinal :: Env + _x2OgUniq :: Int + _x2OintroCVarIntroMp :: CVarIntroMp + _x2OlamArgMp :: LamArgMp + _x2OlamFvSMp :: FvSMp + _x2OlamS :: FvS + _x2Olev :: Int + _x2OvarS :: FvS + _x1IcTrf :: CMetaBind + _x1IfvS :: FvS + _x1IgUniq :: Int + _x1IlevOf :: Int + _x1Iself :: CMetaBind + _x2IcTrf :: CMetaVal + _x2IfvS :: FvS + _x2IgUniq :: Int + _x2IisDictClass :: Bool + _x2IisDictInstance :: Bool + _x2IisInstance :: Bool + _x2IlevOf :: Int + _x2ImbTrack :: (Maybe Track) + _x2Iself :: CMetaVal + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _x1IfvS `Set.union` _x2IfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _x1IlevOf `max` _x2IlevOf + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _self = + (_x1Iself,_x2Iself) + -- self rule + _lhsOcTrf = + _cTrf + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOgUniq = + _x2IgUniq + -- copy rule (up) + _lhsOisDictClass = + _x2IisDictClass + -- copy rule (up) + _lhsOisDictInstance = + _x2IisDictInstance + -- copy rule (up) + _lhsOisInstance = + _x2IisInstance + -- copy rule (up) + _lhsOmbTrack = + _x2ImbTrack + -- copy rule (down) + _x1OargMp = + _lhsIargMp + -- copy rule (down) + _x1OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x1OgUniq = + _lhsIgUniq + -- copy rule (down) + _x1OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x1OlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _x1OlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _x1OlamS = + _lhsIlamS + -- copy rule (down) + _x1Olev = + _lhsIlev + -- copy rule (down) + _x1OvarS = + _lhsIvarS + -- copy rule (down) + _x2OargMp = + _lhsIargMp + -- copy rule (down) + _x2ObindLamArgMp = + _lhsIbindLamArgMp + -- copy rule (down) + _x2OcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _x2OenvFinal = + _lhsIenvFinal + -- copy rule (chain) + _x2OgUniq = + _x1IgUniq + -- copy rule (down) + _x2OintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _x2OlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _x2OlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _x2OlamS = + _lhsIlamS + -- copy rule (down) + _x2Olev = + _lhsIlev + -- copy rule (down) + _x2OvarS = + _lhsIvarS + ( _x1IcTrf,_x1IfvS,_x1IgUniq,_x1IlevOf,_x1Iself) = + x1_ _x1OargMp _x1OcvarIntroMp _x1OgUniq _x1OintroCVarIntroMp _x1OlamArgMp _x1OlamFvSMp _x1OlamS _x1Olev _x1OvarS + ( _x2IcTrf,_x2IfvS,_x2IgUniq,_x2IisDictClass,_x2IisDictInstance,_x2IisInstance,_x2IlevOf,_x2ImbTrack,_x2Iself) = + x2_ _x2OargMp _x2ObindLamArgMp _x2OcvarIntroMp _x2OenvFinal _x2OgUniq _x2OintroCVarIntroMp _x2OlamArgMp _x2OlamFvSMp _x2OlamS _x2Olev _x2OvarS + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOisDictClass,_lhsOisDictInstance,_lhsOisInstance,_lhsOlevOf,_lhsOmbTrack,_lhsOself))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CModule + fvS : FvS + levOf : Int + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CModule,FvS,Int,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _exprOisTopApp :: Bool + _exprOisTopTup :: Bool + _whatAbove :: WhatExpr + _exprOevalCtx :: EvalCtx + _exprOmbCtxCount :: (Maybe Int) + _exprOisDictClass :: Bool + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CModule + _lhsOgUniq :: Int + _exprOargMp :: CVarReplNmMp + _exprOcvarIntroMp :: CVarIntroMp + _exprOgUniq :: Int + _exprOintroCVarIntroMp :: CVarIntroMp + _exprOlamArgMp :: LamArgMp + _exprOlamFvSMp :: FvSMp + _exprOlamS :: FvS + _exprOlev :: Int + _exprOvarS :: FvS + _exprOwhatAbove :: WhatExpr + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIappFunKind :: AppFunKind + _exprIbindLamArgMp :: LamArgMp + _exprIcTrf :: CExpr + _exprIenvUp :: Env + _exprIfvS :: FvS + _exprIgUniq :: Int + _exprIlevOf :: Int + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _exprIwhatBelow :: WhatExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 27, column 17) + _exprOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 90, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 99, column 17) + _exprOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 176, column 10) + _exprOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 177, column 10) + _exprOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _exprIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _exprIlevOf + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _exprIgUniq + -- copy rule (down) + _exprOargMp = + _lhsIargMp + -- copy rule (down) + _exprOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _exprOgUniq = + _lhsIgUniq + -- copy rule (down) + _exprOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _exprOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _exprOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _exprOlamS = + _lhsIlamS + -- copy rule (down) + _exprOlev = + _lhsIlev + -- copy rule (down) + _exprOvarS = + _lhsIvarS + -- copy rule (from local) + _exprOwhatAbove = + _whatAbove + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIappFunKind,_exprIbindLamArgMp,_exprIcTrf,_exprIenvUp,_exprIfvS,_exprIgUniq,_exprIlevOf,_exprImbLam,_exprImbVar,_exprIwhatBelow) = + expr_ _exprOargMp _exprOcvarIntroMp _exprOevalCtx _exprOgUniq _exprOintroCVarIntroMp _exprOisDictClass _exprOisTopApp _exprOisTopTup _exprOlamArgMp _exprOlamFvSMp _exprOlamS _exprOlev _exprOmbCtxCount _exprOvarS _exprOwhatAbove + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CPat,([HsName]),FvS,Int,Int,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 28, column 17) + _lhsOnmL = + [pnm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + _restOargMp :: CVarReplNmMp + _restOcvarIntroMp :: CVarIntroMp + _restOgUniq :: Int + _restOintroCVarIntroMp :: CVarIntroMp + _restOlamArgMp :: LamArgMp + _restOlamFvSMp :: FvSMp + _restOlamS :: FvS + _restOlev :: Int + _restOvarS :: FvS + _bindsOargMp :: CVarReplNmMp + _bindsOcvarIntroMp :: CVarIntroMp + _bindsOgUniq :: Int + _bindsOintroCVarIntroMp :: CVarIntroMp + _bindsOlamArgMp :: LamArgMp + _bindsOlamFvSMp :: FvSMp + _bindsOlamS :: FvS + _bindsOlev :: Int + _bindsOvarS :: FvS + _restIcTrf :: CPatRest + _restIfvS :: FvS + _restIgUniq :: Int + _restIlevOf :: Int + _restInmL :: ([HsName]) + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + _bindsIfvS :: FvS + _bindsIgUniq :: Int + _bindsIlevOf :: Int + _bindsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 29, column 17) + _lhsOnmL = + _restInmL ++ _bindsInmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _restIfvS `Set.union` _bindsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _restIlevOf `max` _bindsIlevOf + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _bindsIgUniq + -- copy rule (down) + _restOargMp = + _lhsIargMp + -- copy rule (down) + _restOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _restOgUniq = + _lhsIgUniq + -- copy rule (down) + _restOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _restOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _restOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _restOlamS = + _lhsIlamS + -- copy rule (down) + _restOlev = + _lhsIlev + -- copy rule (down) + _restOvarS = + _lhsIvarS + -- copy rule (down) + _bindsOargMp = + _lhsIargMp + -- copy rule (down) + _bindsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _bindsOgUniq = + _restIgUniq + -- copy rule (down) + _bindsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindsOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bindsOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bindsOlamS = + _lhsIlamS + -- copy rule (down) + _bindsOlev = + _lhsIlev + -- copy rule (down) + _bindsOvarS = + _lhsIvarS + ( _restIcTrf,_restIfvS,_restIgUniq,_restIlevOf,_restInmL) = + rest_ _restOargMp _restOcvarIntroMp _restOgUniq _restOintroCVarIntroMp _restOlamArgMp _restOlamFvSMp _restOlamS _restOlev _restOvarS + ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsIgUniq,_bindsIlevOf,_bindsInmL) = + binds_ _bindsOargMp _bindsOcvarIntroMp _bindsOgUniq _bindsOintroCVarIntroMp _bindsOlamArgMp _bindsOlamFvSMp _bindsOlamS _bindsOlev _bindsOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPat + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local whatAbove : {WhatExpr} + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CPatFld,([HsName]),FvS,Int,Int,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfldNmL :: ([HsName]) + _bindOletBindingsCateg :: CBindCateg + _offsetOisTopApp :: Bool + _offsetOisTopTup :: Bool + _whatAbove :: WhatExpr + _offsetOevalCtx :: EvalCtx + _bindOevalCtx :: EvalCtx + _bindOisGlobal :: Bool + _offsetOmbCtxCount :: (Maybe Int) + _offsetOisDictClass :: Bool + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatFld + _lhsOgUniq :: Int + _offsetOargMp :: CVarReplNmMp + _offsetOcvarIntroMp :: CVarIntroMp + _offsetOgUniq :: Int + _offsetOintroCVarIntroMp :: CVarIntroMp + _offsetOlamArgMp :: LamArgMp + _offsetOlamFvSMp :: FvSMp + _offsetOlamS :: FvS + _offsetOlev :: Int + _offsetOvarS :: FvS + _offsetOwhatAbove :: WhatExpr + _bindOargMp :: CVarReplNmMp + _bindOcvarIntroMp :: CVarIntroMp + _bindOgUniq :: Int + _bindOintroCVarIntroMp :: CVarIntroMp + _bindOlamArgMp :: LamArgMp + _bindOlamFvSMp :: FvSMp + _bindOlamS :: FvS + _bindOlev :: Int + _bindOvarS :: FvS + _fldAnnsOargMp :: CVarReplNmMp + _fldAnnsOcvarIntroMp :: CVarIntroMp + _fldAnnsOgUniq :: Int + _fldAnnsOintroCVarIntroMp :: CVarIntroMp + _fldAnnsOlamArgMp :: LamArgMp + _fldAnnsOlamFvSMp :: FvSMp + _fldAnnsOlamS :: FvS + _fldAnnsOlev :: Int + _fldAnnsOvarS :: FvS + _offsetIappFunKind :: AppFunKind + _offsetIbindLamArgMp :: LamArgMp + _offsetIcTrf :: CExpr + _offsetIenvUp :: Env + _offsetIfvS :: FvS + _offsetIgUniq :: Int + _offsetIlevOf :: Int + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _offsetIwhatBelow :: WhatExpr + _bindIbindLamArgMp :: LamArgMp + _bindIbindLamS :: FvS + _bindIbindVarS :: FvS + _bindIbindsIntroCVarIntroMp :: CVarIntroMp + _bindIcTrf :: CBind + _bindIcvarIntroExprMp :: CVarIntroMp + _bindIenvUp :: Env + _bindIfvS :: FvS + _bindIfvSMp :: FvSMp + _bindIgUniq :: Int + _bindIlevOf :: Int + _bindInm :: HsName + _bindInmL :: ([HsName]) + _fldAnnsIcTrf :: CBindAnnL + _fldAnnsIfvS :: FvS + _fldAnnsIgUniq :: Int + _fldAnnsIlevOf :: Int + _fldAnnsInmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 22, column 17) + _lhsOnmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 9, column 17) + _bindOletBindingsCateg = + acoreBindcategPlain + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopApp = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 41, column 17) + _offsetOisTopTup = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 84, column 17) + _whatAbove = + ExprIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) + _offsetOevalCtx = + EvalCtx_Eval + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 103, column 33) + _bindOevalCtx = + EvalCtx_None + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 15, column 17) + _bindOisGlobal = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 192, column 10) + _offsetOmbCtxCount = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 193, column 10) + _offsetOisDictClass = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _offsetIlevOf `max` _bindIlevOf `max` _fldAnnsIlevOf + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _fldAnnsIgUniq + -- copy rule (down) + _offsetOargMp = + _lhsIargMp + -- copy rule (down) + _offsetOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _offsetOgUniq = + _lhsIgUniq + -- copy rule (down) + _offsetOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _offsetOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _offsetOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _offsetOlamS = + _lhsIlamS + -- copy rule (down) + _offsetOlev = + _lhsIlev + -- copy rule (down) + _offsetOvarS = + _lhsIvarS + -- copy rule (from local) + _offsetOwhatAbove = + _whatAbove + -- copy rule (down) + _bindOargMp = + _lhsIargMp + -- copy rule (down) + _bindOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _bindOgUniq = + _offsetIgUniq + -- copy rule (down) + _bindOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _bindOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _bindOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _bindOlamS = + _lhsIlamS + -- copy rule (down) + _bindOlev = + _lhsIlev + -- copy rule (down) + _bindOvarS = + _lhsIvarS + -- copy rule (down) + _fldAnnsOargMp = + _lhsIargMp + -- copy rule (down) + _fldAnnsOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _fldAnnsOgUniq = + _bindIgUniq + -- copy rule (down) + _fldAnnsOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _fldAnnsOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _fldAnnsOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _fldAnnsOlamS = + _lhsIlamS + -- copy rule (down) + _fldAnnsOlev = + _lhsIlev + -- copy rule (down) + _fldAnnsOvarS = + _lhsIvarS + ( _offsetIappFunKind,_offsetIbindLamArgMp,_offsetIcTrf,_offsetIenvUp,_offsetIfvS,_offsetIgUniq,_offsetIlevOf,_offsetImbLam,_offsetImbVar,_offsetIwhatBelow) = + offset_ _offsetOargMp _offsetOcvarIntroMp _offsetOevalCtx _offsetOgUniq _offsetOintroCVarIntroMp _offsetOisDictClass _offsetOisTopApp _offsetOisTopTup _offsetOlamArgMp _offsetOlamFvSMp _offsetOlamS _offsetOlev _offsetOmbCtxCount _offsetOvarS _offsetOwhatAbove + ( _bindIbindLamArgMp,_bindIbindLamS,_bindIbindVarS,_bindIbindsIntroCVarIntroMp,_bindIcTrf,_bindIcvarIntroExprMp,_bindIenvUp,_bindIfvS,_bindIfvSMp,_bindIgUniq,_bindIlevOf,_bindInm,_bindInmL) = + bind_ _bindOargMp _bindOcvarIntroMp _bindOevalCtx _bindOgUniq _bindOintroCVarIntroMp _bindOisGlobal _bindOlamArgMp _bindOlamFvSMp _bindOlamS _bindOletBindingsCateg _bindOlev _bindOvarS + ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsIgUniq,_fldAnnsIlevOf,_fldAnnsInmL) = + fldAnns_ _fldAnnsOargMp _fldAnnsOcvarIntroMp _fldAnnsOgUniq _fldAnnsOintroCVarIntroMp _fldAnnsOlamArgMp _fldAnnsOlamFvSMp _fldAnnsOlamS _fldAnnsOlev _fldAnnsOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CPatFldL,([HsName]),FvS,Int,Int,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: Int + _hdOargMp :: CVarReplNmMp + _hdOcvarIntroMp :: CVarIntroMp + _hdOgUniq :: Int + _hdOintroCVarIntroMp :: CVarIntroMp + _hdOlamArgMp :: LamArgMp + _hdOlamFvSMp :: FvSMp + _hdOlamS :: FvS + _hdOlev :: Int + _hdOvarS :: FvS + _tlOargMp :: CVarReplNmMp + _tlOcvarIntroMp :: CVarIntroMp + _tlOgUniq :: Int + _tlOintroCVarIntroMp :: CVarIntroMp + _tlOlamArgMp :: LamArgMp + _tlOlamFvSMp :: FvSMp + _tlOlamS :: FvS + _tlOlev :: Int + _tlOvarS :: FvS + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _hdIfvS :: FvS + _hdIgUniq :: Int + _hdIlevOf :: Int + _hdInmL :: ([HsName]) + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + _tlIfvS :: FvS + _tlIgUniq :: Int + _tlIlevOf :: Int + _tlInmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + _hdIfvS `Set.union` _tlIfvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + _hdIlevOf `max` _tlIlevOf + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + _hdInmL ++ _tlInmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (down) + _hdOargMp = + _lhsIargMp + -- copy rule (down) + _hdOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _hdOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _hdOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _hdOlamS = + _lhsIlamS + -- copy rule (down) + _hdOlev = + _lhsIlev + -- copy rule (down) + _hdOvarS = + _lhsIvarS + -- copy rule (down) + _tlOargMp = + _lhsIargMp + -- copy rule (down) + _tlOcvarIntroMp = + _lhsIcvarIntroMp + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOintroCVarIntroMp = + _lhsIintroCVarIntroMp + -- copy rule (down) + _tlOlamArgMp = + _lhsIlamArgMp + -- copy rule (down) + _tlOlamFvSMp = + _lhsIlamFvSMp + -- copy rule (down) + _tlOlamS = + _lhsIlamS + -- copy rule (down) + _tlOlev = + _lhsIlev + -- copy rule (down) + _tlOvarS = + _lhsIvarS + ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdIgUniq,_hdIlevOf,_hdInmL) = + hd_ _hdOargMp _hdOcvarIntroMp _hdOgUniq _hdOintroCVarIntroMp _hdOlamArgMp _hdOlamFvSMp _hdOlamS _hdOlev _hdOvarS + ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlIgUniq,_tlIlevOf,_tlInmL) = + tl_ _tlOargMp _tlOcvarIntroMp _tlOgUniq _tlOintroCVarIntroMp _tlOlamArgMp _tlOlamFvSMp _tlOlamS _tlOlev _tlOvarS + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + argMp : CVarReplNmMp + cvarIntroMp : CVarIntroMp + introCVarIntroMp : CVarIntroMp + lamArgMp : LamArgMp + lamFvSMp : FvSMp + lamS : FvS + lev : Int + varS : FvS + chained attribute: + gUniq : Int + synthesized attributes: + cTrf : CPatRest + fvS : FvS + levOf : Int + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = CVarReplNmMp -> + CVarIntroMp -> + Int -> + CVarIntroMp -> + LamArgMp -> + FvSMp -> + FvS -> + Int -> + FvS -> + ( CPatRest,FvS,Int,Int,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOnmL :: ([HsName]) + _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOcTrf :: CPatRest + _lhsOgUniq :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 25, column 17) + _lhsOnmL = + [nm_] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIargMp + _lhsIcvarIntroMp + _lhsIgUniq + _lhsIintroCVarIntroMp + _lhsIlamArgMp + _lhsIlamFvSMp + _lhsIlamS + _lhsIlev + _lhsIvarS -> + (let _lhsOfvS :: FvS + _lhsOlevOf :: Int + _lhsOnmL :: ([HsName]) + _lhsOcTrf :: CPatRest + _lhsOgUniq :: Int + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 1, column 26) + _lhsOfvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 56, column 28) + _lhsOlevOf = + cLevModule + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonFv.ag"(line 16, column 31) + _lhsOnmL = + [] + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + in ( _lhsOcTrf,_lhsOfvS,_lhsOgUniq,_lhsOlevOf,_lhsOnmL))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (let _moduleOvarS :: FvS + _moduleOlamS :: FvS + _moduleOcvarIntroMp :: CVarIntroMp + _moduleOintroCVarIntroMp :: CVarIntroMp + _moduleOlev :: Int + _moduleOgUniq :: Int + _moduleOlamFvSMp :: FvSMp + _moduleOargMp :: CVarReplNmMp + _moduleOlamArgMp :: LamArgMp + _lhsOcTrf :: CModule + _moduleIcTrf :: CModule + _moduleIfvS :: FvS + _moduleIgUniq :: Int + _moduleIlevOf :: Int + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 14, column 17) + _moduleOvarS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonGlobalAsArg.ag"(line 14, column 17) + _moduleOlamS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 20, column 17) + _moduleOcvarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/CommonLev.ag"(line 41, column 17) + _moduleOintroCVarIntroMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLev.ag"(line 4, column 17) + _moduleOlev = + cLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 55, column 17) + _moduleOgUniq = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 64, column 17) + _moduleOlamFvSMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 80, column 17) + _moduleOargMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 121, column 17) + _moduleOlamArgMp = + Map.empty + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + ( _moduleIcTrf,_moduleIfvS,_moduleIgUniq,_moduleIlevOf) = + module_ _moduleOargMp _moduleOcvarIntroMp _moduleOgUniq _moduleOintroCVarIntroMp _moduleOlamArgMp _moduleOlamFvSMp _moduleOlamS _moduleOlev _moduleOvarS + in ( _lhsOcTrf)) diff --git a/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs b/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs @@ -0,0 +1,2319 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LetDe) +module UHC.Light.Compiler.Core.Trf.LetDefBeforeUse(cmodTrfLetDefBeforeUse) where + +import Data.Maybe +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.Base.Debug +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.Utils (scc) + + + + + + + + + + + + + +cmodTrfLetDefBeforeUse :: CModule -> CModule +cmodTrfLetDefBeforeUse cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) Inh_CodeAGItf + in cTrf_Syn_CodeAGItf t + + + +-- | A definition just administers the code (required for transformation) and what it uses (to reorder). +data Def + = Def + { defCateg :: CBindCateg -- the category of the binding + , defCore :: CBind -- the actual code + , defFvS :: FvS -- its used (free) vars + } + +emptyDef :: Def +emptyDef = Def CBindCateg_Rec (CBind_Bind hsnUnknown []) Set.empty + +type DefMp = Map.Map HsName Def + +defMpComb :: DefMp -> DefMp -> DefMp +defMpComb = Map.unionWith (\d1 d2 -> d1 {defFvS = defFvS d1 `Set.union` defFvS d2}) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CAlt + defMp : DefMp + fvS : FvS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local lev : _ + local cTrf : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = Int -> + ( CAlt,DefMp,FvS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIlev -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOlev) of + { ( _patIcTrf,_patIdefMp,_patIfldNmL,_patIfvS,_patInmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_patIdefMp `defMpComb` _exprIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CAltL + defMp : DefMp + fvS : FvS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = Int -> + ( CAltL,DefMp,FvS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcTrf,_tlIdefMp,_tlIfvS) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcTrf,_hdIdefMp,_hdIfvS) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIdefMp `defMpComb` _tlIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + synthesized attributes: + cTrf : CBind + defMp : DefMp + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = Bool -> + Int -> + ( CBind,DefMp,FvS,FvSMp,HsName,([HsName])) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIisGlobal + _lhsIlev -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_ _bindAspectsOisGlobal _bindAspectsOlev _bindAspectsOnm) of + { ( _bindAspectsIcTrf,_bindAspectsIdefMp,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL) | True -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.singleton nm_ (emptyDef {defCore = _cTrf, defFvS = _bindAspectsIfvS})) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CBindAnn + defMp : DefMp + fvS : FvS + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + ( CBindAnn,DefMp,FvS,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlev -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CBindAnnL + defMp : DefMp + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + ( CBindAnnL,DefMp,FvS,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcTrf,_tlIdefMp,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcTrf,_hdIdefMp,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIdefMp `defMpComb` _tlIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + synthesized attributes: + cTrf : CBindL + defMp : DefMp + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = Bool -> + Int -> + ( CBindL,DefMp,FvS,FvSMp,([HsName])) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIisGlobal + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (tl_ _tlOisGlobal _tlOlev) of + { ( _tlIcTrf,_tlIdefMp,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (hd_ _hdOisGlobal _hdOlev) of + { ( _hdIcTrf,_hdIdefMp,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIdefMp `defMpComb` _tlIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIisGlobal + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + nm : HsName + synthesized attributes: + cTrf : CBound + defMp : DefMp + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = Bool -> + Int -> + HsName -> + ( CBound,DefMp,FvS,FvSMp,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (bindMeta_ _bindMetaOlev) of + { ( _bindMetaIcTrf,_bindMetaIdefMp,_bindMetaIfvS) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindMetaIdefMp `defMpComb` _exprIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (cmetas_ _cmetasOlev) of + { ( _cmetasIcTrf,_cmetasIdefMp,_cmetasIfvS) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cmetasIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_cmetasIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + isGlobal : Bool + lev : Int + nm : HsName + synthesized attributes: + cTrf : CBoundL + defMp : DefMp + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = Bool -> + Int -> + HsName -> + ( CBoundL,DefMp,FvS,FvSMp,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (tl_ _tlOisGlobal _tlOlev _tlOnm) of + { ( _tlIcTrf,_tlIdefMp,_tlIfvS,_tlIfvSMp,_tlInmL) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (hd_ _hdOisGlobal _hdOlev _hdOnm) of + { ( _hdIcTrf,_hdIdefMp,_hdIfvS,_hdIfvSMp,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIdefMp `defMpComb` _tlIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOfvSMp,_lhsOnmL) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CExpr + defMp : DefMp + fvS : FvS + letBody : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isGlobal : _ + local cTrf : _ + local fvS : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local isGlobal : _ + local cTrf : _ + local fvS : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local lev : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local fvS : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = Int -> + ( CExpr,DefMp,FvS,CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIlev -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Set.singleton _nm) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIlev -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIlev -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIlev -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIlev -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIlev -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOlev) of + { ( _bodyIcTrf,_bodyIdefMp,_bodyIfvS,_bodyIletBody) | True -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (_lhsIlev + 1) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOisGlobal _bindsOlev) of + { ( _bindsIcTrf,_bindsIdefMp,_bindsIfvS,_bindsIfvSMp,_bindsInmL) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (if _isGlobal + then Map.map (\d -> d {defCateg = categ_}) _bindsIdefMp `defMpComb` _bodyIdefMp + else Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_bodyIletBody) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_ _argOisGlobal _argOlev _argOnm) of + { ( _argIcTrf,_argIdefMp,_argIfvS,_argIfvSMp,_argInmL) | True -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (func_ _funcOlev) of + { ( _funcIcTrf,_funcIdefMp,_funcIfvS,_funcIletBody) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIlev -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOlev) of + { ( _bodyIcTrf,_bodyIdefMp,_bodyIfvS,_bodyIletBody) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (bind_ _bindOisGlobal _bindOlev) of + { ( _bindIcTrf,_bindIdefMp,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (dflt_ _dfltOlev) of + { ( _dfltIcTrf,_dfltIdefMp,_dfltIfvS,_dfltIletBody) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (alts_ _altsOlev) of + { ( _altsIcTrf,_altsIdefMp,_altsIfvS) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (errorExpr_ _errorExprOlev) of + { ( _errorExprIcTrf,_errorExprIdefMp,_errorExprIfvS,_errorExprIletBody) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_errorExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOlev) of + { ( _offsetIcTrf,_offsetIdefMp,_offsetIfvS,_offsetIletBody) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (fldExpr_ _fldExprOlev) of + { ( _fldExprIcTrf,_fldExprIdefMp,_fldExprIfvS,_fldExprIletBody) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOlev) of + { ( _offsetIcTrf,_offsetIdefMp,_offsetIfvS,_offsetIletBody) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (fldExpr_ _fldExprOlev) of + { ( _fldExprIcTrf,_fldExprIdefMp,_fldExprIfvS,_fldExprIletBody) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOlev) of + { ( _offsetIcTrf,_offsetIdefMp,_offsetIfvS,_offsetIletBody) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIlev -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIlev -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIlev -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOlev) of + { ( _bodyIcTrf,_bodyIdefMp,_bodyIfvS,_bodyIletBody) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIlev -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (func_ _funcOlev) of + { ( _funcIcTrf,_funcIdefMp,_funcIfvS,_funcIletBody) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_funcIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOlev) of + { ( _bodyIcTrf,_bodyIdefMp,_bodyIfvS,_bodyIletBody) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (ann_ _annOlev) of + { ( _annIcTrf,_annIdefMp,_annIfvS) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_annIdefMp `defMpComb` _exprIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_cTrf) of + { _lhsOletBody | _lhsOletBody `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOletBody) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CExprAnn + defMp : DefMp + fvS : FvS + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + ( CExprAnn,DefMp,FvS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlev -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlev -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlev -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetaBind + defMp : DefMp + fvS : FvS + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + ( CMetaBind,DefMp,FvS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlev -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlev -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlev -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlev -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetaVal + defMp : DefMp + fvS : FvS + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + ( CMetaVal,DefMp,FvS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlev -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlev -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlev -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlev -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlev -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CMetas + defMp : DefMp + fvS : FvS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + ( CMetas,DefMp,FvS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (x2_ _x2Olev) of + { ( _x2IcTrf,_x2IdefMp,_x2IfvS) | True -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (x1_ _x1Olev) of + { ( _x1IcTrf,_x1IdefMp,_x1IfvS) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_x1IdefMp `defMpComb` _x2IdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CModule + fvS : FvS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local sccDefs : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = Int -> + ( CModule,FvS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOlev) of + { ( _exprIcTrf,_exprIdefMp,_exprIfvS,_exprIletBody) | True -> + (case (map (catMaybes . map (\n -> Map.lookup n _exprIdefMp)) + $ scc [ (n, Set.toList $ defFvS d) | (n,d) <- Map.toList _exprIdefMp ]) of + { _sccDefs | _sccDefs `seq` (True) -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (let mk ds@(_:_:_) e = acoreLetRec (map defCore ds) e + mk [d] e = acoreLet (defCateg d) [defCore d] e + in CModule_Mod + moduleNm_ + _importsIcTrf + _declMetasIcTrf + (foldr mk _exprIletBody _sccDefs)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPat + defMp : DefMp + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = Int -> + ( CPat,DefMp,([HsName]),FvS,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlev -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOlev) of + { ( _bindsIcTrf,_bindsIdefMp,_bindsIfldNmL,_bindsIfvS,_bindsInmL) | True -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_ _restOlev) of + { ( _restIcTrf,_restIdefMp,_restIfvS,_restInmL) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_restIdefMp `defMpComb` _bindsIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlev -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlev -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlev -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatFld + defMp : DefMp + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = Int -> + ( CPatFld,DefMp,([HsName]),FvS,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (fldAnns_ _fldAnnsOlev) of + { ( _fldAnnsIcTrf,_fldAnnsIdefMp,_fldAnnsIfvS,_fldAnnsInmL) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (bind_ _bindOisGlobal _bindOlev) of + { ( _bindIcTrf,_bindIdefMp,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOlev) of + { ( _offsetIcTrf,_offsetIdefMp,_offsetIfvS,_offsetIletBody) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_offsetIdefMp `defMpComb` _bindIdefMp `defMpComb` _fldAnnsIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatFldL + defMp : DefMp + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = Int -> + ( CPatFldL,DefMp,([HsName]),FvS,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOlev) of + { ( _tlIcTrf,_tlIdefMp,_tlIfldNmL,_tlIfvS,_tlInmL) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOlev) of + { ( _hdIcTrf,_hdIdefMp,_hdIfldNmL,_hdIfvS,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIdefMp `defMpComb` _tlIdefMp) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfldNmL,_lhsOfvS,_lhsOnmL) }) }) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attribute: + lev : Int + synthesized attributes: + cTrf : CPatRest + defMp : DefMp + fvS : FvS + nmL : [HsName] + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = Int -> + ( CPatRest,DefMp,FvS,([HsName])) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlev -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlev -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Map.empty) of + { _lhsOdefMp | _lhsOdefMp `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOdefMp,_lhsOfvS,_lhsOnmL) }) }) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) | True = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOlev) of + { ( _moduleIcTrf,_moduleIfvS) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) diff --git a/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs b/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs @@ -0,0 +1,1995 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LetFl) +module UHC.Light.Compiler.Core.Trf.LetFlattenStrict(cmodTrfLetFlattenStrict) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import Data.Maybe +import qualified UHC.Util.FastSeq as Seq + + + + + + + + + +cmodTrfLetFlattenStrict :: CModule -> CModule +cmodTrfLetFlattenStrict cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) Inh_CodeAGItf + in cTrf_Syn_CodeAGItf t + + + +type Lift = (Seq.Seq CBind,CExpr) +type MbLift = Maybe Lift + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local isStrictChain : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (False) of + { _isStrictChain -> + (case (_isStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (pat_) of + { ( _patIcTrf) -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + chained attribute: + isStrictChain : Bool + synthesized attributes: + binds : Seq.Seq CBind + cTrf : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = Bool -> + ( (Seq.Seq CBind),CBind,Bool) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _bindAspectsOisStrictChain -> + (case (bindAspects_ _bindAspectsOisStrictChain) of + { ( _bindAspectsIaspLiftL,_bindAspectsIcTrf,_bindAspectsIhasNonPlainBinds,_bindAspectsIisStrictChain) -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf -> + (case (case _bindAspectsIaspLiftL of + [(flatBinds,flatExpr)] | not _bindAspectsIhasNonPlainBinds + -> flatBinds `Seq.union` Seq.singleton (acoreBind1Cat CBindCateg_Strict nm_ flatExpr) + _ -> Seq.singleton _cTrf) of + { _lhsObinds -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (_bindAspectsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsObinds,_lhsOcTrf,_lhsOisStrictChain) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (CBindAnn_Coe coe_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + chained attribute: + isStrictChain : Bool + synthesized attributes: + binds : Seq.Seq CBind + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = Bool -> + ( (Seq.Seq CBind),CBindL,Bool) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _hdOisStrictChain -> + (case (hd_ _hdOisStrictChain) of + { ( _hdIbinds,_hdIcTrf,_hdIisStrictChain) -> + (case (_hdIisStrictChain) of + { _tlOisStrictChain -> + (case (tl_ _tlOisStrictChain) of + { ( _tlIbinds,_tlIcTrf,_tlIisStrictChain) -> + (case (_hdIbinds `Seq.union` _tlIbinds) of + { _lhsObinds -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (_tlIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsObinds,_lhsOcTrf,_lhsOisStrictChain) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIisStrictChain -> + (case (Seq.empty) of + { _lhsObinds -> + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsObinds,_lhsOcTrf,_lhsOisStrictChain) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + chained attribute: + isStrictChain : Bool + synthesized attributes: + aspLiftL : [Lift] + cTrf : CBound + hasNonPlainBinds : Bool + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = Bool -> + ( ([Lift]),CBound,Bool,Bool) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (maybe [] (:[]) _exprImbLift) of + { _lhsOaspLiftL -> + (case (bindMeta_) of + { ( _bindMetaIcTrf) -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (False) of + { _lhsOhasNonPlainBinds -> + (case (_exprIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case (cmetas_) of + { ( _cmetasIcTrf) -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (True) of + { _lhsOhasNonPlainBinds -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (True) of + { _lhsOhasNonPlainBinds -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (True) of + { _lhsOhasNonPlainBinds -> + (case (_exprIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (True) of + { _lhsOhasNonPlainBinds -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (True) of + { _lhsOhasNonPlainBinds -> + (case (_exprIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + chained attribute: + isStrictChain : Bool + synthesized attributes: + aspLiftL : [Lift] + cTrf : CBoundL + hasNonPlainBinds : Bool + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = Bool -> + ( ([Lift]),CBoundL,Bool,Bool) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _hdOisStrictChain -> + (case (hd_ _hdOisStrictChain) of + { ( _hdIaspLiftL,_hdIcTrf,_hdIhasNonPlainBinds,_hdIisStrictChain) -> + (case (_hdIisStrictChain) of + { _tlOisStrictChain -> + (case (tl_ _tlOisStrictChain) of + { ( _tlIaspLiftL,_tlIcTrf,_tlIhasNonPlainBinds,_tlIisStrictChain) -> + (case (_hdIaspLiftL ++ _tlIaspLiftL) of + { _lhsOaspLiftL -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (_hdIhasNonPlainBinds || _tlIhasNonPlainBinds) of + { _lhsOhasNonPlainBinds -> + (case (_tlIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIisStrictChain -> + (case ([]) of + { _lhsOaspLiftL -> + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (False) of + { _lhsOhasNonPlainBinds -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + ( _lhsOaspLiftL,_lhsOcTrf,_lhsOhasNonPlainBinds,_lhsOisStrictChain) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + chained attribute: + isStrictChain : Bool + synthesized attributes: + binds : Seq.Seq CBind + cTrf : CExpr + flatExpr : CExpr + mbLift : MbLift + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local _tup1 : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + local _tup2 : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + local _tup3 : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + local _tup4 : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + local _tup5 : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + local _tup6 : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isStrictChain : _ + local cTrf : _ + local letbinds : _ + local isLaterInChain : _ + local _tup7 : _ + local isFirstInChain : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local cTrf : _ + local _tup8 : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local cTrf : _ + local _tup9 : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + local _tup10 : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + local _tup11 : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + local _tup12 : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + local _tup13 : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + local _tup14 : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + local _tup15 : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + local _tup16 : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + local _tup17 : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + local _tup18 : _ + alternative CoeArg: + visit 0: + local cTrf : _ + local _tup19 : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + local _tup20 : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + local _tup21 : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ + local _tup22 : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = Bool -> + ( (Seq.Seq CBind),CExpr,CExpr,Bool,MbLift) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Var ref_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup1 -> + (case (__tup1) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup1) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Int int_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup2 -> + (case (__tup2) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup2) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Char char_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup3 -> + (case (__tup3) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup3) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIisStrictChain -> + (case (CExpr_String str_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup4 -> + (case (__tup4) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup4) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Integer integer_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup5 -> + (case (__tup5) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup5) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Tup tag_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup6 -> + (case (__tup6) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup6) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIisStrictChain -> + (case (categ_ == CBindCateg_Strict) of + { _isStrictChain -> + (case (_isStrictChain) of + { _bindsOisStrictChain -> + (case (binds_ _bindsOisStrictChain) of + { ( _bindsIbinds,_bindsIcTrf,_bindsIisStrictChain) -> + (case (_isStrictChain && _bindsIisStrictChain) of + { _bodyOisStrictChain -> + (case (body_ _bodyOisStrictChain) of + { ( _bodyIbinds,_bodyIcTrf,_bodyIflatExpr,_bodyIisStrictChain,_bodyImbLift) -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf -> + (case (_bindsIbinds `Seq.union` _bodyIbinds) of + { _letbinds -> + (case (_isStrictChain && _lhsIisStrictChain) of + { _isLaterInChain -> + (case (if _isLaterInChain + then (_letbinds,_bodyIflatExpr) + else (Seq.empty,_cTrf)) of + { __tup7 -> + (case (__tup7) of + { (_lhsObinds,_) -> + (case (_isStrictChain && not _lhsIisStrictChain) of + { _isFirstInChain -> + (case (if _isFirstInChain + then foldr (\b e -> CExpr_Let categ_ [b] e) _bodyIflatExpr $ Seq.toList _letbinds + else _cTrf) of + { _lhsOcTrf -> + (case (__tup7) of + { (_,_lhsOflatExpr) -> + (case (_isStrictChain && _bodyIisStrictChain) of + { _lhsOisStrictChain -> + (case (if _isLaterInChain + then Just (_letbinds, _bodyIflatExpr) + else Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _funcOisStrictChain -> + (case (func_ _funcOisStrictChain) of + { ( _funcIbinds,_funcIcTrf,_funcIflatExpr,_funcIisStrictChain,_funcImbLift) -> + (case (_funcIisStrictChain) of + { _argOisStrictChain -> + (case (arg_ _argOisStrictChain) of + { ( _argIaspLiftL,_argIcTrf,_argIhasNonPlainBinds,_argIisStrictChain) -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup8 -> + (case (__tup8) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup8) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _bindOisStrictChain -> + (case (bind_ _bindOisStrictChain) of + { ( _bindIbinds,_bindIcTrf,_bindIisStrictChain) -> + (case (_bindIisStrictChain) of + { _bodyOisStrictChain -> + (case (body_ _bodyOisStrictChain) of + { ( _bodyIbinds,_bodyIcTrf,_bodyIflatExpr,_bodyIisStrictChain,_bodyImbLift) -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup9 -> + (case (__tup9) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup9) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (_exprIisStrictChain) of + { _dfltOisStrictChain -> + (case (dflt_ _dfltOisStrictChain) of + { ( _dfltIbinds,_dfltIcTrf,_dfltIflatExpr,_dfltIisStrictChain,_dfltImbLift) -> + (case (alts_) of + { ( _altsIcTrf) -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup10 -> + (case (__tup10) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup10) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _errorExprOisStrictChain -> + (case (errorExpr_ _errorExprOisStrictChain) of + { ( _errorExprIbinds,_errorExprIcTrf,_errorExprIflatExpr,_errorExprIisStrictChain,_errorExprImbLift) -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup11 -> + (case (__tup11) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup11) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (_exprIisStrictChain) of + { _offsetOisStrictChain -> + (case (offset_ _offsetOisStrictChain) of + { ( _offsetIbinds,_offsetIcTrf,_offsetIflatExpr,_offsetIisStrictChain,_offsetImbLift) -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup12 -> + (case (__tup12) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup12) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (_exprIisStrictChain) of + { _offsetOisStrictChain -> + (case (offset_ _offsetOisStrictChain) of + { ( _offsetIbinds,_offsetIcTrf,_offsetIflatExpr,_offsetIisStrictChain,_offsetImbLift) -> + (case (_offsetIisStrictChain) of + { _fldExprOisStrictChain -> + (case (fldExpr_ _fldExprOisStrictChain) of + { ( _fldExprIbinds,_fldExprIcTrf,_fldExprIflatExpr,_fldExprIisStrictChain,_fldExprImbLift) -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup13 -> + (case (__tup13) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup13) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (_exprIisStrictChain) of + { _offsetOisStrictChain -> + (case (offset_ _offsetOisStrictChain) of + { ( _offsetIbinds,_offsetIcTrf,_offsetIflatExpr,_offsetIisStrictChain,_offsetImbLift) -> + (case (_offsetIisStrictChain) of + { _fldExprOisStrictChain -> + (case (fldExpr_ _fldExprOisStrictChain) of + { ( _fldExprIbinds,_fldExprIcTrf,_fldExprIflatExpr,_fldExprIisStrictChain,_fldExprImbLift) -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup14 -> + (case (__tup14) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup14) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIisStrictChain -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup15 -> + (case (__tup15) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup15) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Dbg info_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup16 -> + (case (__tup16) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup16) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIisStrictChain -> + (case (CExpr_Hole uid_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup17 -> + (case (__tup17) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup17) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _bodyOisStrictChain -> + (case (body_ _bodyOisStrictChain) of + { ( _bodyIbinds,_bodyIcTrf,_bodyIflatExpr,_bodyIisStrictChain,_bodyImbLift) -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup18 -> + (case (__tup18) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup18) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIisStrictChain -> + (case (CExpr_CoeArg) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup19 -> + (case (__tup19) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup19) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _funcOisStrictChain -> + (case (func_ _funcOisStrictChain) of + { ( _funcIbinds,_funcIcTrf,_funcIflatExpr,_funcIisStrictChain,_funcImbLift) -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup20 -> + (case (__tup20) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup20) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _bodyOisStrictChain -> + (case (body_ _bodyOisStrictChain) of + { ( _bodyIbinds,_bodyIcTrf,_bodyIflatExpr,_bodyIisStrictChain,_bodyImbLift) -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup21 -> + (case (__tup21) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup21) of + { (_,_lhsOflatExpr) -> + (case (_lhsIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIisStrictChain -> + (case (_lhsIisStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (ann_) of + { ( _annIcTrf) -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf -> + (case ((Seq.empty,_cTrf)) of + { __tup22 -> + (case (__tup22) of + { (_lhsObinds,_) -> + (case (_cTrf) of + { _lhsOcTrf -> + (case (__tup22) of + { (_,_lhsOflatExpr) -> + (case (_exprIisStrictChain) of + { _lhsOisStrictChain -> + (case (Nothing) of + { _lhsOmbLift -> + ( _lhsObinds,_lhsOcTrf,_lhsOflatExpr,_lhsOisStrictChain,_lhsOmbLift) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (CExprAnn_Ty ty_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (CExprAnn_Coe coe_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (CExprAnn_Debug info_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (CMetaBind_Plain) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (CMetaBind_Function0) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (CMetaBind_Function1) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (CMetaBind_Apply0) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (CMetaVal_Val) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (CMetaVal_Dict) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (CMetaVal_DictClass tracks_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (CMetaVal_DictInstance tracks_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (CMetaVal_Track track_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2IcTrf) -> + (case (x1_) of + { ( _x1IcTrf) -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local isStrictChain : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( CModule) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (False) of + { _isStrictChain -> + (case (_isStrictChain) of + { _exprOisStrictChain -> + (case (expr_ _exprOisStrictChain) of + { ( _exprIbinds,_exprIcTrf,_exprIflatExpr,_exprIisStrictChain,_exprImbLift) -> + (case (declMetas_) of + { ( _declMetasIcTrf) -> + (case (imports_) of + { ( _importsIcTrf) -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) }) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CPat + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( CPat) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case (CPat_Var pnm_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIcTrf) -> + (case (rest_) of + { ( _restIcTrf) -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case (CPat_Int int_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case (CPat_Char char_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case (CPat_BoolExpr cexpr_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CPatFld + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local isStrictChain : _ + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( CPatFld) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (False) of + { _isStrictChain -> + (case (_isStrictChain) of + { _bindOisStrictChain -> + (case (_isStrictChain) of + { _offsetOisStrictChain -> + (case (fldAnns_) of + { ( _fldAnnsIcTrf) -> + (case (bind_ _bindOisStrictChain) of + { ( _bindIbinds,_bindIcTrf,_bindIisStrictChain) -> + (case (offset_ _offsetOisStrictChain) of + { ( _offsetIbinds,_offsetIcTrf,_offsetIflatExpr,_offsetIisStrictChain,_offsetImbLift) -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CPatFldL + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( CPatFldL) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) -> + (case (hd_) of + { ( _hdIcTrf) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (CPatRest_Var nm_) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (CPatRest_Empty) of + { _cTrf -> + (case (_cTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (module_) of + { ( _moduleIcTrf) -> + (case (_moduleIcTrf) of + { _lhsOcTrf -> + ( _lhsOcTrf) }) }) diff --git a/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs b/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs @@ -0,0 +1,2500 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LetUn) +module UHC.Light.Compiler.Core.Trf.LetUnrec(cmodTrfLetUnrec) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Utils (scc) +import Data.Maybe +import qualified Data.Map as Map +import qualified Data.Set as Set + + + + + + + + + + + +cmodTrfLetUnrec :: CModule -> CModule +cmodTrfLetUnrec cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) Inh_CodeAGItf + in cTrf_Syn_CodeAGItf t + + + +type UseMp = Map.Map HsName [HsName] + +useMpComb :: UseMp -> UseMp -> UseMp +useMpComb = Map.unionWith (++) + + + +type BindMp = Map.Map HsName (CExpr,CMetas) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CAlt + fvS : FvS + useMp : UseMp + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local lev : _ + local cTrf : _ + local fvS : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ([HsName]) -> + Int -> + ( CAlt,FvS,UseMp) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _patOinNmL | _patOinNmL `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (_lev) of + { _patOlev | _patOlev `seq` (True) -> + (case (pat_ _patOinNmL _patOlev) of + { ( _patIcTrf,_patIfldNmL,_patIfvS,_patInmL,_patIuseMp) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.difference` Set.fromList _patInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_patIuseMp `useMpComb` _exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CAltL + fvS : FvS + useMp : UseMp + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ([HsName]) -> + Int -> + ( CAltL,FvS,UseMp) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _tlOinNmL | _tlOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _hdOinNmL | _hdOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOinNmL _tlOlev) of + { ( _tlIcTrf,_tlIfvS,_tlIuseMp) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOinNmL _hdOlev) of + { ( _hdIcTrf,_hdIfvS,_hdIuseMp) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIuseMp `useMpComb` _tlIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIinNmL + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + isGlobal : Bool + lev : Int + synthesized attributes: + bindMp : BindMp + cTrf : CBind + fvS : FvS + fvSMp : FvSMp + nm : HsName + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ([HsName]) -> + Bool -> + Int -> + ( BindMp,CBind,FvS,FvSMp,HsName,([HsName]),UseMp) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev -> + (case (_lhsIinNmL) of + { _bindAspectsOinNmL | _bindAspectsOinNmL `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _bindAspectsOisGlobal | _bindAspectsOisGlobal `seq` (True) -> + (case (bindAspects_ _bindAspectsOinNmL _bindAspectsOisGlobal _bindAspectsOlev _bindAspectsOnm) of + { ( _bindAspectsIbindMp,_bindAspectsIcTrf,_bindAspectsIfvS,_bindAspectsIfvSMp,_bindAspectsInmL,_bindAspectsIuseMp) | True -> + (case (_bindAspectsIbindMp) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (CBind_Bind nm_ _bindAspectsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindAspectsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.singleton nm_ _bindAspectsIfvS) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_bindAspectsIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnm,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CBindAnn + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ([HsName]) -> + Int -> + ( CBindAnn,FvS,([HsName]),UseMp) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CBindAnnL + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ([HsName]) -> + Int -> + ( CBindAnnL,FvS,([HsName]),UseMp) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _tlOinNmL | _tlOinNmL `seq` (True) -> + (case (tl_ _tlOinNmL _tlOlev) of + { ( _tlIcTrf,_tlIfvS,_tlInmL,_tlIuseMp) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _hdOinNmL | _hdOinNmL `seq` (True) -> + (case (hd_ _hdOinNmL _hdOlev) of + { ( _hdIcTrf,_hdIfvS,_hdInmL,_hdIuseMp) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_hdIuseMp `useMpComb` _tlIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIinNmL + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + inNmL : [HsName] + isGlobal : Bool + lev : Int + synthesized attributes: + bindMp : BindMp + cTrf : CBindL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ([HsName]) -> + Bool -> + Int -> + ( BindMp,CBindL,FvS,FvSMp,([HsName]),UseMp) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev -> + (case (_lhsIinNmL) of + { _tlOinNmL | _tlOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _hdOinNmL | _hdOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (tl_ _tlOinNmL _tlOisGlobal _tlOlev) of + { ( _tlIbindMp,_tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL,_tlIuseMp) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (hd_ _hdOinNmL _hdOisGlobal _hdOlev) of + { ( _hdIbindMp,_hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInm,_hdInmL,_hdIuseMp) | True -> + (case (_hdIbindMp `Map.union` _tlIbindMp) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_hdIuseMp `useMpComb` _tlIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + inNmL : [HsName] + isGlobal : Bool + lev : Int + nm : HsName + synthesized attributes: + bindMp : BindMp + cTrf : CBound + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = ([HsName]) -> + Bool -> + Int -> + HsName -> + ( BindMp,CBound,FvS,FvSMp,([HsName]),UseMp) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsInm : _lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _bindMetaOinNmL | _bindMetaOinNmL `seq` (True) -> + (case (bindMeta_ _bindMetaOinNmL _bindMetaOlev) of + { ( _bindMetaIcTrf,_bindMetaIfvS,_bindMetaIuseMp) | True -> + (case (_lhsInm `Map.singleton` (_exprIcTrf,_bindMetaIcTrf)) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindMetaIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((_lhsInm `Map.singleton` []) `useMpComb` _exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _cmetasOinNmL | _cmetasOinNmL `seq` (True) -> + (case (cmetas_ _cmetasOinNmL _cmetasOlev) of + { ( _cmetasIcTrf,_cmetasIfvS,_cmetasIuseMp) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_cmetasIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_cmetasIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + isGlobal : Bool + lev : Int + nm : HsName + synthesized attributes: + bindMp : BindMp + cTrf : CBoundL + fvS : FvS + fvSMp : FvSMp + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = ([HsName]) -> + Bool -> + Int -> + HsName -> + ( BindMp,CBoundL,FvS,FvSMp,([HsName]),UseMp) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (_lhsIinNmL) of + { _tlOinNmL | _tlOinNmL `seq` (True) -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (_lhsIinNmL) of + { _hdOinNmL | _hdOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _tlOisGlobal | _tlOisGlobal `seq` (True) -> + (case (tl_ _tlOinNmL _tlOisGlobal _tlOlev _tlOnm) of + { ( _tlIbindMp,_tlIcTrf,_tlIfvS,_tlIfvSMp,_tlInmL,_tlIuseMp) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIisGlobal) of + { _hdOisGlobal | _hdOisGlobal `seq` (True) -> + (case (hd_ _hdOinNmL _hdOisGlobal _hdOlev _hdOnm) of + { ( _hdIbindMp,_hdIcTrf,_hdIfvS,_hdIfvSMp,_hdInmL,_hdIuseMp) | True -> + (case (_hdIbindMp `Map.union` _tlIbindMp) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdIfvSMp `Map.union` _tlIfvSMp) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_hdIuseMp `useMpComb` _tlIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIinNmL + _lhsIisGlobal + _lhsIlev + _lhsInm -> + (case (Map.empty) of + { _lhsObindMp | _lhsObindMp `seq` (True) -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOfvSMp | _lhsOfvSMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsObindMp,_lhsOcTrf,_lhsOfvS,_lhsOfvSMp,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CExpr + fvS : FvS + useMp : UseMp + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local cTrf : _ + local nm : {HsName} + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local isGlobal : _ + local _tup1 : _ + local cTrf : _ + local fvS : _ + local remUseMp : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local isGlobal : _ + local cTrf : _ + local fvS : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local lev : _ + local isGlobal : _ + local cTrf : _ + local argNm : _ + local fvS : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local cTrf : _ + alternative CoeArg: + visit 0: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ([HsName]) -> + Int -> + ( CExpr,FvS,UseMp) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Var ref_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (Set.singleton _nm) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.fromList (zip _lhsIinNmL (repeat [_nm]))) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bodyOinNmL | _bodyOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _bindsOinNmL | _bindsOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOinNmL _bodyOlev) of + { ( _bodyIcTrf,_bodyIfvS,_bodyIuseMp) | True -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindsOisGlobal | _bindsOisGlobal `seq` (True) -> + (case (binds_ _bindsOinNmL _bindsOisGlobal _bindsOlev) of + { ( _bindsIbindMp,_bindsIcTrf,_bindsIfvS,_bindsIfvSMp,_bindsInmL,_bindsIuseMp) | True -> + (case (if categ_ == CBindCateg_Rec + then let h = Map.filterWithKey (\k e -> k `Map.member` _bindsIbindMp) _bindsIuseMp + o = scc . Map.toList $ h + mk c ns b = acoreLet c [ acoreBind1MetasTy n m (acoreTyErr "LetUnrec.CExpr.Let") e | n <- ns, (e,m) <- maybeToList (Map.lookup n _bindsIbindMp) ] b + t = foldr (\bs b + -> case bs of + [n] | n `elem` Map.findWithDefault [] n h + -> mk CBindCateg_Rec bs b + | otherwise -> mk CBindCateg_Plain bs b + _ -> mk CBindCateg_Rec bs b + ) + _bodyIcTrf o + in (_bindsIuseMp `Map.difference` h,t) + else (_bindsIuseMp,CExpr_Let categ_ _bindsIcTrf _bodyIcTrf)) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_,_cTrf) | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ((_bodyIfvS `Set.union` _bindsIfvS) `Set.difference` Set.fromList _bindsInmL) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (__tup1) of + { (_remUseMp,_) | _remUseMp `seq` (True) -> + (case (_remUseMp `useMpComb` _bodyIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _argOinNmL | _argOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _funcOinNmL | _funcOinNmL `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _argOisGlobal | _argOisGlobal `seq` (True) -> + (case (arg_ _argOinNmL _argOisGlobal _argOlev _argOnm) of + { ( _argIbindMp,_argIcTrf,_argIfvS,_argIfvSMp,_argInmL,_argIuseMp) | True -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (func_ _funcOinNmL _funcOlev) of + { ( _funcIcTrf,_funcIfvS,_funcIuseMp) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS `Set.union` _argIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_funcIuseMp `useMpComb` _argIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bodyOinNmL | _bodyOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _bindOinNmL | _bindOinNmL `seq` (True) -> + (case (_lhsIlev + 1) of + { _lev | _lev `seq` (True) -> + (case (_lev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOinNmL _bodyOlev) of + { ( _bodyIcTrf,_bodyIfvS,_bodyIuseMp) | True -> + (case (_lev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (_isGlobal) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (bind_ _bindOinNmL _bindOisGlobal _bindOlev) of + { ( _bindIbindMp,_bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL,_bindIuseMp) | True -> + (case (CExpr_Lam _bindIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (_argNm `Set.delete` _bodyIfvS) of + { _fvS | _fvS `seq` (True) -> + (case (_fvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_bindIuseMp `useMpComb` _bodyIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _dfltOinNmL | _dfltOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _altsOinNmL | _altsOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (dflt_ _dfltOinNmL _dfltOlev) of + { ( _dfltIcTrf,_dfltIfvS,_dfltIuseMp) | True -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (alts_ _altsOinNmL _altsOlev) of + { ( _altsIcTrf,_altsIfvS,_altsIuseMp) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _altsIfvS `Set.union` _dfltIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIuseMp `useMpComb` _altsIuseMp `useMpComb` _dfltIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _errorExprOinNmL | _errorExprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (errorExpr_ _errorExprOinNmL _errorExprOlev) of + { ( _errorExprIcTrf,_errorExprIfvS,_errorExprIuseMp) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_errorExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_errorExprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _offsetOinNmL | _offsetOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOinNmL _offsetOlev) of + { ( _offsetIcTrf,_offsetIfvS,_offsetIuseMp) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIuseMp `useMpComb` _offsetIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _fldExprOinNmL | _fldExprOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _offsetOinNmL | _offsetOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (fldExpr_ _fldExprOinNmL _fldExprOlev) of + { ( _fldExprIcTrf,_fldExprIfvS,_fldExprIuseMp) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOinNmL _offsetOlev) of + { ( _offsetIcTrf,_offsetIfvS,_offsetIuseMp) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIuseMp `useMpComb` _offsetIuseMp `useMpComb` _fldExprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _fldExprOinNmL | _fldExprOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _offsetOinNmL | _offsetOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (fldExpr_ _fldExprOinNmL _fldExprOlev) of + { ( _fldExprIcTrf,_fldExprIfvS,_fldExprIuseMp) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOinNmL _offsetOlev) of + { ( _offsetIcTrf,_offsetIfvS,_offsetIuseMp) | True -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS `Set.union` _offsetIfvS `Set.union` _fldExprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIuseMp `useMpComb` _offsetIuseMp `useMpComb` _fldExprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bodyOinNmL | _bodyOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOinNmL _bodyOlev) of + { ( _bodyIcTrf,_bodyIfvS,_bodyIuseMp) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_bodyIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _funcOinNmL | _funcOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (func_ _funcOinNmL _funcOlev) of + { ( _funcIcTrf,_funcIfvS,_funcIuseMp) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_funcIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_funcIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bodyOinNmL | _bodyOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (body_ _bodyOinNmL _bodyOlev) of + { ( _bodyIcTrf,_bodyIfvS,_bodyIuseMp) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bodyIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_bodyIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _annOinNmL | _annOinNmL `seq` (True) -> + (case (ann_ _annOinNmL _annOlev) of + { ( _annIcTrf,_annIfvS,_annIuseMp) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_annIfvS `Set.union` _exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_annIuseMp `useMpComb` _exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CExprAnn + fvS : FvS + useMp : UseMp + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ([HsName]) -> + Int -> + ( CExprAnn,FvS,UseMp) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CMetaBind + fvS : FvS + useMp : UseMp + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ([HsName]) -> + Int -> + ( CMetaBind,FvS,UseMp) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CMetaVal + fvS : FvS + useMp : UseMp + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ([HsName]) -> + Int -> + ( CMetaVal,FvS,UseMp) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CMetas + fvS : FvS + useMp : UseMp + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ([HsName]) -> + Int -> + ( CMetas,FvS,UseMp) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (_lhsIinNmL) of + { _x2OinNmL | _x2OinNmL `seq` (True) -> + (case (x2_ _x2OinNmL _x2Olev) of + { ( _x2IcTrf,_x2IfvS,_x2IuseMp) | True -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (_lhsIinNmL) of + { _x1OinNmL | _x1OinNmL `seq` (True) -> + (case (x1_ _x1OinNmL _x1Olev) of + { ( _x1IcTrf,_x1IfvS,_x1IuseMp) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_x1IfvS `Set.union` _x2IfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_x1IuseMp `useMpComb` _x2IuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CModule + fvS : FvS + useMp : UseMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ([HsName]) -> + Int -> + ( CModule,FvS,UseMp) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _exprOinNmL | _exprOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (expr_ _exprOinNmL _exprOlev) of + { ( _exprIcTrf,_exprIfvS,_exprIuseMp) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_exprIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOuseMp) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ([HsName]) -> + Int -> + ( CPat,([HsName]),FvS,([HsName]),UseMp) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPat_Var pnm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) })) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bindsOinNmL | _bindsOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (binds_ _bindsOinNmL _bindsOlev) of + { ( _bindsIcTrf,_bindsIfldNmL,_bindsIfvS,_bindsInmL,_bindsIuseMp) | True -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _restOinNmL | _restOinNmL `seq` (True) -> + (case (rest_ _restOinNmL _restOlev) of + { ( _restIcTrf,_restIfvS,_restInmL,_restIuseMp) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_restIfvS `Set.union` _bindsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_restIuseMp `useMpComb` _bindsIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) })) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) })) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) })) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local cTrf : _ + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ([HsName]) -> + Int -> + ( CPatFld,([HsName]),FvS,([HsName]),UseMp) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _bindOinNmL | _bindOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _offsetOinNmL | _offsetOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (_lhsIinNmL) of + { _fldAnnsOinNmL | _fldAnnsOinNmL `seq` (True) -> + (case (fldAnns_ _fldAnnsOinNmL _fldAnnsOlev) of + { ( _fldAnnsIcTrf,_fldAnnsIfvS,_fldAnnsInmL,_fldAnnsIuseMp) | True -> + (case (_lhsIlev) of + { _bindOlev | _bindOlev `seq` (True) -> + (case (False) of + { _bindOisGlobal | _bindOisGlobal `seq` (True) -> + (case (bind_ _bindOinNmL _bindOisGlobal _bindOlev) of + { ( _bindIbindMp,_bindIcTrf,_bindIfvS,_bindIfvSMp,_bindInm,_bindInmL,_bindIuseMp) | True -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (offset_ _offsetOinNmL _offsetOlev) of + { ( _offsetIcTrf,_offsetIfvS,_offsetIuseMp) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_offsetIfvS `Set.union` _bindIfvS `Set.union` _fldAnnsIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_offsetIuseMp `useMpComb` _bindIuseMp `useMpComb` _fldAnnsIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ([HsName]) -> + Int -> + ( CPatFldL,([HsName]),FvS,([HsName]),UseMp) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (_lhsIinNmL) of + { _tlOinNmL | _tlOinNmL `seq` (True) -> + (case (_lhsIinNmL) of + { _hdOinNmL | _hdOinNmL `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (tl_ _tlOinNmL _tlOlev) of + { ( _tlIcTrf,_tlIfldNmL,_tlIfvS,_tlInmL,_tlIuseMp) | True -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (hd_ _hdOinNmL _hdOlev) of + { ( _hdIcTrf,_hdIfldNmL,_hdIfvS,_hdInmL,_hdIuseMp) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (_hdIfvS `Set.union` _tlIfvS) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_hdIuseMp `useMpComb` _tlIuseMp) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIinNmL + _lhsIlev -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) }) })) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + inNmL : [HsName] + lev : Int + synthesized attributes: + cTrf : CPatRest + fvS : FvS + nmL : [HsName] + useMp : UseMp + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ([HsName]) -> + Int -> + ( CPatRest,FvS,([HsName]),UseMp) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPatRest_Var nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) })) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIinNmL + _lhsIlev -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (Set.empty) of + { _lhsOfvS | _lhsOfvS `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (Map.empty) of + { _lhsOuseMp | _lhsOuseMp `seq` (True) -> + ( _lhsOcTrf,_lhsOfvS,_lhsOnmL,_lhsOuseMp) }) }) }) }) })) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOcTrf) | True = sem + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case ([]) of + { _moduleOinNmL | _moduleOinNmL `seq` (True) -> + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (module_ _moduleOinNmL _moduleOlev) of + { ( _moduleIcTrf,_moduleIfvS,_moduleIuseMp) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) diff --git a/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs b/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs @@ -0,0 +1,3896 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/Optim) +module UHC.Light.Compiler.Core.Trf.OptimizeStrictness(cmodTrfOptimizeStrictness) where + +import Data.Maybe +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.List +import Data.Maybe +import UHC.Util.Utils +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Base.Debug +import UHC.Light.Compiler.Base.HsName.Builtin + + + + + + + + + + + + + + + +cmodTrfOptimizeStrictness + :: EHCOpts + -> LamMp + -> CModule + -> ( CModule + , LamMp + ) +cmodTrfOptimizeStrictness + opts + lamMp + cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf + { opts_Inh_CodeAGItf = opts + , lamMp_Inh_CodeAGItf = lamMp + }) + in ( cTrf_Syn_CodeAGItf t + , gathLamMp_Syn_CodeAGItf t + ) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + anaEvalCtxt : AnaEval + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = AnaEval -> + LamMp -> + EHCOpts -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CAlt + _patOlamMp :: LamMp + _patOopts :: EHCOpts + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _patIcTrf :: CPat + _patIfldNmL :: ([HsName]) + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 121, column 17) + _lamArgAnaEvalL = + [] + -- self rule + _cTrf = + CAlt_Alt _patIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _patOlamMp = + _lhsIlamMp + -- copy rule (down) + _patOopts = + _lhsIopts + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _patIcTrf,_patIfldNmL) = + pat_ _patOlamMp _patOopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsOcTrf))) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + anaEvalCtxt : AnaEval + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = AnaEval -> + LamMp -> + EHCOpts -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CAltL + _hdOanaEvalCtxt :: AnaEval + _hdOlamMp :: LamMp + _hdOopts :: EHCOpts + _tlOanaEvalCtxt :: AnaEval + _tlOlamMp :: LamMp + _tlOopts :: EHCOpts + _hdIcTrf :: CAlt + _tlIcTrf :: CAltL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _tlOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOopts = + _lhsIopts + ( _hdIcTrf) = + hd_ _hdOanaEvalCtxt _hdOlamMp _hdOopts + ( _tlIcTrf) = + tl_ _tlOanaEvalCtxt _tlOlamMp _tlOopts + in ( _lhsOcTrf))) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CAltL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cTrf : CBind + nm : HsName + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL + visit 0: + local mbStrictArgsRes : _ + local cTrf : _ +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = LamMp -> + EHCOpts -> + ( LamMp,CBind,HsName) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _bindAspectsOnm :: HsName + _lhsOnm :: HsName + _lhsOcTrf :: CBind + _lhsObindLamMp :: LamMp + _bindAspectsOlamMp :: LamMp + _bindAspectsOmbStrictArgsRes :: (Maybe (RelevTy,[AnaEval],AnaEval)) + _bindAspectsOopts :: EHCOpts + _bindAspectsIbindLamMp :: LamMp + _bindAspectsIcTrf :: CBoundL + _bindAspectsIcTrfBoundL :: ([CBound]) + _bindAspectsIgathStrictTyL :: ([RelevTy]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 4, column 17) + _bindAspectsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 12, column 17) + _lhsOnm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 102, column 17) + _mbStrictArgsRes = + case _bindAspectsIgathStrictTyL of + [t@(RelevTy_Fun _ _ _ a r)] + -> Just (t, map relevtyAnaEval a, relevtyAnaEval r) + _ -> Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 153, column 17) + _lhsOcTrf = + CBind_Bind nm_ _bindAspectsIcTrfBoundL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _bindAspectsIbindLamMp + -- self rule + _cTrf = + CBind_Bind nm_ _bindAspectsIcTrf + -- copy rule (down) + _bindAspectsOlamMp = + _lhsIlamMp + -- copy rule (from local) + _bindAspectsOmbStrictArgsRes = + _mbStrictArgsRes + -- copy rule (down) + _bindAspectsOopts = + _lhsIopts + ( _bindAspectsIbindLamMp,_bindAspectsIcTrf,_bindAspectsIcTrfBoundL,_bindAspectsIgathStrictTyL) = + bindAspects_ _bindAspectsOlamMp _bindAspectsOmbStrictArgsRes _bindAspectsOnm _bindAspectsOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOnm))) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnn + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = LamMp -> + EHCOpts -> + ( CBindAnn) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CBindAnn + -- self rule + _cTrf = + CBindAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CBindAnnL + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = LamMp -> + EHCOpts -> + ( CBindAnnL) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CBindAnnL + _hdOlamMp :: LamMp + _hdOopts :: EHCOpts + _tlOlamMp :: LamMp + _tlOopts :: EHCOpts + _hdIcTrf :: CBindAnn + _tlIcTrf :: CBindAnnL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOopts = + _lhsIopts + ( _hdIcTrf) = + hd_ _hdOlamMp _hdOopts + ( _tlIcTrf) = + tl_ _tlOlamMp _tlOopts + in ( _lhsOcTrf))) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CBindAnnL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = LamMp -> + EHCOpts -> + ( LamMp,CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsObindLamMp :: LamMp + _lhsOcTrf :: CBindL + _hdOlamMp :: LamMp + _hdOopts :: EHCOpts + _tlOlamMp :: LamMp + _tlOopts :: EHCOpts + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBind + _hdInm :: HsName + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOopts = + _lhsIopts + ( _hdIbindLamMp,_hdIcTrf,_hdInm) = + hd_ _hdOlamMp _hdOopts + ( _tlIbindLamMp,_tlIcTrf) = + tl_ _tlOlamMp _tlOopts + in ( _lhsObindLamMp,_lhsOcTrf))) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsObindLamMp :: LamMp + _lhsOcTrf :: CBindL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindLamMp,_lhsOcTrf))) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + anaEvalCtxt : AnaEval + lamMp : LamMp + mbStrictArgsRes : Maybe (RelevTy,[AnaEval],AnaEval) + nm : HsName + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cTrf : CBound + cTrfBoundL : [CBound] + gathStrictTyL : [RelevTy] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 0: + local doWorkerWrapper : _ + local wrapper : _ + local worker : _ + local oldbinding : _ + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 0: + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 0: + local anaEvalCtxt : {AnaEval} + local gathStrictTyL : _ + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 0: + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 0: + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 0: + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = AnaEval -> + LamMp -> + (Maybe (RelevTy,[AnaEval],AnaEval)) -> + HsName -> + EHCOpts -> + ( LamMp,CBound,([CBound]),([RelevTy])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOanaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + _bindMetaOlamMp :: LamMp + _bindMetaOopts :: EHCOpts + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _bindMetaIcTrf :: CMetas + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 111, column 17) + _doWorkerWrapper = + isJust _lhsImbStrictArgsRes + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 116, column 17) + (_exprOlamArgAnaEvalL,_exprOanaEvalCtxt) = + maybe ([],top) tup123to23 _lhsImbStrictArgsRes + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 131, column 17) + _wrapper = + case (_exprImbLam,_lhsImbStrictArgsRes) of + (Just as, Just (_,evs,_)) + -> [ CBound_Val acbaspkeyNone 0 CLbl_None + $ acoreLam wrapperArgs + $ (\b -> foldr ($) b bodyWrappers) + $ acoreApp (CExpr_Var (ACoreBindRef _lhsInm (Just acbaspkeyStrict))) + $ map acoreVar workerArgs + ] + where (wrapperArgs,workerArgs,bodyWrappers) = unzip3 $ zipWith mk as evs + mk a AnaEval_WHNF = (a, a', acoreLet1Strict a' (acoreVar a)) + where a' = hsnUniqify HsNameUniqifier_Evaluated a + mk a _ = (a, a , id ) + _ -> [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 131, column 17) + _worker = + if _doWorkerWrapper then [CBound_Val acbaspkeyStrict 0 CLbl_None _exprIcTrf] else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 131, column 17) + _oldbinding = + if _doWorkerWrapper then [] else [_cTrf] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 146, column 17) + _lhsOcTrfBoundL = + _worker ++ _wrapper ++ _oldbinding + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + CBound_Bind _bindMetaIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindMetaOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindMetaOopts = + _lhsIopts + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _bindMetaIcTrf) = + bindMeta_ _bindMetaOlamMp _bindMetaOopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + _cmetasOlamMp :: LamMp + _cmetasOopts :: EHCOpts + _cmetasIcTrf :: CMetas + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 81, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 118, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 150, column 17) + _lhsOcTrfBoundL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + CBound_Meta aspectKeyS_ _cmetasIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _cmetasOlamMp = + _lhsIlamMp + -- copy rule (down) + _cmetasOopts = + _lhsIopts + ( _cmetasIcTrf) = + cmetas_ _cmetasOlamMp _cmetasOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 81, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 95, column 17) + _gathStrictTyL = + if aspectKeyS_ == acbaspkeyStrict + then [relevTy_] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 118, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 150, column 17) + _lhsOcTrfBoundL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + _gathStrictTyL + -- self rule + _cTrf = + CBound_RelevTy aspectKeyS_ relevTy_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 81, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 118, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 150, column 17) + _lhsOcTrfBoundL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (from local) + _exprOanaEvalCtxt = + _anaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 81, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 118, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 150, column 17) + _lhsOcTrfBoundL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + CBound_Ty aspectKeyS_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIanaEvalCtxt + _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrfBoundL :: ([CBound]) + _lhsObindLamMp :: LamMp + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBound + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 81, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 118, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 147, column 17) + _lhsOcTrfBoundL = + [_cTrf] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + CBound_FFE callconv_ expEnt_ _exprIcTrf ty_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (from local) + _exprOanaEvalCtxt = + _anaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + mbStrictArgsRes : Maybe (RelevTy,[AnaEval],AnaEval) + nm : HsName + opts : EHCOpts + synthesized attributes: + bindLamMp : LamMp + cTrf : CBoundL + cTrfBoundL : [CBound] + gathStrictTyL : [RelevTy] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 0: + local anaEvalCtxt : {AnaEval} + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = LamMp -> + (Maybe (RelevTy,[AnaEval],AnaEval)) -> + HsName -> + EHCOpts -> + ( LamMp,CBoundL,([CBound]),([RelevTy])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsObindLamMp :: LamMp + _lhsOcTrfBoundL :: ([CBound]) + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBoundL + _hdOanaEvalCtxt :: AnaEval + _hdOlamMp :: LamMp + _hdOmbStrictArgsRes :: (Maybe (RelevTy,[AnaEval],AnaEval)) + _hdOnm :: HsName + _hdOopts :: EHCOpts + _tlOlamMp :: LamMp + _tlOmbStrictArgsRes :: (Maybe (RelevTy,[AnaEval],AnaEval)) + _tlOnm :: HsName + _tlOopts :: EHCOpts + _hdIbindLamMp :: LamMp + _hdIcTrf :: CBound + _hdIcTrfBoundL :: ([CBound]) + _hdIgathStrictTyL :: ([RelevTy]) + _tlIbindLamMp :: LamMp + _tlIcTrf :: CBoundL + _tlIcTrfBoundL :: ([CBound]) + _tlIgathStrictTyL :: ([RelevTy]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 78, column 17) + _anaEvalCtxt = + top + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + _hdIbindLamMp `lamMpUnionBindAspMp` _tlIbindLamMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 128, column 32) + _lhsOcTrfBoundL = + _hdIcTrfBoundL ++ _tlIcTrfBoundL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + _hdIgathStrictTyL ++ _tlIgathStrictTyL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (from local) + _hdOanaEvalCtxt = + _anaEvalCtxt + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOmbStrictArgsRes = + _lhsImbStrictArgsRes + -- copy rule (down) + _hdOnm = + _lhsInm + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOmbStrictArgsRes = + _lhsImbStrictArgsRes + -- copy rule (down) + _tlOnm = + _lhsInm + -- copy rule (down) + _tlOopts = + _lhsIopts + ( _hdIbindLamMp,_hdIcTrf,_hdIcTrfBoundL,_hdIgathStrictTyL) = + hd_ _hdOanaEvalCtxt _hdOlamMp _hdOmbStrictArgsRes _hdOnm _hdOopts + ( _tlIbindLamMp,_tlIcTrf,_tlIcTrfBoundL,_tlIgathStrictTyL) = + tl_ _tlOlamMp _tlOmbStrictArgsRes _tlOnm _tlOopts + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIlamMp + _lhsImbStrictArgsRes + _lhsInm + _lhsIopts -> + (let _lhsObindLamMp :: LamMp + _lhsOcTrfBoundL :: ([CBound]) + _lhsOgathStrictTyL :: ([RelevTy]) + _lhsOcTrf :: CBoundL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 11, column 30) + _lhsObindLamMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 128, column 32) + _lhsOcTrfBoundL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 92, column 35) + _lhsOgathStrictTyL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsObindLamMp,_lhsOcTrf,_lhsOcTrfBoundL,_lhsOgathStrictTyL))) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (let _lhsOcTrf :: CDataCon + -- self rule + _cTrf = + CDataCon_Con conNm_ tagNr_ arity_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDataConL + _hdIcTrf :: CDataCon + _tlIcTrf :: CDataConL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (let _lhsOcTrf :: CDataConL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (let _lhsOcTrf :: CDeclMeta + _dataConsIcTrf :: CDataConL + -- self rule + _cTrf = + CDeclMeta_Data tyNm_ _dataConsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _dataConsIcTrf) = + dataCons_ + in ( _lhsOcTrf)) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (let _lhsOcTrf :: CDeclMetaL + _hdIcTrf :: CDeclMeta + _tlIcTrf :: CDeclMetaL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (let _lhsOcTrf :: CDeclMetaL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + anaEvalCtxt : AnaEval + lamArgAnaEvalL : [AnaEval] + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + appArgAnaEvalL : [AnaEval] + appFunKind : AppFunKind + appResAnaEval : AnaEval + cTrf : CExpr + gathLamMp : LamMp + mbLam : Maybe [HsName] + mbVar : Maybe HsName + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local mbVar : {Maybe HsName} + local nm : {HsName} + local nmAsp : {HsName} + local lamArgAnaEvalL : _ + local strictRef : _ + local mbStrict : _ + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative String: + child str : {String} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative App: + child func : CExpr + child arg : CBound + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + local argAnaEval : _ + local cTrf : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Dbg: + child info : {String} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative CoeArg: + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 0: + local lamArgAnaEvalL : _ + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 0: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = AnaEval -> + ([AnaEval]) -> + LamMp -> + EHCOpts -> + ( ([AnaEval]),AppFunKind,AnaEval,CExpr,LamMp,(Maybe [HsName]),(Maybe HsName)) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _mbVar :: (Maybe HsName) + _nm :: HsName + _nmAsp :: HsName + _lhsOgathLamMp :: LamMp + _lhsOcTrf :: CExpr + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOmbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 13, column 17) + _lhsOappFunKind = + AppFunKind_Fun ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 21, column 17) + _mbVar = + Just _nm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nm = + acbrefNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 15, column 17) + _nmAsp = + mkHNm ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 156, column 17) + _strictRef = + acbrefAspAnd acbaspkeyStrict ref_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 156, column 17) + _mbStrict = + case fmap libindaspRelevTy $ lamMpLookupAsp2 _strictRef _lhsIlamMp of + Just (t@(RelevTy_Fun _ _ _ a r)) + -> Just (t, map relevtyAnaEval a, relevtyAnaEval r) + _ -> Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 163, column 17) + _lhsOcTrf = + CExpr_Var $ maybe ref_ (const _strictRef) _mbStrict + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 169, column 17) + (_lhsOappArgAnaEvalL,_lhsOappResAnaEval) = + maybe ([],top) tup123to23 _mbStrict + -- self rule + _cTrf = + CExpr_Var ref_ + -- copy rule (from local) + _lhsOmbVar = + _mbVar + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_String str_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Integer integer_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 11, column 17) + _lhsOappFunKind = + AppFunKind_Tag tag_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Tup tag_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _bindsOlamMp :: LamMp + _bindsOopts :: EHCOpts + _bodyOanaEvalCtxt :: AnaEval + _bodyOlamArgAnaEvalL :: ([AnaEval]) + _bodyOlamMp :: LamMp + _bodyOopts :: EHCOpts + _bindsIbindLamMp :: LamMp + _bindsIcTrf :: CBindL + _bodyIappArgAnaEvalL :: ([AnaEval]) + _bodyIappFunKind :: AppFunKind + _bodyIappResAnaEval :: AnaEval + _bodyIcTrf :: CExpr + _bodyIgathLamMp :: LamMp + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 7, column 17) + _lhsOgathLamMp = + _bindsIbindLamMp `Map.union` _bodyIgathLamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Let categ_ _bindsIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindsOopts = + _lhsIopts + -- copy rule (down) + _bodyOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _bodyOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOopts = + _lhsIopts + ( _bindsIbindLamMp,_bindsIcTrf) = + binds_ _bindsOlamMp _bindsOopts + ( _bodyIappArgAnaEvalL,_bodyIappFunKind,_bodyIappResAnaEval,_bodyIcTrf,_bodyIgathLamMp,_bodyImbLam,_bodyImbVar) = + body_ _bodyOanaEvalCtxt _bodyOlamArgAnaEvalL _bodyOlamMp _bodyOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _argOnm :: HsName + _lhsOgathLamMp :: LamMp + _argOmbStrictArgsRes :: (Maybe (RelevTy,[AnaEval],AnaEval)) + _argOanaEvalCtxt :: AnaEval + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOcTrf :: CExpr + _lhsOappResAnaEval :: AnaEval + _funcOanaEvalCtxt :: AnaEval + _funcOlamArgAnaEvalL :: ([AnaEval]) + _funcOlamMp :: LamMp + _funcOopts :: EHCOpts + _argOlamMp :: LamMp + _argOopts :: EHCOpts + _funcIappArgAnaEvalL :: ([AnaEval]) + _funcIappFunKind :: AppFunKind + _funcIappResAnaEval :: AnaEval + _funcIcTrf :: CExpr + _funcIgathLamMp :: LamMp + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + _argIbindLamMp :: LamMp + _argIcTrf :: CBound + _argIcTrfBoundL :: ([CBound]) + _argIgathStrictTyL :: ([RelevTy]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 14, column 17) + _lhsOappFunKind = + _funcIappFunKind + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 7, column 17) + _argOnm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 108, column 25) + _argOmbStrictArgsRes = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 171, column 17) + (_argOanaEvalCtxt,_lhsOappArgAnaEvalL) = + hdAndTl' top _funcIappArgAnaEvalL + -- self rule + _cTrf = + CExpr_App _funcIcTrf _argIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappResAnaEval = + _funcIappResAnaEval + -- copy rule (down) + _funcOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _funcOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOopts = + _lhsIopts + -- copy rule (down) + _argOlamMp = + _lhsIlamMp + -- copy rule (down) + _argOopts = + _lhsIopts + ( _funcIappArgAnaEvalL,_funcIappFunKind,_funcIappResAnaEval,_funcIcTrf,_funcIgathLamMp,_funcImbLam,_funcImbVar) = + func_ _funcOanaEvalCtxt _funcOlamArgAnaEvalL _funcOlamMp _funcOopts + ( _argIbindLamMp,_argIcTrf,_argIcTrfBoundL,_argIgathStrictTyL) = + arg_ _argOanaEvalCtxt _argOlamMp _argOmbStrictArgsRes _argOnm _argOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _bodyOlamMp :: LamMp + _bodyOlamArgAnaEvalL :: ([AnaEval]) + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _bindOlamMp :: LamMp + _bindOopts :: EHCOpts + _bodyOanaEvalCtxt :: AnaEval + _bodyOopts :: EHCOpts + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindInm :: HsName + _bodyIappArgAnaEvalL :: ([AnaEval]) + _bodyIappFunKind :: AppFunKind + _bodyIappResAnaEval :: AnaEval + _bodyIcTrf :: CExpr + _bodyIgathLamMp :: LamMp + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 4, column 17) + _lhsOmbLam = + Just $ maybe [_argNm] (_argNm:) _bodyImbLam + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 19, column 17) + _argNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonLamInfo.ag"(line 7, column 17) + _bodyOlamMp = + Map.delete _argNm _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 124, column 17) + (_argAnaEval,_bodyOlamArgAnaEvalL) = + hdAndTl' top _lhsIlamArgAnaEvalL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Lam _bindIcTrf _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (down) + _bodyOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (down) + _bodyOopts = + _lhsIopts + ( _bindIbindLamMp,_bindIcTrf,_bindInm) = + bind_ _bindOlamMp _bindOopts + ( _bodyIappArgAnaEvalL,_bodyIappFunKind,_bodyIappResAnaEval,_bodyIcTrf,_bodyIgathLamMp,_bodyImbLam,_bodyImbVar) = + body_ _bodyOanaEvalCtxt _bodyOlamArgAnaEvalL _bodyOlamMp _bodyOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _altsOanaEvalCtxt :: AnaEval + _altsOlamMp :: LamMp + _altsOopts :: EHCOpts + _dfltOanaEvalCtxt :: AnaEval + _dfltOlamArgAnaEvalL :: ([AnaEval]) + _dfltOlamMp :: LamMp + _dfltOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _altsIcTrf :: CAltL + _dfltIappArgAnaEvalL :: ([AnaEval]) + _dfltIappFunKind :: AppFunKind + _dfltIappResAnaEval :: AnaEval + _dfltIcTrf :: CExpr + _dfltIgathLamMp :: LamMp + _dfltImbLam :: (Maybe [HsName]) + _dfltImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _altsOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (down) + _altsOlamMp = + _lhsIlamMp + -- copy rule (down) + _altsOopts = + _lhsIopts + -- copy rule (down) + _dfltOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _dfltOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _dfltOlamMp = + _lhsIlamMp + -- copy rule (down) + _dfltOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + ( _altsIcTrf) = + alts_ _altsOanaEvalCtxt _altsOlamMp _altsOopts + ( _dfltIappArgAnaEvalL,_dfltIappFunKind,_dfltIappResAnaEval,_dfltIcTrf,_dfltIgathLamMp,_dfltImbLam,_dfltImbVar) = + dflt_ _dfltOanaEvalCtxt _dfltOlamArgAnaEvalL _dfltOlamMp _dfltOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _lhsOappFunKind :: AppFunKind + _lhsOgathLamMp :: LamMp + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _errorExprOanaEvalCtxt :: AnaEval + _errorExprOlamArgAnaEvalL :: ([AnaEval]) + _errorExprOlamMp :: LamMp + _errorExprOopts :: EHCOpts + _errorExprIappArgAnaEvalL :: ([AnaEval]) + _errorExprIappFunKind :: AppFunKind + _errorExprIappResAnaEval :: AnaEval + _errorExprIcTrf :: CExpr + _errorExprIgathLamMp :: LamMp + _errorExprImbLam :: (Maybe [HsName]) + _errorExprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_CaseAltFail failReason_ _errorExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappFunKind = + _errorExprIappFunKind + -- copy rule (up) + _lhsOgathLamMp = + _errorExprIgathLamMp + -- copy rule (up) + _lhsOmbLam = + _errorExprImbLam + -- copy rule (up) + _lhsOmbVar = + _errorExprImbVar + -- copy rule (down) + _errorExprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _errorExprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _errorExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _errorExprOopts = + _lhsIopts + ( _errorExprIappArgAnaEvalL,_errorExprIappFunKind,_errorExprIappResAnaEval,_errorExprIcTrf,_errorExprIgathLamMp,_errorExprImbLam,_errorExprImbVar) = + errorExpr_ _errorExprOanaEvalCtxt _errorExprOlamArgAnaEvalL _errorExprOlamMp _errorExprOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _offsetOanaEvalCtxt :: AnaEval + _offsetOlamArgAnaEvalL :: ([AnaEval]) + _offsetOlamMp :: LamMp + _offsetOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _offsetIappArgAnaEvalL :: ([AnaEval]) + _offsetIappFunKind :: AppFunKind + _offsetIappResAnaEval :: AnaEval + _offsetIcTrf :: CExpr + _offsetIgathLamMp :: LamMp + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _offsetOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _offsetOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + ( _offsetIappArgAnaEvalL,_offsetIappFunKind,_offsetIappResAnaEval,_offsetIcTrf,_offsetIgathLamMp,_offsetImbLam,_offsetImbVar) = + offset_ _offsetOanaEvalCtxt _offsetOlamArgAnaEvalL _offsetOlamMp _offsetOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _offsetOanaEvalCtxt :: AnaEval + _offsetOlamArgAnaEvalL :: ([AnaEval]) + _offsetOlamMp :: LamMp + _offsetOopts :: EHCOpts + _fldExprOanaEvalCtxt :: AnaEval + _fldExprOlamArgAnaEvalL :: ([AnaEval]) + _fldExprOlamMp :: LamMp + _fldExprOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _offsetIappArgAnaEvalL :: ([AnaEval]) + _offsetIappFunKind :: AppFunKind + _offsetIappResAnaEval :: AnaEval + _offsetIcTrf :: CExpr + _offsetIgathLamMp :: LamMp + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _fldExprIappArgAnaEvalL :: ([AnaEval]) + _fldExprIappFunKind :: AppFunKind + _fldExprIappResAnaEval :: AnaEval + _fldExprIcTrf :: CExpr + _fldExprIgathLamMp :: LamMp + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _offsetOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _offsetOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (down) + _fldExprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _fldExprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + ( _offsetIappArgAnaEvalL,_offsetIappFunKind,_offsetIappResAnaEval,_offsetIcTrf,_offsetIgathLamMp,_offsetImbLam,_offsetImbVar) = + offset_ _offsetOanaEvalCtxt _offsetOlamArgAnaEvalL _offsetOlamMp _offsetOopts + ( _fldExprIappArgAnaEvalL,_fldExprIappFunKind,_fldExprIappResAnaEval,_fldExprIcTrf,_fldExprIgathLamMp,_fldExprImbLam,_fldExprImbVar) = + fldExpr_ _fldExprOanaEvalCtxt _fldExprOlamArgAnaEvalL _fldExprOlamMp _fldExprOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _offsetOanaEvalCtxt :: AnaEval + _offsetOlamArgAnaEvalL :: ([AnaEval]) + _offsetOlamMp :: LamMp + _offsetOopts :: EHCOpts + _fldExprOanaEvalCtxt :: AnaEval + _fldExprOlamArgAnaEvalL :: ([AnaEval]) + _fldExprOlamMp :: LamMp + _fldExprOopts :: EHCOpts + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + _offsetIappArgAnaEvalL :: ([AnaEval]) + _offsetIappFunKind :: AppFunKind + _offsetIappResAnaEval :: AnaEval + _offsetIcTrf :: CExpr + _offsetIgathLamMp :: LamMp + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _fldExprIappArgAnaEvalL :: ([AnaEval]) + _fldExprIappFunKind :: AppFunKind + _fldExprIappResAnaEval :: AnaEval + _fldExprIcTrf :: CExpr + _fldExprIgathLamMp :: LamMp + _fldExprImbLam :: (Maybe [HsName]) + _fldExprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + -- copy rule (down) + _offsetOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _offsetOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (down) + _fldExprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _fldExprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _fldExprOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldExprOopts = + _lhsIopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + ( _offsetIappArgAnaEvalL,_offsetIappFunKind,_offsetIappResAnaEval,_offsetIcTrf,_offsetIgathLamMp,_offsetImbLam,_offsetImbVar) = + offset_ _offsetOanaEvalCtxt _offsetOlamArgAnaEvalL _offsetOlamMp _offsetOopts + ( _fldExprIappArgAnaEvalL,_fldExprIappFunKind,_fldExprIappResAnaEval,_fldExprIcTrf,_fldExprIgathLamMp,_fldExprImbLam,_fldExprImbVar) = + fldExpr_ _fldExprOanaEvalCtxt _fldExprOlamArgAnaEvalL _fldExprOlamMp _fldExprOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 12, column 17) + _lhsOappFunKind = + AppFunKind_FFI + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_FFI callconv_ safety_ impEnt_ ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Dbg info_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_Hole uid_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _bodyOanaEvalCtxt :: AnaEval + _bodyOlamArgAnaEvalL :: ([AnaEval]) + _bodyOlamMp :: LamMp + _bodyOopts :: EHCOpts + _bodyIappArgAnaEvalL :: ([AnaEval]) + _bodyIappFunKind :: AppFunKind + _bodyIappResAnaEval :: AnaEval + _bodyIcTrf :: CExpr + _bodyIgathLamMp :: LamMp + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_HoleLet bindsUid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bodyOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _bodyOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOopts = + _lhsIopts + ( _bodyIappArgAnaEvalL,_bodyIappFunKind,_bodyIappResAnaEval,_bodyIcTrf,_bodyIgathLamMp,_bodyImbLam,_bodyImbVar) = + body_ _bodyOanaEvalCtxt _bodyOlamArgAnaEvalL _bodyOlamMp _bodyOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_CoeArg + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _funcOanaEvalCtxt :: AnaEval + _funcOlamArgAnaEvalL :: ([AnaEval]) + _funcOlamMp :: LamMp + _funcOopts :: EHCOpts + _funcIappArgAnaEvalL :: ([AnaEval]) + _funcIappFunKind :: AppFunKind + _funcIappResAnaEval :: AnaEval + _funcIcTrf :: CExpr + _funcIgathLamMp :: LamMp + _funcImbLam :: (Maybe [HsName]) + _funcImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_ImplsApp _funcIcTrf uid_ + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _funcOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _funcOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _funcOlamMp = + _lhsIlamMp + -- copy rule (down) + _funcOopts = + _lhsIopts + ( _funcIappArgAnaEvalL,_funcIappFunKind,_funcIappResAnaEval,_funcIcTrf,_funcIgathLamMp,_funcImbLam,_funcImbVar) = + func_ _funcOanaEvalCtxt _funcOlamArgAnaEvalL _funcOlamMp _funcOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOmbLam :: (Maybe [HsName]) + _lhsOappFunKind :: AppFunKind + _lhsOmbVar :: (Maybe HsName) + _lhsOgathLamMp :: LamMp + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappResAnaEval :: AnaEval + _lhsOcTrf :: CExpr + _bodyOanaEvalCtxt :: AnaEval + _bodyOlamArgAnaEvalL :: ([AnaEval]) + _bodyOlamMp :: LamMp + _bodyOopts :: EHCOpts + _bodyIappArgAnaEvalL :: ([AnaEval]) + _bodyIappFunKind :: AppFunKind + _bodyIappResAnaEval :: AnaEval + _bodyIcTrf :: CExpr + _bodyIgathLamMp :: LamMp + _bodyImbLam :: (Maybe [HsName]) + _bodyImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 6, column 33) + _lhsOmbLam = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 16, column 17) + _lhsOappFunKind = + AppFunKind_NoApp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonPred.ag"(line 24, column 33) + _lhsOmbVar = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 9, column 33) + _lhsOgathLamMp = + Map.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 126, column 17) + _lamArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappArgAnaEvalL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 174, column 17) + _lhsOappResAnaEval = + top + -- self rule + _cTrf = + CExpr_ImplsLam uid_ _bodyIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _bodyOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (from local) + _bodyOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _bodyOlamMp = + _lhsIlamMp + -- copy rule (down) + _bodyOopts = + _lhsIopts + ( _bodyIappArgAnaEvalL,_bodyIappFunKind,_bodyIappResAnaEval,_bodyIcTrf,_bodyIgathLamMp,_bodyImbLam,_bodyImbVar) = + body_ _bodyOanaEvalCtxt _bodyOlamArgAnaEvalL _bodyOlamMp _bodyOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIanaEvalCtxt + _lhsIlamArgAnaEvalL + _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CExpr + _lhsOappArgAnaEvalL :: ([AnaEval]) + _lhsOappFunKind :: AppFunKind + _lhsOappResAnaEval :: AnaEval + _lhsOgathLamMp :: LamMp + _lhsOmbLam :: (Maybe [HsName]) + _lhsOmbVar :: (Maybe HsName) + _annOlamMp :: LamMp + _annOopts :: EHCOpts + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _annIcTrf :: CExprAnn + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- self rule + _cTrf = + CExpr_Ann _annIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOappArgAnaEvalL = + _exprIappArgAnaEvalL + -- copy rule (up) + _lhsOappFunKind = + _exprIappFunKind + -- copy rule (up) + _lhsOappResAnaEval = + _exprIappResAnaEval + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (up) + _lhsOmbLam = + _exprImbLam + -- copy rule (up) + _lhsOmbVar = + _exprImbVar + -- copy rule (down) + _annOlamMp = + _lhsIlamMp + -- copy rule (down) + _annOopts = + _lhsIopts + -- copy rule (down) + _exprOanaEvalCtxt = + _lhsIanaEvalCtxt + -- copy rule (down) + _exprOlamArgAnaEvalL = + _lhsIlamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _annIcTrf) = + ann_ _annOlamMp _annOopts + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsOappArgAnaEvalL,_lhsOappFunKind,_lhsOappResAnaEval,_lhsOcTrf,_lhsOgathLamMp,_lhsOmbLam,_lhsOmbVar))) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 0: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 0: + local cTrf : _ + alternative Debug: + child info : {String} + visit 0: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = LamMp -> + EHCOpts -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CExprAnn + -- self rule + _cTrf = + CExprAnn_Ty ty_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CExprAnn + -- self rule + _cTrf = + CExprAnn_Coe coe_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CExprAnn + -- self rule + _cTrf = + CExprAnn_Debug info_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (let _lhsOcTrf :: CImport + -- self rule + _cTrf = + CImport_Import nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (let _lhsOcTrf :: CImportL + _hdIcTrf :: CImport + _tlIcTrf :: CImportL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + ( _hdIcTrf) = + hd_ + ( _tlIcTrf) = + tl_ + in ( _lhsOcTrf)) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (let _lhsOcTrf :: CImportL + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf)) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 0: + local cTrf : _ + alternative Function0: + visit 0: + local cTrf : _ + alternative Function1: + visit 0: + local cTrf : _ + alternative Apply0: + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = LamMp -> + EHCOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaBind + -- self rule + _cTrf = + CMetaBind_Plain + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaBind + -- self rule + _cTrf = + CMetaBind_Function0 + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaBind + -- self rule + _cTrf = + CMetaBind_Function1 + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaBind + -- self rule + _cTrf = + CMetaBind_Apply0 + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 0: + local cTrf : _ + alternative Dict: + visit 0: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 0: + local cTrf : _ + alternative Track: + child track : {Track} + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = LamMp -> + EHCOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaVal + -- self rule + _cTrf = + CMetaVal_Val + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaVal + -- self rule + _cTrf = + CMetaVal_Dict + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaVal + -- self rule + _cTrf = + CMetaVal_DictClass tracks_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaVal + -- self rule + _cTrf = + CMetaVal_DictInstance tracks_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetaVal + -- self rule + _cTrf = + CMetaVal_Track track_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CMetas ------------------------------------------------------ +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 0: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = LamMp -> + EHCOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CMetas + _x1OlamMp :: LamMp + _x1Oopts :: EHCOpts + _x2OlamMp :: LamMp + _x2Oopts :: EHCOpts + _x1IcTrf :: CMetaBind + _x2IcTrf :: CMetaVal + -- self rule + _cTrf = + (_x1IcTrf,_x2IcTrf) + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _x1OlamMp = + _lhsIlamMp + -- copy rule (down) + _x1Oopts = + _lhsIopts + -- copy rule (down) + _x2OlamMp = + _lhsIlamMp + -- copy rule (down) + _x2Oopts = + _lhsIopts + ( _x1IcTrf) = + x1_ _x1OlamMp _x1Oopts + ( _x2IcTrf) = + x2_ _x2OlamMp _x2Oopts + in ( _lhsOcTrf))) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + gathLamMp : LamMp + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = LamMp -> + EHCOpts -> + ( CModule,LamMp) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _anaEvalCtxt :: AnaEval + _lhsOcTrf :: CModule + _lhsOgathLamMp :: LamMp + _exprOanaEvalCtxt :: AnaEval + _exprOlamArgAnaEvalL :: ([AnaEval]) + _exprOlamMp :: LamMp + _exprOopts :: EHCOpts + _importsIcTrf :: CImportL + _declMetasIcTrf :: CDeclMetaL + _exprIappArgAnaEvalL :: ([AnaEval]) + _exprIappFunKind :: AppFunKind + _exprIappResAnaEval :: AnaEval + _exprIcTrf :: CExpr + _exprIgathLamMp :: LamMp + _exprImbLam :: (Maybe [HsName]) + _exprImbVar :: (Maybe HsName) + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 84, column 17) + _anaEvalCtxt = + top + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 121, column 17) + _lamArgAnaEvalL = + [] + -- self rule + _cTrf = + CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (up) + _lhsOgathLamMp = + _exprIgathLamMp + -- copy rule (from local) + _exprOanaEvalCtxt = + _anaEvalCtxt + -- copy rule (from local) + _exprOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _exprOlamMp = + _lhsIlamMp + -- copy rule (down) + _exprOopts = + _lhsIopts + ( _importsIcTrf) = + imports_ + ( _declMetasIcTrf) = + declMetas_ + ( _exprIappArgAnaEvalL,_exprIappFunKind,_exprIappResAnaEval,_exprIcTrf,_exprIgathLamMp,_exprImbLam,_exprImbVar) = + expr_ _exprOanaEvalCtxt _exprOlamArgAnaEvalL _exprOlamMp _exprOopts + in ( _lhsOcTrf,_lhsOgathLamMp))) +-- CPat -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + visit 0: + local cTrf : _ + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 0: + local cTrf : _ + alternative Int: + child int : {Int} + visit 0: + local cTrf : _ + alternative Char: + child char : {Char} + visit 0: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 0: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = LamMp -> + EHCOpts -> + ( CPat,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Var pnm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL))) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + _restOlamMp :: LamMp + _restOopts :: EHCOpts + _bindsOlamMp :: LamMp + _bindsOopts :: EHCOpts + _restIcTrf :: CPatRest + _bindsIcTrf :: CPatFldL + _bindsIfldNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _bindsIfldNmL + -- self rule + _cTrf = + CPat_Con tag_ _restIcTrf _bindsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _restOlamMp = + _lhsIlamMp + -- copy rule (down) + _restOopts = + _lhsIopts + -- copy rule (down) + _bindsOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindsOopts = + _lhsIopts + ( _restIcTrf) = + rest_ _restOlamMp _restOopts + ( _bindsIcTrf,_bindsIfldNmL) = + binds_ _bindsOlamMp _bindsOopts + in ( _lhsOcTrf,_lhsOfldNmL))) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Int int_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL))) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_Char char_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL))) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPat + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + CPat_BoolExpr cexpr_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL))) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + local anaEvalCtxt : {AnaEval} + local lamArgAnaEvalL : _ + local cTrf : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = LamMp -> + EHCOpts -> + ( CPatFld,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _anaEvalCtxt :: AnaEval + _lhsOcTrf :: CPatFld + _offsetOanaEvalCtxt :: AnaEval + _offsetOlamArgAnaEvalL :: ([AnaEval]) + _offsetOlamMp :: LamMp + _offsetOopts :: EHCOpts + _bindOlamMp :: LamMp + _bindOopts :: EHCOpts + _fldAnnsOlamMp :: LamMp + _fldAnnsOopts :: EHCOpts + _offsetIappArgAnaEvalL :: ([AnaEval]) + _offsetIappFunKind :: AppFunKind + _offsetIappResAnaEval :: AnaEval + _offsetIcTrf :: CExpr + _offsetIgathLamMp :: LamMp + _offsetImbLam :: (Maybe [HsName]) + _offsetImbVar :: (Maybe HsName) + _bindIbindLamMp :: LamMp + _bindIcTrf :: CBind + _bindInm :: HsName + _fldAnnsIcTrf :: CBindAnnL + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 23, column 17) + _fldNm = + _bindInm + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 28, column 17) + _lhsOfldNmL = + [_fldNm] + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 87, column 17) + _anaEvalCtxt = + bot + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 121, column 17) + _lamArgAnaEvalL = + [] + -- self rule + _cTrf = + CPatFld_Fld lbl_ _offsetIcTrf _bindIcTrf _fldAnnsIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (from local) + _offsetOanaEvalCtxt = + _anaEvalCtxt + -- copy rule (from local) + _offsetOlamArgAnaEvalL = + _lamArgAnaEvalL + -- copy rule (down) + _offsetOlamMp = + _lhsIlamMp + -- copy rule (down) + _offsetOopts = + _lhsIopts + -- copy rule (down) + _bindOlamMp = + _lhsIlamMp + -- copy rule (down) + _bindOopts = + _lhsIopts + -- copy rule (down) + _fldAnnsOlamMp = + _lhsIlamMp + -- copy rule (down) + _fldAnnsOopts = + _lhsIopts + ( _offsetIappArgAnaEvalL,_offsetIappFunKind,_offsetIappResAnaEval,_offsetIcTrf,_offsetIgathLamMp,_offsetImbLam,_offsetImbVar) = + offset_ _offsetOanaEvalCtxt _offsetOlamArgAnaEvalL _offsetOlamMp _offsetOopts + ( _bindIbindLamMp,_bindIcTrf,_bindInm) = + bind_ _bindOlamMp _bindOopts + ( _fldAnnsIcTrf) = + fldAnns_ _fldAnnsOlamMp _fldAnnsOopts + in ( _lhsOcTrf,_lhsOfldNmL))) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = LamMp -> + EHCOpts -> + ( CPatFldL,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + _hdOlamMp :: LamMp + _hdOopts :: EHCOpts + _tlOlamMp :: LamMp + _tlOopts :: EHCOpts + _hdIcTrf :: CPatFld + _hdIfldNmL :: ([HsName]) + _tlIcTrf :: CPatFldL + _tlIfldNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + _hdIfldNmL ++ _tlIfldNmL + -- self rule + _cTrf = + (:) _hdIcTrf _tlIcTrf + -- self rule + _lhsOcTrf = + _cTrf + -- copy rule (down) + _hdOlamMp = + _lhsIlamMp + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _tlOlamMp = + _lhsIlamMp + -- copy rule (down) + _tlOopts = + _lhsIopts + ( _hdIcTrf,_hdIfldNmL) = + hd_ _hdOlamMp _hdOopts + ( _tlIcTrf,_tlIfldNmL) = + tl_ _tlOlamMp _tlOopts + in ( _lhsOcTrf,_lhsOfldNmL))) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOfldNmL :: ([HsName]) + _lhsOcTrf :: CPatFldL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonBindNm.ag"(line 25, column 41) + _lhsOfldNmL = + [] + -- self rule + _cTrf = + [] + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf,_lhsOfldNmL))) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + visit 0: + local cTrf : _ + alternative Empty: + visit 0: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = LamMp -> + EHCOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CPatRest + -- self rule + _cTrf = + CPatRest_Var nm_ + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (\ _lhsIlamMp + _lhsIopts -> + (let _lhsOcTrf :: CPatRest + -- self rule + _cTrf = + CPatRest_Empty + -- self rule + _lhsOcTrf = + _cTrf + in ( _lhsOcTrf))) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + lamMp : LamMp + opts : EHCOpts + synthesized attributes: + cTrf : CModule + gathLamMp : LamMp + alternatives: + alternative AGItf: + child module : CModule + visit 0: + local gathLamMp : _ + local howUnionGathLamInfo : _ + local howMergeLamInfo : _ +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = LamMp -> + EHCOpts -> + ( CModule,LamMp) +data Inh_CodeAGItf = Inh_CodeAGItf {lamMp_Inh_CodeAGItf :: !(LamMp),opts_Inh_CodeAGItf :: !(EHCOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule),gathLamMp_Syn_CodeAGItf :: !(LamMp)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIlamMp _lhsIopts) = + (let ( _lhsOcTrf,_lhsOgathLamMp) = sem _lhsIlamMp _lhsIopts + in (Syn_CodeAGItf _lhsOcTrf _lhsOgathLamMp)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIlamMp + _lhsIopts -> + (let _moduleOlamMp :: LamMp + _lhsOcTrf :: CModule + _lhsOgathLamMp :: LamMp + _moduleOopts :: EHCOpts + _moduleIcTrf :: CModule + _moduleIgathLamMp :: LamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 15, column 17) + _gathLamMp = + lamMpMergeInto _howMergeLamInfo const _moduleIgathLamMp _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonGathLamInfo.ag"(line 16, column 17) + _moduleOlamMp = + _howUnionGathLamInfo _lhsIlamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 68, column 17) + _howUnionGathLamInfo = + Map.union _gathLamMp + -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 72, column 17) + _howMergeLamInfo = + (\(LamInfo {laminfoBindAspMp=m}) i -> i {laminfoBindAspMp = m `Map.union` laminfoBindAspMp i}) + -- copy rule (up) + _lhsOcTrf = + _moduleIcTrf + -- copy rule (from local) + _lhsOgathLamMp = + _gathLamMp + -- copy rule (down) + _moduleOopts = + _lhsIopts + ( _moduleIcTrf,_moduleIgathLamMp) = + module_ _moduleOlamMp _moduleOopts + in ( _lhsOcTrf,_lhsOgathLamMp))) diff --git a/src/UHC/Light/Compiler/Core/Trf/RenUniq.hs b/src/UHC/Light/Compiler/Core/Trf/RenUniq.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Trf/RenUniq.hs @@ -0,0 +1,3997 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/RenUn) +module UHC.Light.Compiler.Core.Trf.RenUniq(RenUniqOpts (..), emptyRenUniqOpts +, cmodTrfRenUniq) where + +import Data.Maybe +import Data.Char +import Control.Monad (liftM) +import qualified Data.Map as Map +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty + + + + + + + + + + + + + +data RenUniqOpts + = RenUniqOpts + { renuniqOptResetOnlyInLam :: Bool -- restart numbering in lambda only, throwing away all name modifiers previously added + } + +emptyRenUniqOpts :: RenUniqOpts +emptyRenUniqOpts = RenUniqOpts False + + + +cmodTrfRenUniq :: RenUniqOpts -> CModule -> CModule +cmodTrfRenUniq ropts cmod + = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) + (Inh_CodeAGItf { gIniq_Inh_CodeAGItf = 1 + -- , gUniq_Inh_CodeAGItf = uidStart + , ropts_Inh_CodeAGItf = ropts + }) + in cTrf_Syn_CodeAGItf t + + + +newIniq :: Int -> Int -> (Int,[Int]) +newIniq nr seed = (seed+nr, [seed .. seed + nr -1]) + + + +type NmMp = Map.Map HsName HsName +type ARenMp + = ( NmMp -- forward map, from old -> new + , NmMp -- backward map, from new -> old + ) + +emptyARenMp :: ARenMp +emptyARenMp = (Map.empty, Map.empty) + + + +-- breaks assumption that globals are qualified, locals not. Problem in future when records are used for globals and access differs. +mkUniqGlob :: NmMp -> HsName -> HsName -> Maybe Int -> (HsName,NmMp) +mkUniqGlob mb q n mbU + = ( + (if hsnIsQual n + then id + else hsnSetQual q + ) $ + maybe n (\u -> hsnUniqifyInt HsNameUniqifier_GloballyUnique u n) mbU + , mb + ) + + + +-- breaks assumption that globals are qualified, locals not. Problem in future when records are used for globals and access differs. +mkUniqLoc :: NmMp -> HsName -> HsName -> Maybe Int -> (HsName,NmMp) +mkUniqLoc mb q n mbU + = ( -- tr "mkUniqLoc" (n >#< n2 >#< n3 >#< n5) $ + n5 + , Map.insert n5 n mb + ) + where n2 = hsnStripUniqifiers $ hsnQualified n + n3 = case hsnBaseUnpack n2 of + Just ('_':_, _) -> mkHNm "_" + _ -> n2 + n5 | Map.member n3 mb = hsnUniqifyInt HsNameUniqifier_Blank (panicJust "RenUniq.mkUniqLoc" mbU) $ hsnStripUniqifiers n3 + | otherwise = n3 + -- where mbExists@(~(Just n4)) = Map.lookup n3 mb + + + +aRenAdd :: RenUniqOpts -> Bool -> HsName -> [HsName] -> [Int] -> ARenMp -> ARenMp +aRenAdd ropts isGlob q nL uL mfb@(mf,mb) + = foldr (\(n,u) (mf,mb) -> let (n',mb') = mkNm mb n u in (Map.insert n n' mf,mb')) mfb $ zip nL uL + where mkNm mb n u + | doChng && isUnqualifiedGlob + = mkUniq mb q n Nothing + | doChng = mkUniq mb q n (Just u) + | otherwise = (n,mb) + where doChng + = isChangeable + || isUnqualifiedGlob + isUnqualifiedGlob = isGlob && not onlyLam && isNothing (hsnQualifier n) && n /= hsnMain + isChangeable = not isGlob || n `Map.member` mf + onlyLam = renuniqOptResetOnlyInLam ropts + mkUniq | onlyLam = mkUniqLoc + | otherwise = mkUniqGlob + + + +aRenRepl :: ARenMp -> HsName -> HsName +aRenRepl (mf,_) n = maybe n id . Map.lookup n $ mf + +-- CAlt -------------------------------------------------------- +{- + visit 0: + inherited attributes: + protectedBindingNames : [HsName] + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attribute: + cTrf : CAlt + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr + visit 0: + local _tup1 : _ + visit 1: + local lIniq : _ + local aRenMp : _ + local cTrf : _ + intra _tup1 : _ +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = Int -> + ([HsName]) -> + RenUniqOpts -> + ( Int,T_CAlt_1) +type T_CAlt_1 = ARenMp -> + Int -> + HsName -> + ( CAlt) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _patOropts | _patOropts `seq` (True) -> + (case (pat_) of + { ( _patInmL,pat_1) | True -> + (case (newIniq (length _patInmL) _lhsIgIniq) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_patOgIniq,_) | _patOgIniq `seq` (True) -> + (case (pat_1 _patOgIniq _patOropts) of + { ( _patIgIniq,pat_2) | True -> + (case (_patIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CAlt_Alt_1 :: T_CAlt_1 + sem_CAlt_Alt_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev + 1) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (__tup1) of + { (_,_lIniq) | _lIniq `seq` (True) -> + (case (aRenAdd _lhsIropts False + _lhsImoduleNm + _patInmL _lIniq _lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patOmoduleNm | _patOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _patOlev | _patOlev `seq` (True) -> + (case (_aRenMp) of + { _patOaRenMp | _patOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (pat_2 _patOaRenMp _patOlev _patOmoduleNm) of + { ( _patIcTrf,_patIfldNmL) | True -> + (case (CAlt_Alt _patIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CAlt_Alt_1)) of + { ( sem_CAlt_1) | True -> + ( _lhsOgIniq,sem_CAlt_1) }) }) }) }) }) }) }) }) }) }) })) +-- CAltL ------------------------------------------------------- +{- + visit 0: + inherited attributes: + protectedBindingNames : [HsName] + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attribute: + cTrf : CAltL + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + visit 1: + local cTrf : _ + alternative Nil: + visit 1: + local cTrf : _ +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = Int -> + ([HsName]) -> + RenUniqOpts -> + ( Int,T_CAltL_1) +type T_CAltL_1 = ARenMp -> + Int -> + HsName -> + ( CAltL) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _tlOropts | _tlOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _tlOprotectedBindingNames | _tlOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _hdOropts | _hdOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _hdOprotectedBindingNames | _hdOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _hdOgIniq | _hdOgIniq `seq` (True) -> + (case (hd_ _hdOgIniq _hdOprotectedBindingNames _hdOropts) of + { ( _hdIgIniq,hd_1) | True -> + (case (_hdIgIniq) of + { _tlOgIniq | _tlOgIniq `seq` (True) -> + (case (tl_ _tlOgIniq _tlOprotectedBindingNames _tlOropts) of + { ( _tlIgIniq,tl_1) | True -> + (case (_tlIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CAltL_Cons_1 :: T_CAltL_1 + sem_CAltL_Cons_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _tlOaRenMp | _tlOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _hdOaRenMp | _hdOaRenMp `seq` (True) -> + (case (tl_1 _tlOaRenMp _tlOlev _tlOmoduleNm) of + { ( _tlIcTrf) | True -> + (case (hd_1 _hdOaRenMp _hdOlev _hdOmoduleNm) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) })) + in sem_CAltL_Cons_1)) of + { ( sem_CAltL_1) | True -> + ( _lhsOgIniq,sem_CAltL_1) }) }) }) }) }) }) }) }) }) })) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CAltL_Nil_1 :: T_CAltL_1 + sem_CAltL_Nil_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CAltL_Nil_1)) of + { ( sem_CAltL_1) | True -> + ( _lhsOgIniq,sem_CAltL_1) }) })) +-- CBind ------------------------------------------------------- +{- + visit 0: + inherited attribute: + protectedBindingNames : [HsName] + synthesized attributes: + nm : HsName + nmL : [HsName] + visit 1: + inherited attribute: + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attribute: + cTrf : CBind + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ([HsName]) -> + ( HsName,([HsName]),T_CBind_1) +type T_CBind_1 = Int -> + RenUniqOpts -> + ( Int,T_CBind_2) +type T_CBind_2 = ARenMp -> + Int -> + HsName -> + ( CBind) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (\ _lhsIprotectedBindingNames -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case (if nm_ `elem` _lhsIprotectedBindingNames + then [] + else [nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CBind_Bind_1 :: T_CBind_1 + sem_CBind_Bind_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _bindAspectsOropts | _bindAspectsOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bindAspectsOprotectedBindingNames | _bindAspectsOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _bindAspectsOgIniq | _bindAspectsOgIniq `seq` (True) -> + (case (bindAspects_ _bindAspectsOgIniq _bindAspectsOprotectedBindingNames _bindAspectsOropts) of + { ( _bindAspectsIgIniq,bindAspects_1) | True -> + (case (_bindAspectsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBind_Bind_2 :: T_CBind_2 + sem_CBind_Bind_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _bindAspectsOmoduleNm | _bindAspectsOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bindAspectsOlev | _bindAspectsOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _bindAspectsOaRenMp | _bindAspectsOaRenMp `seq` (True) -> + (case (nm_) of + { _bindAspectsOnm | _bindAspectsOnm `seq` (True) -> + (case (bindAspects_1 _bindAspectsOaRenMp _bindAspectsOlev _bindAspectsOmoduleNm _bindAspectsOnm) of + { ( _bindAspectsIcTrf,_bindAspectsInmL) | True -> + (case (CBind_Bind (aRenRepl _lhsIaRenMp nm_) _bindAspectsIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) + in sem_CBind_Bind_2)) of + { ( sem_CBind_2) | True -> + ( _lhsOgIniq,sem_CBind_2) }) }) }) }) }) })) + in sem_CBind_Bind_1)) of + { ( sem_CBind_1) | True -> + ( _lhsOnm,_lhsOnmL,sem_CBind_1) }) }) })) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attributes: + cTrf : CBindAnn + nmL : [HsName] + alternatives: + alternative Coe: + child coe : {RelevCoe} + visit 1: + local cTrf : _ +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = Int -> + ( Int,T_CBindAnn_1) +type T_CBindAnn_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CBindAnn,([HsName])) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBindAnn_Coe_1 :: T_CBindAnn_1 + sem_CBindAnn_Coe_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CBindAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) })) + in sem_CBindAnn_Coe_1)) of + { ( sem_CBindAnn_1) | True -> + ( _lhsOgIniq,sem_CBindAnn_1) }) })) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attributes: + cTrf : CBindAnnL + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + visit 1: + local cTrf : _ + alternative Nil: + visit 1: + local cTrf : _ +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = Int -> + ( Int,T_CBindAnnL_1) +type T_CBindAnnL_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CBindAnnL,([HsName])) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _hdOgIniq | _hdOgIniq `seq` (True) -> + (case (hd_ _hdOgIniq) of + { ( _hdIgIniq,hd_1) | True -> + (case (_hdIgIniq) of + { _tlOgIniq | _tlOgIniq `seq` (True) -> + (case (tl_ _tlOgIniq) of + { ( _tlIgIniq,tl_1) | True -> + (case (_tlIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBindAnnL_Cons_1 :: T_CBindAnnL_1 + sem_CBindAnnL_Cons_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (_lhsIropts) of + { _tlOropts | _tlOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _tlOaRenMp | _tlOaRenMp `seq` (True) -> + (case (tl_1 _tlOaRenMp _tlOlev _tlOmoduleNm _tlOropts) of + { ( _tlIcTrf,_tlInmL) | True -> + (case (_lhsIropts) of + { _hdOropts | _hdOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _hdOaRenMp | _hdOaRenMp `seq` (True) -> + (case (hd_1 _hdOaRenMp _hdOlev _hdOmoduleNm _hdOropts) of + { ( _hdIcTrf,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBindAnnL_Cons_1)) of + { ( sem_CBindAnnL_1) | True -> + ( _lhsOgIniq,sem_CBindAnnL_1) }) }) }) }) }) })) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBindAnnL_Nil_1 :: T_CBindAnnL_1 + sem_CBindAnnL_Nil_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) })) + in sem_CBindAnnL_Nil_1)) of + { ( sem_CBindAnnL_1) | True -> + ( _lhsOgIniq,sem_CBindAnnL_1) }) })) +-- CBindL ------------------------------------------------------ +{- + visit 0: + inherited attribute: + protectedBindingNames : [HsName] + synthesized attribute: + nmL : [HsName] + visit 1: + inherited attribute: + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attribute: + cTrf : CBindL + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + visit 2: + local cTrf : _ + alternative Nil: + visit 2: + local cTrf : _ +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ([HsName]) -> + ( ([HsName]),T_CBindL_1) +type T_CBindL_1 = Int -> + RenUniqOpts -> + ( Int,T_CBindL_2) +type T_CBindL_2 = ARenMp -> + Int -> + HsName -> + ( CBindL) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (\ _lhsIprotectedBindingNames -> + (case (_lhsIprotectedBindingNames) of + { _tlOprotectedBindingNames | _tlOprotectedBindingNames `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _hdOprotectedBindingNames | _hdOprotectedBindingNames `seq` (True) -> + (case (tl_ _tlOprotectedBindingNames) of + { ( _tlInmL,tl_1) | True -> + (case (hd_ _hdOprotectedBindingNames) of + { ( _hdInm,_hdInmL,hd_1) | True -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CBindL_Cons_1 :: T_CBindL_1 + sem_CBindL_Cons_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _tlOropts | _tlOropts `seq` (True) -> + (case (_lhsIropts) of + { _hdOropts | _hdOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _hdOgIniq | _hdOgIniq `seq` (True) -> + (case (hd_1 _hdOgIniq _hdOropts) of + { ( _hdIgIniq,hd_2) | True -> + (case (_hdIgIniq) of + { _tlOgIniq | _tlOgIniq `seq` (True) -> + (case (tl_1 _tlOgIniq _tlOropts) of + { ( _tlIgIniq,tl_2) | True -> + (case (_tlIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBindL_Cons_2 :: T_CBindL_2 + sem_CBindL_Cons_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _tlOaRenMp | _tlOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _hdOaRenMp | _hdOaRenMp `seq` (True) -> + (case (tl_2 _tlOaRenMp _tlOlev _tlOmoduleNm) of + { ( _tlIcTrf) | True -> + (case (hd_2 _hdOaRenMp _hdOlev _hdOmoduleNm) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) })) + in sem_CBindL_Cons_2)) of + { ( sem_CBindL_2) | True -> + ( _lhsOgIniq,sem_CBindL_2) }) }) }) }) }) }) }) })) + in sem_CBindL_Cons_1)) of + { ( sem_CBindL_1) | True -> + ( _lhsOnmL,sem_CBindL_1) }) }) }) }) }) })) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (\ _lhsIprotectedBindingNames -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CBindL_Nil_1 :: T_CBindL_1 + sem_CBindL_Nil_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBindL_Nil_2 :: T_CBindL_2 + sem_CBindL_Nil_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CBindL_Nil_2)) of + { ( sem_CBindL_2) | True -> + ( _lhsOgIniq,sem_CBindL_2) }) })) + in sem_CBindL_Nil_1)) of + { ( sem_CBindL_1) | True -> + ( _lhsOnmL,sem_CBindL_1) }) })) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attributes: + protectedBindingNames : [HsName] + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + nm : HsName + synthesized attributes: + cTrf : CBound + nmL : [HsName] + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + visit 1: + local aRenMp : _ + local cTrf : _ + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + visit 1: + local cTrf : _ + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + visit 1: + local cTrf : _ + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + visit 1: + local aRenMp : _ + local cTrf : _ + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + visit 1: + local cTrf : _ + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} + visit 1: + local aRenMp : _ + local cTrf : _ +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = Int -> + ([HsName]) -> + RenUniqOpts -> + ( Int,T_CBound_1) +type T_CBound_1 = ARenMp -> + Int -> + HsName -> + HsName -> + ( CBound,([HsName])) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _bindMetaOgIniq | _bindMetaOgIniq `seq` (True) -> + (case (bindMeta_ _bindMetaOgIniq) of + { ( _bindMetaIgIniq,_bindMetaIprotectableBindingNames,bindMeta_1) | True -> + (case (_bindMetaIprotectableBindingNames ++ _lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (if renuniqOptResetOnlyInLam _lhsIropts + then 1 + else _lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (if renuniqOptResetOnlyInLam _lhsIropts + then _lhsIgIniq + else _exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_Bind_1 :: T_CBound_1 + sem_CBound_Bind_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (_lhsIropts) of + { _bindMetaOropts | _bindMetaOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _bindMetaOmoduleNm | _bindMetaOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bindMetaOlev | _bindMetaOlev `seq` (True) -> + (case (_aRenMp) of + { _bindMetaOaRenMp | _bindMetaOaRenMp `seq` (True) -> + (case (bindMeta_1 _bindMetaOaRenMp _bindMetaOlev _bindMetaOmoduleNm _bindMetaOropts) of + { ( _bindMetaIcTrf) | True -> + (case (CBound_Bind _bindMetaIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Bind_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) }) }) }) }) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _cmetasOgIniq | _cmetasOgIniq `seq` (True) -> + (case (cmetas_ _cmetasOgIniq) of + { ( _cmetasIgIniq,_cmetasIprotectableBindingNames,cmetas_1) | True -> + (case (_cmetasIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_Meta_1 :: T_CBound_1 + sem_CBound_Meta_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (_lhsIropts) of + { _cmetasOropts | _cmetasOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _cmetasOmoduleNm | _cmetasOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _cmetasOlev | _cmetasOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _cmetasOaRenMp | _cmetasOaRenMp `seq` (True) -> + (case (cmetas_1 _cmetasOaRenMp _cmetasOlev _cmetasOmoduleNm _cmetasOropts) of + { ( _cmetasIcTrf) | True -> + (case (CBound_Meta aspectKeyS_ _cmetasIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) })) + in sem_CBound_Meta_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) }) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 + sem_CBound_RelevTy_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (CBound_RelevTy aspectKeyS_ relevTy_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) })) + in sem_CBound_RelevTy_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (if renuniqOptResetOnlyInLam _lhsIropts + then 1 + else _lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (if renuniqOptResetOnlyInLam _lhsIropts + then _lhsIgIniq + else _exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_Val_1 :: T_CBound_1 + sem_CBound_Val_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CBound_Val aspectKeyS_ mlev_ lbl_ _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_Val_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) }) }) }) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_Ty_1 :: T_CBound_1 + sem_CBound_Ty_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (CBound_Ty aspectKeyS_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) })) + in sem_CBound_Ty_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBound_FFE_1 :: T_CBound_1 + sem_CBound_FFE_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CBound_FFE callconv_ expEnt_ _exprIcTrf ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) }) }) })) + in sem_CBound_FFE_1)) of + { ( sem_CBound_1) | True -> + ( _lhsOgIniq,sem_CBound_1) }) }) }) }) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attributes: + protectedBindingNames : [HsName] + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + nm : HsName + synthesized attributes: + cTrf : CBoundL + nmL : [HsName] + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + visit 1: + local cTrf : _ + alternative Nil: + visit 1: + local cTrf : _ +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = Int -> + ([HsName]) -> + RenUniqOpts -> + ( Int,T_CBoundL_1) +type T_CBoundL_1 = ARenMp -> + Int -> + HsName -> + HsName -> + ( CBoundL,([HsName])) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _tlOropts | _tlOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _tlOprotectedBindingNames | _tlOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _hdOropts | _hdOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _hdOprotectedBindingNames | _hdOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _hdOgIniq | _hdOgIniq `seq` (True) -> + (case (hd_ _hdOgIniq _hdOprotectedBindingNames _hdOropts) of + { ( _hdIgIniq,hd_1) | True -> + (case (_hdIgIniq) of + { _tlOgIniq | _tlOgIniq `seq` (True) -> + (case (tl_ _tlOgIniq _tlOprotectedBindingNames _tlOropts) of + { ( _tlIgIniq,tl_1) | True -> + (case (_tlIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBoundL_Cons_1 :: T_CBoundL_1 + sem_CBoundL_Cons_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _tlOaRenMp | _tlOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _hdOaRenMp | _hdOaRenMp `seq` (True) -> + (case (_lhsInm) of + { _tlOnm | _tlOnm `seq` (True) -> + (case (tl_1 _tlOaRenMp _tlOlev _tlOmoduleNm _tlOnm) of + { ( _tlIcTrf,_tlInmL) | True -> + (case (_lhsInm) of + { _hdOnm | _hdOnm `seq` (True) -> + (case (hd_1 _hdOaRenMp _hdOlev _hdOmoduleNm _hdOnm) of + { ( _hdIcTrf,_hdInmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CBoundL_Cons_1)) of + { ( sem_CBoundL_1) | True -> + ( _lhsOgIniq,sem_CBoundL_1) }) }) }) }) }) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CBoundL_Nil_1 :: T_CBoundL_1 + sem_CBoundL_Nil_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsInm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + ( _lhsOcTrf,_lhsOnmL) }) }) })) + in sem_CBoundL_Nil_1)) of + { ( sem_CBoundL_1) | True -> + ( _lhsOgIniq,sem_CBoundL_1) }) })) +-- CDataCon ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataCon + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( CDataCon) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + (case (CDataCon_Con conNm_ tagNr_ arity_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDataConL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDataConL + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( CDataConL) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CDeclMeta --------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMeta + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( CDeclMeta) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + (case (dataCons_) of + { ( _dataConsIcTrf) | True -> + (case (CDeclMeta_Data tyNm_ _dataConsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) +-- CDeclMetaL -------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CDeclMetaL + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( CDeclMetaL) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CExpr ------------------------------------------------------- +{- + visit 0: + inherited attributes: + protectedBindingNames : [HsName] + ropts : RenUniqOpts + chained attribute: + gIniq : Int + synthesized attribute: + isLamBody : Bool + visit 1: + inherited attributes: + lev : Int + moduleNm : HsName + chained attribute: + accumARenMp : ARenMp + visit 2: + inherited attribute: + aRenMp : ARenMp + synthesized attribute: + cTrf : CExpr + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 2: + local nm : {HsName} + alternative Int: + child int : {Int} + visit 2: + local cTrf : _ + alternative Char: + child char : {Char} + visit 2: + local cTrf : _ + alternative String: + child str : {String} + visit 2: + local cTrf : _ + alternative Integer: + child integer : {Integer} + visit 2: + local cTrf : _ + alternative Tup: + child tag : {CTag} + visit 2: + local cTrf : _ + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local _tup2 : _ + visit 1: + local isGlobal : _ + local lIniq : _ + local addToARenMp : _ + intra _tup2 : _ + visit 2: + local aRenMp : _ + local cTrf : _ + intra addToARenMp : _ + intra isGlobal : _ + alternative App: + child func : CExpr + child arg : CBound + visit 2: + local aRenMp : _ + local cTrf : _ + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local _tup3 : _ + visit 1: + intra _tup3 : _ + visit 2: + local lIniq : _ + local argNm : _ + local aRenMp : _ + intra _tup3 : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + visit 2: + local accumARenMp : _ + local aRenMp : _ + local cTrf : _ + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + visit 2: + local aRenMp : _ + local cTrf : _ + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + visit 2: + local accumARenMp : _ + local aRenMp : _ + local cTrf : _ + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 2: + local accumARenMp : _ + local aRenMp : _ + local cTrf : _ + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + visit 2: + local accumARenMp : _ + local aRenMp : _ + local cTrf : _ + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + visit 2: + local cTrf : _ + alternative Dbg: + child info : {String} + visit 2: + local cTrf : _ + alternative Hole: + child uid : {UID} + visit 2: + local cTrf : _ + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + visit 2: + local aRenMp : _ + local cTrf : _ + alternative CoeArg: + visit 2: + local cTrf : _ + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + visit 2: + local aRenMp : _ + local cTrf : _ + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + visit 2: + local aRenMp : _ + local cTrf : _ + alternative Ann: + child ann : CExprAnn + child expr : CExpr + visit 2: + local cTrf : _ +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = Int -> + ([HsName]) -> + RenUniqOpts -> + ( Int,Bool,T_CExpr_1) +type T_CExpr_1 = ARenMp -> + Int -> + HsName -> + ( ARenMp,T_CExpr_2) +type T_CExpr_2 = ARenMp -> + ( CExpr) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Var_1 :: T_CExpr_1 + sem_CExpr_Var_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Var_2 :: T_CExpr_2 + sem_CExpr_Var_2 = + (\ _lhsIaRenMp -> + (case (acbrefNm ref_) of + { _nm | _nm `seq` (True) -> + (case (acoreVar (aRenRepl _lhsIaRenMp _nm)) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Var_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Var_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Int_1 :: T_CExpr_1 + sem_CExpr_Int_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Int_2 :: T_CExpr_2 + sem_CExpr_Int_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Int_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Int_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Char_1 :: T_CExpr_1 + sem_CExpr_Char_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Char_2 :: T_CExpr_2 + sem_CExpr_Char_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Char_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Char_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_String_1 :: T_CExpr_1 + sem_CExpr_String_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_String_2 :: T_CExpr_2 + sem_CExpr_String_2 = + (\ _lhsIaRenMp -> + (case (CExpr_String str_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_String_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_String_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Integer_1 :: T_CExpr_1 + sem_CExpr_Integer_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Integer_2 :: T_CExpr_2 + sem_CExpr_Integer_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Integer integer_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Integer_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Integer_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Tup_1 :: T_CExpr_1 + sem_CExpr_Tup_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Tup_2 :: T_CExpr_2 + sem_CExpr_Tup_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Tup tag_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Tup_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Tup_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _bodyOropts | _bodyOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bodyOprotectedBindingNames | _bodyOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _bindsOropts | _bindsOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bindsOprotectedBindingNames | _bindsOprotectedBindingNames `seq` (True) -> + (case (binds_ _bindsOprotectedBindingNames) of + { ( _bindsInmL,binds_1) | True -> + (case (newIniq (length _bindsInmL) _lhsIgIniq) of + { __tup2 | __tup2 `seq` (True) -> + (case (__tup2) of + { (_bindsOgIniq,_) | _bindsOgIniq `seq` (True) -> + (case (binds_1 _bindsOgIniq _bindsOropts) of + { ( _bindsIgIniq,binds_2) | True -> + (case (_bindsIgIniq) of + { _bodyOgIniq | _bodyOgIniq `seq` (True) -> + (case (body_ _bodyOgIniq _bodyOprotectedBindingNames _bodyOropts) of + { ( _bodyIgIniq,_bodyIisLamBody,body_1) | True -> + (case (_bodyIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Let_1 :: T_CExpr_1 + sem_CExpr_Let_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _bodyOmoduleNm | _bodyOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (_lhsIlev == cLevModule) of + { _isGlobal | _isGlobal `seq` (True) -> + (case (__tup2) of + { (_,_lIniq) | _lIniq `seq` (True) -> + (case (\m -> aRenAdd _lhsIropts _isGlobal + _lhsImoduleNm + _bindsInmL _lIniq m) of + { _addToARenMp | _addToARenMp `seq` (True) -> + (case (if _isGlobal + then _addToARenMp _lhsIaccumARenMp + else _lhsIaccumARenMp) of + { _bodyOaccumARenMp | _bodyOaccumARenMp `seq` (True) -> + (case (body_1 _bodyOaccumARenMp _bodyOlev _bodyOmoduleNm) of + { ( _bodyIaccumARenMp,body_2) | True -> + (case (_bodyIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Let_2 :: T_CExpr_2 + sem_CExpr_Let_2 = + (\ _lhsIaRenMp -> + (case (if _isGlobal + then _lhsIaRenMp + else _addToARenMp _lhsIaRenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _bodyOaRenMp | _bodyOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _bindsOmoduleNm | _bindsOmoduleNm `seq` (True) -> + (case (_aRenMp) of + { _bindsOaRenMp | _bindsOaRenMp `seq` (True) -> + (case (_lhsIlev + 1) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (body_2 _bodyOaRenMp) of + { ( _bodyIcTrf) | True -> + (case (binds_2 _bindsOaRenMp _bindsOlev _bindsOmoduleNm) of + { ( _bindsIcTrf) | True -> + (case (CExpr_Let categ_ _bindsIcTrf _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Let_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Let_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _argOropts | _argOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _argOprotectedBindingNames | _argOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _funcOropts | _funcOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _funcOprotectedBindingNames | _funcOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _funcOgIniq | _funcOgIniq `seq` (True) -> + (case (func_ _funcOgIniq _funcOprotectedBindingNames _funcOropts) of + { ( _funcIgIniq,_funcIisLamBody,func_1) | True -> + (case (_funcIgIniq) of + { _argOgIniq | _argOgIniq `seq` (True) -> + (case (arg_ _argOgIniq _argOprotectedBindingNames _argOropts) of + { ( _argIgIniq,arg_1) | True -> + (case (_argIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_App_1 :: T_CExpr_1 + sem_CExpr_App_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_App_2 :: T_CExpr_2 + sem_CExpr_App_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _argOmoduleNm | _argOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _argOlev | _argOlev `seq` (True) -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm | _funcOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _funcOaccumARenMp | _funcOaccumARenMp `seq` (True) -> + (case (func_1 _funcOaccumARenMp _funcOlev _funcOmoduleNm) of + { ( _funcIaccumARenMp,func_2) | True -> + (case (_funcIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _argOaRenMp | _argOaRenMp `seq` (True) -> + (case (_aRenMp) of + { _funcOaRenMp | _funcOaRenMp `seq` (True) -> + (case (hsnUnknown) of + { _argOnm | _argOnm `seq` (True) -> + (case (arg_1 _argOaRenMp _argOlev _argOmoduleNm _argOnm) of + { ( _argIcTrf,_argInmL) | True -> + (case (func_2 _funcOaRenMp) of + { ( _funcIcTrf) | True -> + (case (CExpr_App _funcIcTrf _argIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_App_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_App_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _bodyOropts | _bodyOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bodyOprotectedBindingNames | _bodyOprotectedBindingNames `seq` (True) -> + (case (newIniq 1 _lhsIgIniq) of + { __tup3 | __tup3 `seq` (True) -> + (case (__tup3) of + { (_bodyOgIniq,_) | _bodyOgIniq `seq` (True) -> + (case (body_ _bodyOgIniq _bodyOprotectedBindingNames _bodyOropts) of + { ( _bodyIgIniq,_bodyIisLamBody,body_1) | True -> + (case (_bodyIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (False) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Lam_1 :: T_CExpr_1 + sem_CExpr_Lam_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Lam_2 :: T_CExpr_2 + sem_CExpr_Lam_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _bodyOmoduleNm | _bodyOmoduleNm `seq` (True) -> + (case (if _bodyIisLamBody then _lhsIlev + 1 else _lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (__tup3) of + { (_,_lIniq) | _lIniq `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bindOprotectedBindingNames | _bindOprotectedBindingNames `seq` (True) -> + (case (bind_ _bindOprotectedBindingNames) of + { ( _bindInm,_bindInmL,bind_1) | True -> + (case (_bindInm) of + { _argNm | _argNm `seq` (True) -> + (case (aRenAdd _lhsIropts False + _lhsImoduleNm + [_argNm] _lIniq _lhsIaRenMp) of + { _bodyOaccumARenMp | _bodyOaccumARenMp `seq` (True) -> + (case (body_1 _bodyOaccumARenMp _bodyOlev _bodyOmoduleNm) of + { ( _bodyIaccumARenMp,body_2) | True -> + (case (_bodyIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _bodyOaRenMp | _bodyOaRenMp `seq` (True) -> + (case (body_2 _bodyOaRenMp) of + { ( _bodyIcTrf) | True -> + (case (acoreLam1 (aRenRepl _aRenMp _argNm) _bodyIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Lam_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Lam_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) })) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _dfltOropts | _dfltOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _dfltOprotectedBindingNames | _dfltOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _altsOropts | _altsOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _altsOprotectedBindingNames | _altsOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _altsOgIniq | _altsOgIniq `seq` (True) -> + (case (alts_ _altsOgIniq _altsOprotectedBindingNames _altsOropts) of + { ( _altsIgIniq,alts_1) | True -> + (case (_altsIgIniq) of + { _dfltOgIniq | _dfltOgIniq `seq` (True) -> + (case (dflt_ _dfltOgIniq _dfltOprotectedBindingNames _dfltOropts) of + { ( _dfltIgIniq,_dfltIisLamBody,dflt_1) | True -> + (case (_dfltIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Case_1 :: T_CExpr_1 + sem_CExpr_Case_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Case_2 :: T_CExpr_2 + sem_CExpr_Case_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _dfltOmoduleNm | _dfltOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _dfltOlev | _dfltOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _accumARenMp | _accumARenMp `seq` (True) -> + (case (_accumARenMp) of + { _dfltOaccumARenMp | _dfltOaccumARenMp `seq` (True) -> + (case (dflt_1 _dfltOaccumARenMp _dfltOlev _dfltOmoduleNm) of + { ( _dfltIaccumARenMp,dflt_2) | True -> + (case (_dfltIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _dfltOaRenMp | _dfltOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _altsOmoduleNm | _altsOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _altsOlev | _altsOlev `seq` (True) -> + (case (_aRenMp) of + { _altsOaRenMp | _altsOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (dflt_2 _dfltOaRenMp) of + { ( _dfltIcTrf) | True -> + (case (alts_1 _altsOaRenMp _altsOlev _altsOmoduleNm) of + { ( _altsIcTrf) | True -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CExpr_Case _exprIcTrf _altsIcTrf _dfltIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Case_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Case_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _errorExprOropts | _errorExprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _errorExprOprotectedBindingNames | _errorExprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _errorExprOgIniq | _errorExprOgIniq `seq` (True) -> + (case (errorExpr_ _errorExprOgIniq _errorExprOprotectedBindingNames _errorExprOropts) of + { ( _errorExprIgIniq,_errorExprIisLamBody,errorExpr_1) | True -> + (case (_errorExprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_CaseAltFail_1 :: T_CExpr_1 + sem_CExpr_CaseAltFail_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_CaseAltFail_2 :: T_CExpr_2 + sem_CExpr_CaseAltFail_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _errorExprOmoduleNm | _errorExprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _errorExprOlev | _errorExprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _errorExprOaccumARenMp | _errorExprOaccumARenMp `seq` (True) -> + (case (errorExpr_1 _errorExprOaccumARenMp _errorExprOlev _errorExprOmoduleNm) of + { ( _errorExprIaccumARenMp,errorExpr_2) | True -> + (case (_errorExprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _errorExprOaRenMp | _errorExprOaRenMp `seq` (True) -> + (case (errorExpr_2 _errorExprOaRenMp) of + { ( _errorExprIcTrf) | True -> + (case (CExpr_CaseAltFail failReason_ _errorExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_CaseAltFail_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_CaseAltFail_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) })) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _offsetOropts | _offsetOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _offsetOprotectedBindingNames | _offsetOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _offsetOgIniq | _offsetOgIniq `seq` (True) -> + (case (offset_ _offsetOgIniq _offsetOprotectedBindingNames _offsetOropts) of + { ( _offsetIgIniq,_offsetIisLamBody,offset_1) | True -> + (case (_offsetIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_TupDel_1 :: T_CExpr_1 + sem_CExpr_TupDel_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_TupDel_2 :: T_CExpr_2 + sem_CExpr_TupDel_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _offsetOmoduleNm | _offsetOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _accumARenMp | _accumARenMp `seq` (True) -> + (case (_accumARenMp) of + { _offsetOaccumARenMp | _offsetOaccumARenMp `seq` (True) -> + (case (offset_1 _offsetOaccumARenMp _offsetOlev _offsetOmoduleNm) of + { ( _offsetIaccumARenMp,offset_2) | True -> + (case (_offsetIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _offsetOaRenMp | _offsetOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (offset_2 _offsetOaRenMp) of + { ( _offsetIcTrf) | True -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupDel _exprIcTrf tag_ nm_ _offsetIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupDel_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_TupDel_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _fldExprOropts | _fldExprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _fldExprOprotectedBindingNames | _fldExprOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _offsetOropts | _offsetOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _offsetOprotectedBindingNames | _offsetOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _offsetOgIniq | _offsetOgIniq `seq` (True) -> + (case (offset_ _offsetOgIniq _offsetOprotectedBindingNames _offsetOropts) of + { ( _offsetIgIniq,_offsetIisLamBody,offset_1) | True -> + (case (_offsetIgIniq) of + { _fldExprOgIniq | _fldExprOgIniq `seq` (True) -> + (case (fldExpr_ _fldExprOgIniq _fldExprOprotectedBindingNames _fldExprOropts) of + { ( _fldExprIgIniq,_fldExprIisLamBody,fldExpr_1) | True -> + (case (_fldExprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_TupIns_1 :: T_CExpr_1 + sem_CExpr_TupIns_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_TupIns_2 :: T_CExpr_2 + sem_CExpr_TupIns_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _fldExprOmoduleNm | _fldExprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _accumARenMp | _accumARenMp `seq` (True) -> + (case (_accumARenMp) of + { _fldExprOaccumARenMp | _fldExprOaccumARenMp `seq` (True) -> + (case (fldExpr_1 _fldExprOaccumARenMp _fldExprOlev _fldExprOmoduleNm) of + { ( _fldExprIaccumARenMp,fldExpr_2) | True -> + (case (_fldExprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _fldExprOaRenMp | _fldExprOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _offsetOmoduleNm | _offsetOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_accumARenMp) of + { _offsetOaccumARenMp | _offsetOaccumARenMp `seq` (True) -> + (case (_aRenMp) of + { _offsetOaRenMp | _offsetOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (fldExpr_2 _fldExprOaRenMp) of + { ( _fldExprIcTrf) | True -> + (case (offset_1 _offsetOaccumARenMp _offsetOlev _offsetOmoduleNm) of + { ( _offsetIaccumARenMp,offset_2) | True -> + (case (offset_2 _offsetOaRenMp) of + { ( _offsetIcTrf) | True -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupIns _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupIns_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_TupIns_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _fldExprOropts | _fldExprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _fldExprOprotectedBindingNames | _fldExprOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _offsetOropts | _offsetOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _offsetOprotectedBindingNames | _offsetOprotectedBindingNames `seq` (True) -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _offsetOgIniq | _offsetOgIniq `seq` (True) -> + (case (offset_ _offsetOgIniq _offsetOprotectedBindingNames _offsetOropts) of + { ( _offsetIgIniq,_offsetIisLamBody,offset_1) | True -> + (case (_offsetIgIniq) of + { _fldExprOgIniq | _fldExprOgIniq `seq` (True) -> + (case (fldExpr_ _fldExprOgIniq _fldExprOprotectedBindingNames _fldExprOropts) of + { ( _fldExprIgIniq,_fldExprIisLamBody,fldExpr_1) | True -> + (case (_fldExprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_TupUpd_1 :: T_CExpr_1 + sem_CExpr_TupUpd_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_TupUpd_2 :: T_CExpr_2 + sem_CExpr_TupUpd_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _fldExprOmoduleNm | _fldExprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _fldExprOlev | _fldExprOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _accumARenMp | _accumARenMp `seq` (True) -> + (case (_accumARenMp) of + { _fldExprOaccumARenMp | _fldExprOaccumARenMp `seq` (True) -> + (case (fldExpr_1 _fldExprOaccumARenMp _fldExprOlev _fldExprOmoduleNm) of + { ( _fldExprIaccumARenMp,fldExpr_2) | True -> + (case (_fldExprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _fldExprOaRenMp | _fldExprOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _offsetOmoduleNm | _offsetOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_accumARenMp) of + { _offsetOaccumARenMp | _offsetOaccumARenMp `seq` (True) -> + (case (_aRenMp) of + { _offsetOaRenMp | _offsetOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (fldExpr_2 _fldExprOaRenMp) of + { ( _fldExprIcTrf) | True -> + (case (offset_1 _offsetOaccumARenMp _offsetOlev _offsetOmoduleNm) of + { ( _offsetIaccumARenMp,offset_2) | True -> + (case (offset_2 _offsetOaRenMp) of + { ( _offsetIcTrf) | True -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (CExpr_TupUpd _exprIcTrf tag_ nm_ _offsetIcTrf _fldExprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CExpr_TupUpd_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_TupUpd_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_FFI_1 :: T_CExpr_1 + sem_CExpr_FFI_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_FFI_2 :: T_CExpr_2 + sem_CExpr_FFI_2 = + (\ _lhsIaRenMp -> + (case (CExpr_FFI callconv_ safety_ impEnt_ ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_FFI_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_FFI_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Dbg_1 :: T_CExpr_1 + sem_CExpr_Dbg_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Dbg_2 :: T_CExpr_2 + sem_CExpr_Dbg_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Dbg info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Dbg_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Dbg_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Hole_1 :: T_CExpr_1 + sem_CExpr_Hole_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Hole_2 :: T_CExpr_2 + sem_CExpr_Hole_2 = + (\ _lhsIaRenMp -> + (case (CExpr_Hole uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_Hole_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_Hole_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _bodyOropts | _bodyOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bodyOprotectedBindingNames | _bodyOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _bodyOgIniq | _bodyOgIniq `seq` (True) -> + (case (body_ _bodyOgIniq _bodyOprotectedBindingNames _bodyOropts) of + { ( _bodyIgIniq,_bodyIisLamBody,body_1) | True -> + (case (_bodyIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_HoleLet_1 :: T_CExpr_1 + sem_CExpr_HoleLet_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_HoleLet_2 :: T_CExpr_2 + sem_CExpr_HoleLet_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _bodyOmoduleNm | _bodyOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _bodyOaccumARenMp | _bodyOaccumARenMp `seq` (True) -> + (case (body_1 _bodyOaccumARenMp _bodyOlev _bodyOmoduleNm) of + { ( _bodyIaccumARenMp,body_2) | True -> + (case (_bodyIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _bodyOaRenMp | _bodyOaRenMp `seq` (True) -> + (case (body_2 _bodyOaRenMp) of + { ( _bodyIcTrf) | True -> + (case (CExpr_HoleLet bindsUid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_HoleLet_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_HoleLet_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) })) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_CoeArg_1 :: T_CExpr_1 + sem_CExpr_CoeArg_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_CoeArg_2 :: T_CExpr_2 + sem_CExpr_CoeArg_2 = + (\ _lhsIaRenMp -> + (case (CExpr_CoeArg) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExpr_CoeArg_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_CoeArg_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) })) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _funcOropts | _funcOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _funcOprotectedBindingNames | _funcOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _funcOgIniq | _funcOgIniq `seq` (True) -> + (case (func_ _funcOgIniq _funcOprotectedBindingNames _funcOropts) of + { ( _funcIgIniq,_funcIisLamBody,func_1) | True -> + (case (_funcIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_ImplsApp_1 :: T_CExpr_1 + sem_CExpr_ImplsApp_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_ImplsApp_2 :: T_CExpr_2 + sem_CExpr_ImplsApp_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm | _funcOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _funcOlev | _funcOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _funcOaccumARenMp | _funcOaccumARenMp `seq` (True) -> + (case (func_1 _funcOaccumARenMp _funcOlev _funcOmoduleNm) of + { ( _funcIaccumARenMp,func_2) | True -> + (case (_funcIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _funcOaRenMp | _funcOaRenMp `seq` (True) -> + (case (func_2 _funcOaRenMp) of + { ( _funcIcTrf) | True -> + (case (CExpr_ImplsApp _funcIcTrf uid_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsApp_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_ImplsApp_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) })) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _bodyOropts | _bodyOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _bodyOprotectedBindingNames | _bodyOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _bodyOgIniq | _bodyOgIniq `seq` (True) -> + (case (body_ _bodyOgIniq _bodyOprotectedBindingNames _bodyOropts) of + { ( _bodyIgIniq,_bodyIisLamBody,body_1) | True -> + (case (_bodyIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (True) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_ImplsLam_1 :: T_CExpr_1 + sem_CExpr_ImplsLam_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_ImplsLam_2 :: T_CExpr_2 + sem_CExpr_ImplsLam_2 = + (\ _lhsIaRenMp -> + (case (_lhsImoduleNm) of + { _bodyOmoduleNm | _bodyOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bodyOlev | _bodyOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _bodyOaccumARenMp | _bodyOaccumARenMp `seq` (True) -> + (case (body_1 _bodyOaccumARenMp _bodyOlev _bodyOmoduleNm) of + { ( _bodyIaccumARenMp,body_2) | True -> + (case (_bodyIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _bodyOaRenMp | _bodyOaRenMp `seq` (True) -> + (case (body_2 _bodyOaRenMp) of + { ( _bodyIcTrf) | True -> + (case (CExpr_ImplsLam uid_ _bodyIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_ImplsLam_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) })) + in sem_CExpr_ImplsLam_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) })) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (\ _lhsIgIniq + _lhsIprotectedBindingNames + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIprotectedBindingNames) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIgIniq) of + { _annOgIniq | _annOgIniq `seq` (True) -> + (case (ann_ _annOgIniq) of + { ( _annIgIniq,ann_1) | True -> + (case (_annIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (_exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (_exprIisLamBody) of + { _lhsOisLamBody | _lhsOisLamBody `seq` (True) -> + (case ((let sem_CExpr_Ann_1 :: T_CExpr_1 + sem_CExpr_Ann_1 = + (\ _lhsIaccumARenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIaccumARenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _lhsOaccumARenMp | _lhsOaccumARenMp `seq` (True) -> + (case ((let sem_CExpr_Ann_2 :: T_CExpr_2 + sem_CExpr_Ann_2 = + (\ _lhsIaRenMp -> + (case (_lhsIaRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (_lhsIropts) of + { _annOropts | _annOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _annOmoduleNm | _annOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _annOlev | _annOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _annOaRenMp | _annOaRenMp `seq` (True) -> + (case (ann_1 _annOaRenMp _annOlev _annOmoduleNm _annOropts) of + { ( _annIcTrf) | True -> + (case (CExpr_Ann _annIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) })) + in sem_CExpr_Ann_2)) of + { ( sem_CExpr_2) | True -> + ( _lhsOaccumARenMp,sem_CExpr_2) }) }) }) }) }) })) + in sem_CExpr_Ann_1)) of + { ( sem_CExpr_1) | True -> + ( _lhsOgIniq,_lhsOisLamBody,sem_CExpr_1) }) }) }) }) }) }) }) }) })) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attribute: + cTrf : CExprAnn + alternatives: + alternative Ty: + child ty : {Ty} + visit 1: + local cTrf : _ + alternative Coe: + child coe : {RelevCoe} + visit 1: + local cTrf : _ + alternative Debug: + child info : {String} + visit 1: + local cTrf : _ +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = Int -> + ( Int,T_CExprAnn_1) +type T_CExprAnn_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CExprAnn) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CExprAnn_Ty_1 :: T_CExprAnn_1 + sem_CExprAnn_Ty_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CExprAnn_Ty ty_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExprAnn_Ty_1)) of + { ( sem_CExprAnn_1) | True -> + ( _lhsOgIniq,sem_CExprAnn_1) }) })) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1 + sem_CExprAnn_Coe_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CExprAnn_Coe coe_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExprAnn_Coe_1)) of + { ( sem_CExprAnn_1) | True -> + ( _lhsOgIniq,sem_CExprAnn_1) }) })) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CExprAnn_Debug_1 :: T_CExprAnn_1 + sem_CExprAnn_Debug_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CExprAnn_Debug info_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CExprAnn_Debug_1)) of + { ( sem_CExprAnn_1) | True -> + ( _lhsOgIniq,sem_CExprAnn_1) }) })) +-- CImport ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImport + alternatives: + alternative Import: + child nm : {HsName} + visit 0: + local cTrf : _ +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( CImport) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + (case (CImport_Import nm_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CImportL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + cTrf : CImportL + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + visit 0: + local cTrf : _ + alternative Nil: + visit 0: + local cTrf : _ +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( CImportL) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIcTrf) | True -> + (case (hd_) of + { ( _hdIcTrf) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + chained attribute: + gIniq : Int + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attribute: + cTrf : CMetaBind + alternatives: + alternative Plain: + visit 1: + local cTrf : _ + alternative Function0: + visit 1: + local cTrf : _ + alternative Function1: + visit 1: + local cTrf : _ + alternative Apply0: + visit 1: + local cTrf : _ +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = Int -> + ( Int,T_CMetaBind_1) +type T_CMetaBind_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CMetaBind) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CMetaBind_Plain_1 :: T_CMetaBind_1 + sem_CMetaBind_Plain_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaBind_Plain) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaBind_Plain_1)) of + { ( sem_CMetaBind_1) | True -> + ( _lhsOgIniq,sem_CMetaBind_1) }) })) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CMetaBind_Function0_1 :: T_CMetaBind_1 + sem_CMetaBind_Function0_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaBind_Function0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaBind_Function0_1)) of + { ( sem_CMetaBind_1) | True -> + ( _lhsOgIniq,sem_CMetaBind_1) }) })) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CMetaBind_Function1_1 :: T_CMetaBind_1 + sem_CMetaBind_Function1_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaBind_Function1) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaBind_Function1_1)) of + { ( sem_CMetaBind_1) | True -> + ( _lhsOgIniq,sem_CMetaBind_1) }) })) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CMetaBind_Apply0_1 :: T_CMetaBind_1 + sem_CMetaBind_Apply0_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaBind_Apply0) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaBind_Apply0_1)) of + { ( sem_CMetaBind_1) | True -> + ( _lhsOgIniq,sem_CMetaBind_1) }) })) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + chained attribute: + gIniq : Int + synthesized attribute: + protectableBindingNames : [HsName] + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attribute: + cTrf : CMetaVal + alternatives: + alternative Val: + visit 1: + local cTrf : _ + alternative Dict: + visit 1: + local cTrf : _ + alternative DictClass: + child tracks : {[Track]} + visit 1: + local cTrf : _ + alternative DictInstance: + child tracks : {[Track]} + visit 1: + local cTrf : _ + alternative Track: + child track : {Track} + visit 1: + local cTrf : _ +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = Int -> + ( Int,([HsName]),T_CMetaVal_1) +type T_CMetaVal_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CMetaVal) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ([]) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetaVal_Val_1 :: T_CMetaVal_1 + sem_CMetaVal_Val_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaVal_Val) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaVal_Val_1)) of + { ( sem_CMetaVal_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetaVal_1) }) }) })) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ([]) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetaVal_Dict_1 :: T_CMetaVal_1 + sem_CMetaVal_Dict_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaVal_Dict) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaVal_Dict_1)) of + { ( sem_CMetaVal_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetaVal_1) }) }) })) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ([ nm | TrackVarApply nm _ <- tracks_ ]) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetaVal_DictClass_1 :: T_CMetaVal_1 + sem_CMetaVal_DictClass_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaVal_DictClass tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaVal_DictClass_1)) of + { ( sem_CMetaVal_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetaVal_1) }) }) })) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ([ nm | TrackVarApply nm _ <- tracks_ ]) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetaVal_DictInstance_1 :: T_CMetaVal_1 + sem_CMetaVal_DictInstance_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaVal_DictInstance tracks_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaVal_DictInstance_1)) of + { ( sem_CMetaVal_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetaVal_1) }) }) })) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ([]) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetaVal_Track_1 :: T_CMetaVal_1 + sem_CMetaVal_Track_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CMetaVal_Track track_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CMetaVal_Track_1)) of + { ( sem_CMetaVal_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetaVal_1) }) }) })) +-- CMetas ------------------------------------------------------ +{- + visit 0: + chained attribute: + gIniq : Int + synthesized attribute: + protectableBindingNames : [HsName] + visit 1: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attribute: + cTrf : CMetas + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal + visit 1: + local cTrf : _ +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = Int -> + ( Int,([HsName]),T_CMetas_1) +type T_CMetas_1 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CMetas) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _x1OgIniq | _x1OgIniq `seq` (True) -> + (case (x1_ _x1OgIniq) of + { ( _x1IgIniq,x1_1) | True -> + (case (_x1IgIniq) of + { _x2OgIniq | _x2OgIniq `seq` (True) -> + (case (x2_ _x2OgIniq) of + { ( _x2IgIniq,_x2IprotectableBindingNames,x2_1) | True -> + (case (_x2IgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case (_x2IprotectableBindingNames) of + { _lhsOprotectableBindingNames | _lhsOprotectableBindingNames `seq` (True) -> + (case ((let sem_CMetas_Tuple_1 :: T_CMetas_1 + sem_CMetas_Tuple_1 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (_lhsIropts) of + { _x2Oropts | _x2Oropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _x2OmoduleNm | _x2OmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _x2Olev | _x2Olev `seq` (True) -> + (case (_lhsIaRenMp) of + { _x2OaRenMp | _x2OaRenMp `seq` (True) -> + (case (x2_1 _x2OaRenMp _x2Olev _x2OmoduleNm _x2Oropts) of + { ( _x2IcTrf) | True -> + (case (_lhsIropts) of + { _x1Oropts | _x1Oropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _x1OmoduleNm | _x1OmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _x1Olev | _x1Olev `seq` (True) -> + (case (_lhsIaRenMp) of + { _x1OaRenMp | _x1OaRenMp `seq` (True) -> + (case (x1_1 _x1OaRenMp _x1Olev _x1OmoduleNm _x1Oropts) of + { ( _x1IcTrf) | True -> + (case ((_x1IcTrf,_x2IcTrf)) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CMetas_Tuple_1)) of + { ( sem_CMetas_1) | True -> + ( _lhsOgIniq,_lhsOprotectableBindingNames,sem_CMetas_1) }) }) }) }) }) }) })) +-- CModule ----------------------------------------------------- +{- + visit 0: + inherited attributes: + aRenMp : ARenMp + lev : Int + ropts : RenUniqOpts + chained attribute: + gIniq : Int + synthesized attribute: + cTrf : CModule + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr + visit 0: + local aRenMp : _ + local cTrf : _ +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ARenMp -> + Int -> + Int -> + RenUniqOpts -> + ( CModule,Int) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (\ _lhsIaRenMp + _lhsIgIniq + _lhsIlev + _lhsIropts -> + (case (_lhsIropts) of + { _exprOropts | _exprOropts `seq` (True) -> + (case (_lhsIlev) of + { _exprOlev | _exprOlev `seq` (True) -> + (case (_lhsIgIniq) of + { _exprOgIniq | _exprOgIniq `seq` (True) -> + (case ([]) of + { _exprOprotectedBindingNames | _exprOprotectedBindingNames `seq` (True) -> + (case (_lhsIaRenMp) of + { _exprOaccumARenMp | _exprOaccumARenMp `seq` (True) -> + (case (moduleNm_) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (expr_ _exprOgIniq _exprOprotectedBindingNames _exprOropts) of + { ( _exprIgIniq,_exprIisLamBody,expr_1) | True -> + (case (expr_1 _exprOaccumARenMp _exprOlev _exprOmoduleNm) of + { ( _exprIaccumARenMp,expr_2) | True -> + (case (_exprIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _exprOaRenMp | _exprOaRenMp `seq` (True) -> + (case (expr_2 _exprOaRenMp) of + { ( _exprIcTrf) | True -> + (case (declMetas_) of + { ( _declMetasIcTrf) | True -> + (case (imports_) of + { ( _importsIcTrf) | True -> + (case (CModule_Mod moduleNm_ _importsIcTrf _declMetasIcTrf _exprIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_exprIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + ( _lhsOcTrf,_lhsOgIniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + nmL : [HsName] + visit 1: + inherited attribute: + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attributes: + cTrf : CPat + fldNmL : [HsName] + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + visit 2: + local cTrf : _ + alternative Int: + child int : {Int} + visit 2: + local cTrf : _ + alternative Char: + child char : {Char} + visit 2: + local cTrf : _ + alternative BoolExpr: + child cexpr : {CExpr} + visit 2: + local cTrf : _ +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( ([HsName]),T_CPat_1) +type T_CPat_1 = Int -> + RenUniqOpts -> + ( Int,T_CPat_2) +type T_CPat_2 = ARenMp -> + Int -> + HsName -> + ( CPat,([HsName])) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case ([pnm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPat_Var_1 :: T_CPat_1 + sem_CPat_Var_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPat_Var_2 :: T_CPat_2 + sem_CPat_Var_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (CPat_Var (aRenRepl _lhsIaRenMp $ pnm_)) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) })) + in sem_CPat_Var_2)) of + { ( sem_CPat_2) | True -> + ( _lhsOgIniq,sem_CPat_2) }) })) + in sem_CPat_Var_1)) of + { ( sem_CPat_1) | True -> + ( _lhsOnmL,sem_CPat_1) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsInmL,binds_1) | True -> + (case (rest_) of + { ( _restInmL,rest_1) | True -> + (case (_restInmL ++ _bindsInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPat_Con_1 :: T_CPat_1 + sem_CPat_Con_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _bindsOropts | _bindsOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _restOgIniq | _restOgIniq `seq` (True) -> + (case (rest_1 _restOgIniq) of + { ( _restIgIniq,rest_2) | True -> + (case (_restIgIniq) of + { _bindsOgIniq | _bindsOgIniq `seq` (True) -> + (case (binds_1 _bindsOgIniq _bindsOropts) of + { ( _bindsIgIniq,binds_2) | True -> + (case (_bindsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPat_Con_2 :: T_CPat_2 + sem_CPat_Con_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _bindsOmoduleNm | _bindsOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _bindsOlev | _bindsOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _bindsOaRenMp | _bindsOaRenMp `seq` (True) -> + (case (_lhsIaRenMp) of + { _restOaRenMp | _restOaRenMp `seq` (True) -> + (case (binds_2 _bindsOaRenMp _bindsOlev _bindsOmoduleNm) of + { ( _bindsIcTrf,_bindsIfldNmL) | True -> + (case (_lhsIropts) of + { _restOropts | _restOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _restOmoduleNm | _restOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _restOlev | _restOlev `seq` (True) -> + (case (rest_2 _restOaRenMp _restOlev _restOmoduleNm _restOropts) of + { ( _restIcTrf) | True -> + (case (CPat_Con tag_ _restIcTrf _bindsIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPat_Con_2)) of + { ( sem_CPat_2) | True -> + ( _lhsOgIniq,sem_CPat_2) }) }) }) }) }) }) })) + in sem_CPat_Con_1)) of + { ( sem_CPat_1) | True -> + ( _lhsOnmL,sem_CPat_1) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPat_Int_1 :: T_CPat_1 + sem_CPat_Int_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPat_Int_2 :: T_CPat_2 + sem_CPat_Int_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (CPat_Int int_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) + in sem_CPat_Int_2)) of + { ( sem_CPat_2) | True -> + ( _lhsOgIniq,sem_CPat_2) }) })) + in sem_CPat_Int_1)) of + { ( sem_CPat_1) | True -> + ( _lhsOnmL,sem_CPat_1) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPat_Char_1 :: T_CPat_1 + sem_CPat_Char_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPat_Char_2 :: T_CPat_2 + sem_CPat_Char_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (CPat_Char char_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) + in sem_CPat_Char_2)) of + { ( sem_CPat_2) | True -> + ( _lhsOgIniq,sem_CPat_2) }) })) + in sem_CPat_Char_1)) of + { ( sem_CPat_1) | True -> + ( _lhsOnmL,sem_CPat_1) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPat_BoolExpr_1 :: T_CPat_1 + sem_CPat_BoolExpr_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPat_BoolExpr_2 :: T_CPat_2 + sem_CPat_BoolExpr_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (CPat_BoolExpr cexpr_) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) + in sem_CPat_BoolExpr_2)) of + { ( sem_CPat_2) | True -> + ( _lhsOgIniq,sem_CPat_2) }) })) + in sem_CPat_BoolExpr_1)) of + { ( sem_CPat_1) | True -> + ( _lhsOnmL,sem_CPat_1) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + nmL : [HsName] + visit 1: + inherited attribute: + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attributes: + cTrf : CPatFld + fldNmL : [HsName] + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ + visit 1: + intra fldNm : _ + visit 2: + local aRenMp : _ + intra fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( ([HsName]),T_CPatFld_1) +type T_CPatFld_1 = Int -> + RenUniqOpts -> + ( Int,T_CPatFld_2) +type T_CPatFld_2 = ARenMp -> + Int -> + HsName -> + ( CPatFld,([HsName])) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case ([]) of + { _bindOprotectedBindingNames | _bindOprotectedBindingNames `seq` (True) -> + (case (bind_ _bindOprotectedBindingNames) of + { ( _bindInm,_bindInmL,bind_1) | True -> + (case (_bindInm) of + { _fldNm | _fldNm `seq` (True) -> + (case ([_fldNm]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPatFld_Fld_1 :: T_CPatFld_1 + sem_CPatFld_Fld_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _bindOropts | _bindOropts `seq` (True) -> + (case (_lhsIropts) of + { _offsetOropts | _offsetOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _offsetOgIniq | _offsetOgIniq `seq` (True) -> + (case ([]) of + { _offsetOprotectedBindingNames | _offsetOprotectedBindingNames `seq` (True) -> + (case (offset_ _offsetOgIniq _offsetOprotectedBindingNames _offsetOropts) of + { ( _offsetIgIniq,_offsetIisLamBody,offset_1) | True -> + (case (_offsetIgIniq) of + { _bindOgIniq | _bindOgIniq `seq` (True) -> + (case (bind_1 _bindOgIniq _bindOropts) of + { ( _bindIgIniq,bind_2) | True -> + (case (_bindIgIniq) of + { _fldAnnsOgIniq | _fldAnnsOgIniq `seq` (True) -> + (case (fldAnns_ _fldAnnsOgIniq) of + { ( _fldAnnsIgIniq,fldAnns_1) | True -> + (case (_fldAnnsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPatFld_Fld_2 :: T_CPatFld_2 + sem_CPatFld_Fld_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _offsetOmoduleNm | _offsetOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _offsetOlev | _offsetOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _offsetOaccumARenMp | _offsetOaccumARenMp `seq` (True) -> + (case (offset_1 _offsetOaccumARenMp _offsetOlev _offsetOmoduleNm) of + { ( _offsetIaccumARenMp,offset_2) | True -> + (case (_offsetIaccumARenMp) of + { _aRenMp | _aRenMp `seq` (True) -> + (case (_aRenMp) of + { _offsetOaRenMp | _offsetOaRenMp `seq` (True) -> + (case (_lhsIropts) of + { _fldAnnsOropts | _fldAnnsOropts `seq` (True) -> + (case (_lhsImoduleNm) of + { _fldAnnsOmoduleNm | _fldAnnsOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _fldAnnsOlev | _fldAnnsOlev `seq` (True) -> + (case (_aRenMp) of + { _fldAnnsOaRenMp | _fldAnnsOaRenMp `seq` (True) -> + (case (fldAnns_1 _fldAnnsOaRenMp _fldAnnsOlev _fldAnnsOmoduleNm _fldAnnsOropts) of + { ( _fldAnnsIcTrf,_fldAnnsInmL) | True -> + (case (offset_2 _offsetOaRenMp) of + { ( _offsetIcTrf) | True -> + (case (CPatFld_Fld lbl_ _offsetIcTrf (acoreBind1Nm1 $ aRenRepl _aRenMp _fldNm) _fldAnnsIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([_fldNm]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPatFld_Fld_2)) of + { ( sem_CPatFld_2) | True -> + ( _lhsOgIniq,sem_CPatFld_2) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPatFld_Fld_1)) of + { ( sem_CPatFld_1) | True -> + ( _lhsOnmL,sem_CPatFld_1) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + nmL : [HsName] + visit 1: + inherited attribute: + ropts : RenUniqOpts + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + synthesized attributes: + cTrf : CPatFldL + fldNmL : [HsName] + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + visit 2: + local cTrf : _ + alternative Nil: + visit 2: + local cTrf : _ +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( ([HsName]),T_CPatFldL_1) +type T_CPatFldL_1 = Int -> + RenUniqOpts -> + ( Int,T_CPatFldL_2) +type T_CPatFldL_2 = ARenMp -> + Int -> + HsName -> + ( CPatFldL,([HsName])) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlInmL,tl_1) | True -> + (case (hd_) of + { ( _hdInmL,hd_1) | True -> + (case (_hdInmL ++ _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPatFldL_Cons_1 :: T_CPatFldL_1 + sem_CPatFldL_Cons_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _tlOropts | _tlOropts `seq` (True) -> + (case (_lhsIropts) of + { _hdOropts | _hdOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _hdOgIniq | _hdOgIniq `seq` (True) -> + (case (hd_1 _hdOgIniq _hdOropts) of + { ( _hdIgIniq,hd_2) | True -> + (case (_hdIgIniq) of + { _tlOgIniq | _tlOgIniq `seq` (True) -> + (case (tl_1 _tlOgIniq _tlOropts) of + { ( _tlIgIniq,tl_2) | True -> + (case (_tlIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPatFldL_Cons_2 :: T_CPatFldL_2 + sem_CPatFldL_Cons_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _tlOlev | _tlOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _tlOaRenMp | _tlOaRenMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlev) of + { _hdOlev | _hdOlev `seq` (True) -> + (case (_lhsIaRenMp) of + { _hdOaRenMp | _hdOaRenMp `seq` (True) -> + (case (tl_2 _tlOaRenMp _tlOlev _tlOmoduleNm) of + { ( _tlIcTrf,_tlIfldNmL) | True -> + (case (hd_2 _hdOaRenMp _hdOlev _hdOmoduleNm) of + { ( _hdIcTrf,_hdIfldNmL) | True -> + (case ((:) _hdIcTrf _tlIcTrf) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) }) }) }) }) }) }) }) }) })) + in sem_CPatFldL_Cons_2)) of + { ( sem_CPatFldL_2) | True -> + ( _lhsOgIniq,sem_CPatFldL_2) }) }) }) }) }) }) }) })) + in sem_CPatFldL_Cons_1)) of + { ( sem_CPatFldL_1) | True -> + ( _lhsOnmL,sem_CPatFldL_1) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPatFldL_Nil_1 :: T_CPatFldL_1 + sem_CPatFldL_Nil_1 = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPatFldL_Nil_2 :: T_CPatFldL_2 + sem_CPatFldL_Nil_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm -> + (case ([]) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + (case ([]) of + { _lhsOfldNmL | _lhsOfldNmL `seq` (True) -> + ( _lhsOcTrf,_lhsOfldNmL) }) }) })) + in sem_CPatFldL_Nil_2)) of + { ( sem_CPatFldL_2) | True -> + ( _lhsOgIniq,sem_CPatFldL_2) }) })) + in sem_CPatFldL_Nil_1)) of + { ( sem_CPatFldL_1) | True -> + ( _lhsOnmL,sem_CPatFldL_1) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + nmL : [HsName] + visit 1: + chained attribute: + gIniq : Int + visit 2: + inherited attributes: + aRenMp : ARenMp + lev : Int + moduleNm : HsName + ropts : RenUniqOpts + synthesized attribute: + cTrf : CPatRest + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: + visit 2: + local cTrf : _ +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( ([HsName]),T_CPatRest_1) +type T_CPatRest_1 = Int -> + ( Int,T_CPatRest_2) +type T_CPatRest_2 = ARenMp -> + Int -> + HsName -> + RenUniqOpts -> + ( CPatRest) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case ([nm_]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPatRest_Var_1 :: T_CPatRest_1 + sem_CPatRest_Var_1 = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPatRest_Var_2 :: T_CPatRest_2 + sem_CPatRest_Var_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CPatRest_Var (aRenRepl _lhsIaRenMp nm_)) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) })) + in sem_CPatRest_Var_2)) of + { ( sem_CPatRest_2) | True -> + ( _lhsOgIniq,sem_CPatRest_2) }) })) + in sem_CPatRest_Var_1)) of + { ( sem_CPatRest_1) | True -> + ( _lhsOnmL,sem_CPatRest_1) }) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case ((let sem_CPatRest_Empty_1 :: T_CPatRest_1 + sem_CPatRest_Empty_1 = + (\ _lhsIgIniq -> + (case (_lhsIgIniq) of + { _lhsOgIniq | _lhsOgIniq `seq` (True) -> + (case ((let sem_CPatRest_Empty_2 :: T_CPatRest_2 + sem_CPatRest_Empty_2 = + (\ _lhsIaRenMp + _lhsIlev + _lhsImoduleNm + _lhsIropts -> + (case (CPatRest_Empty) of + { _cTrf | _cTrf `seq` (True) -> + (case (_cTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) })) + in sem_CPatRest_Empty_2)) of + { ( sem_CPatRest_2) | True -> + ( _lhsOgIniq,sem_CPatRest_2) }) })) + in sem_CPatRest_Empty_1)) of + { ( sem_CPatRest_1) | True -> + ( _lhsOnmL,sem_CPatRest_1) }) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + inherited attributes: + gIniq : Int + ropts : RenUniqOpts + synthesized attribute: + cTrf : CModule + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = Int -> + RenUniqOpts -> + ( CModule) +data Inh_CodeAGItf = Inh_CodeAGItf {gIniq_Inh_CodeAGItf :: !(Int),ropts_Inh_CodeAGItf :: !(RenUniqOpts)} +data Syn_CodeAGItf = Syn_CodeAGItf {cTrf_Syn_CodeAGItf :: !(CModule)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf _lhsIgIniq _lhsIropts) = + (let ( _lhsOcTrf) | True = sem _lhsIgIniq _lhsIropts + in (Syn_CodeAGItf _lhsOcTrf)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (\ _lhsIgIniq + _lhsIropts -> + (case (_lhsIropts) of + { _moduleOropts | _moduleOropts `seq` (True) -> + (case (_lhsIgIniq) of + { _moduleOgIniq | _moduleOgIniq `seq` (True) -> + (case (cLevModule) of + { _moduleOlev | _moduleOlev `seq` (True) -> + (case (emptyARenMp) of + { _moduleOaRenMp | _moduleOaRenMp `seq` (True) -> + (case (module_ _moduleOaRenMp _moduleOgIniq _moduleOlev _moduleOropts) of + { ( _moduleIcTrf,_moduleIgIniq) | True -> + (case (_moduleIcTrf) of + { _lhsOcTrf | _lhsOcTrf `seq` (True) -> + ( _lhsOcTrf) }) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Core/UsedModNms.hs b/src/UHC/Light/Compiler/Core/UsedModNms.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/UsedModNms.hs @@ -0,0 +1,1326 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Core/UsedModNm) +module UHC.Light.Compiler.Core.UsedModNms(cmodUsedModNms) where + +import qualified Data.Set as Set +import Data.Maybe +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty + + + + + + + +cmodUsedModNms + :: CModule + -> ( HsNameS -- usedModNmS + , HsNameS -- introducedModNmS + ) +cmodUsedModNms m + = ( usedModNmS_Syn_CodeAGItf t + , introducedModNmS_Syn_CodeAGItf t + ) + where t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf m)) Inh_CodeAGItf + + + +collapseToModNm :: HsNameS -> HsNameS +collapseToModNm = Set.unions . Set.toList . Set.map (Set.fromList . maybeToList . hsnQualifier) + +-- CAlt -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Alt: + child pat : CPat + child expr : CExpr +-} +-- cata +sem_CAlt :: CAlt -> + T_CAlt +sem_CAlt (CAlt_Alt _pat _expr) = + (sem_CAlt_Alt (sem_CPat _pat) (sem_CExpr _expr)) +-- semantic domain +type T_CAlt = ( HsNameS) +sem_CAlt_Alt :: T_CPat -> + T_CExpr -> + T_CAlt +sem_CAlt_Alt pat_ expr_ = + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (pat_) of + { ( _patIfldNmL,_patIusedNmS) -> + (case (_exprIusedNmS `Set.difference` Set.fromList _patIfldNmL) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) }) +-- CAltL ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Cons: + child hd : CAlt + child tl : CAltL + alternative Nil: +-} +-- cata +sem_CAltL :: CAltL -> + T_CAltL +sem_CAltL list = + (Prelude.foldr sem_CAltL_Cons sem_CAltL_Nil (Prelude.map sem_CAlt list)) +-- semantic domain +type T_CAltL = ( HsNameS) +sem_CAltL_Cons :: T_CAlt -> + T_CAltL -> + T_CAltL +sem_CAltL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIusedNmS) -> + (case (hd_) of + { ( _hdIusedNmS) -> + (case (_hdIusedNmS `Set.union` _tlIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) }) +sem_CAltL_Nil :: T_CAltL +sem_CAltL_Nil = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CBind ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + introducedNmS : HsNameS + nm : HsName + usedNmS : HsNameS + alternatives: + alternative Bind: + child nm : {HsName} + child bindAspects : CBoundL +-} +-- cata +sem_CBind :: CBind -> + T_CBind +sem_CBind (CBind_Bind _nm _bindAspects) = + (sem_CBind_Bind _nm (sem_CBoundL _bindAspects)) +-- semantic domain +type T_CBind = ( HsNameS,HsName,HsNameS) +sem_CBind_Bind :: HsName -> + T_CBoundL -> + T_CBind +sem_CBind_Bind nm_ bindAspects_ = + (case (Set.singleton nm_) of + { _lhsOintroducedNmS -> + (case (nm_) of + { _lhsOnm -> + (case (nm_) of + { _bindAspectsOnm -> + (case (bindAspects_ _bindAspectsOnm) of + { ( _bindAspectsIusedNmS) -> + (case (_bindAspectsIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOnm,_lhsOusedNmS) }) }) }) }) }) +-- CBindAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Coe: + child coe : {RelevCoe} +-} +-- cata +sem_CBindAnn :: CBindAnn -> + T_CBindAnn +sem_CBindAnn (CBindAnn_Coe _coe) = + (sem_CBindAnn_Coe _coe) +-- semantic domain +type T_CBindAnn = ( HsNameS) +sem_CBindAnn_Coe :: RelevCoe -> + T_CBindAnn +sem_CBindAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CBindAnnL --------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Cons: + child hd : CBindAnn + child tl : CBindAnnL + alternative Nil: +-} +-- cata +sem_CBindAnnL :: CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL list = + (Prelude.foldr sem_CBindAnnL_Cons sem_CBindAnnL_Nil (Prelude.map sem_CBindAnn list)) +-- semantic domain +type T_CBindAnnL = ( HsNameS) +sem_CBindAnnL_Cons :: T_CBindAnn -> + T_CBindAnnL -> + T_CBindAnnL +sem_CBindAnnL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIusedNmS) -> + (case (hd_) of + { ( _hdIusedNmS) -> + (case (_hdIusedNmS `Set.union` _tlIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) }) +sem_CBindAnnL_Nil :: T_CBindAnnL +sem_CBindAnnL_Nil = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CBindL ------------------------------------------------------ +{- + visit 0: + synthesized attributes: + introducedNmS : HsNameS + usedNmS : HsNameS + alternatives: + alternative Cons: + child hd : CBind + child tl : CBindL + alternative Nil: +-} +-- cata +sem_CBindL :: CBindL -> + T_CBindL +sem_CBindL list = + (Prelude.foldr sem_CBindL_Cons sem_CBindL_Nil (Prelude.map sem_CBind list)) +-- semantic domain +type T_CBindL = ( HsNameS,HsNameS) +sem_CBindL_Cons :: T_CBind -> + T_CBindL -> + T_CBindL +sem_CBindL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIintroducedNmS,_tlIusedNmS) -> + (case (hd_) of + { ( _hdIintroducedNmS,_hdInm,_hdIusedNmS) -> + (case (_hdIintroducedNmS `Set.union` _tlIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_hdIusedNmS `Set.union` _tlIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) +sem_CBindL_Nil :: T_CBindL +sem_CBindL_Nil = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +-- CBound ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Bind: + child bindMeta : CMetas + child expr : CExpr + alternative Meta: + child aspectKeyS : {ACoreBindAspectKeyS} + child cmetas : CMetas + alternative RelevTy: + child aspectKeyS : {ACoreBindAspectKeyS} + child relevTy : {RelevTy} + alternative Val: + child aspectKeyS : {ACoreBindAspectKeyS} + child mlev : {MetaLev} + child lbl : {CLbl} + child expr : CExpr + alternative Ty: + child aspectKeyS : {ACoreBindAspectKeyS} + child ty : {Ty} + alternative FFE: + child callconv : {FFIWay} + child expEnt : {ForeignEnt} + child expr : CExpr + child ty : {Ty} +-} +-- cata +sem_CBound :: CBound -> + T_CBound +sem_CBound (CBound_Bind _bindMeta _expr) = + (sem_CBound_Bind (sem_CMetas _bindMeta) (sem_CExpr _expr)) +sem_CBound (CBound_Meta _aspectKeyS _cmetas) = + (sem_CBound_Meta _aspectKeyS (sem_CMetas _cmetas)) +sem_CBound (CBound_RelevTy _aspectKeyS _relevTy) = + (sem_CBound_RelevTy _aspectKeyS _relevTy) +sem_CBound (CBound_Val _aspectKeyS _mlev _lbl _expr) = + (sem_CBound_Val _aspectKeyS _mlev _lbl (sem_CExpr _expr)) +sem_CBound (CBound_Ty _aspectKeyS _ty) = + (sem_CBound_Ty _aspectKeyS _ty) +sem_CBound (CBound_FFE _callconv _expEnt _expr _ty) = + (sem_CBound_FFE _callconv _expEnt (sem_CExpr _expr) _ty) +-- semantic domain +type T_CBound = HsName -> + ( HsNameS) +sem_CBound_Bind :: T_CMetas -> + T_CExpr -> + T_CBound +sem_CBound_Bind bindMeta_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (bindMeta_) of + { ( _bindMetaIusedNmS) -> + (case (_bindMetaIusedNmS `Set.union` _exprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) })) +sem_CBound_Meta :: ACoreBindAspectKeyS -> + T_CMetas -> + T_CBound +sem_CBound_Meta aspectKeyS_ cmetas_ = + (\ _lhsInm -> + (case (cmetas_) of + { ( _cmetasIusedNmS) -> + (case (_cmetasIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) })) +sem_CBound_RelevTy :: ACoreBindAspectKeyS -> + RelevTy -> + T_CBound +sem_CBound_RelevTy aspectKeyS_ relevTy_ = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) })) +sem_CBound_Val :: ACoreBindAspectKeyS -> + MetaLev -> + CLbl -> + T_CExpr -> + T_CBound +sem_CBound_Val aspectKeyS_ mlev_ lbl_ expr_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) })) +sem_CBound_Ty :: ACoreBindAspectKeyS -> + Ty -> + T_CBound +sem_CBound_Ty aspectKeyS_ ty_ = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) })) +sem_CBound_FFE :: FFIWay -> + ForeignEnt -> + T_CExpr -> + Ty -> + T_CBound +sem_CBound_FFE callconv_ expEnt_ expr_ ty_ = + (\ _lhsInm -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) })) +-- CBoundL ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nm : HsName + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Cons: + child hd : CBound + child tl : CBoundL + alternative Nil: +-} +-- cata +sem_CBoundL :: CBoundL -> + T_CBoundL +sem_CBoundL list = + (Prelude.foldr sem_CBoundL_Cons sem_CBoundL_Nil (Prelude.map sem_CBound list)) +-- semantic domain +type T_CBoundL = HsName -> + ( HsNameS) +sem_CBoundL_Cons :: T_CBound -> + T_CBoundL -> + T_CBoundL +sem_CBoundL_Cons hd_ tl_ = + (\ _lhsInm -> + (case (_lhsInm) of + { _tlOnm -> + (case (tl_ _tlOnm) of + { ( _tlIusedNmS) -> + (case (_lhsInm) of + { _hdOnm -> + (case (hd_ _hdOnm) of + { ( _hdIusedNmS) -> + (case (_hdIusedNmS `Set.union` _tlIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) }) }) })) +sem_CBoundL_Nil :: T_CBoundL +sem_CBoundL_Nil = + (\ _lhsInm -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) })) +-- CDataCon ---------------------------------------------------- +{- + alternatives: + alternative Con: + child conNm : {HsName} + child tagNr : {Int} + child arity : {Int} +-} +-- cata +sem_CDataCon :: CDataCon -> + T_CDataCon +sem_CDataCon (CDataCon_Con _conNm _tagNr _arity) = + (sem_CDataCon_Con _conNm _tagNr _arity) +-- semantic domain +type T_CDataCon = ( ) +sem_CDataCon_Con :: HsName -> + Int -> + Int -> + T_CDataCon +sem_CDataCon_Con conNm_ tagNr_ arity_ = + ( ) +-- CDataConL --------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDataCon + child tl : CDataConL + alternative Nil: +-} +-- cata +sem_CDataConL :: CDataConL -> + T_CDataConL +sem_CDataConL list = + (Prelude.foldr sem_CDataConL_Cons sem_CDataConL_Nil (Prelude.map sem_CDataCon list)) +-- semantic domain +type T_CDataConL = ( ) +sem_CDataConL_Cons :: T_CDataCon -> + T_CDataConL -> + T_CDataConL +sem_CDataConL_Cons hd_ tl_ = + ( ) +sem_CDataConL_Nil :: T_CDataConL +sem_CDataConL_Nil = + ( ) +-- CDeclMeta --------------------------------------------------- +{- + alternatives: + alternative Data: + child tyNm : {HsName} + child dataCons : CDataConL +-} +-- cata +sem_CDeclMeta :: CDeclMeta -> + T_CDeclMeta +sem_CDeclMeta (CDeclMeta_Data _tyNm _dataCons) = + (sem_CDeclMeta_Data _tyNm (sem_CDataConL _dataCons)) +-- semantic domain +type T_CDeclMeta = ( ) +sem_CDeclMeta_Data :: HsName -> + T_CDataConL -> + T_CDeclMeta +sem_CDeclMeta_Data tyNm_ dataCons_ = + ( ) +-- CDeclMetaL -------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CDeclMeta + child tl : CDeclMetaL + alternative Nil: +-} +-- cata +sem_CDeclMetaL :: CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL list = + (Prelude.foldr sem_CDeclMetaL_Cons sem_CDeclMetaL_Nil (Prelude.map sem_CDeclMeta list)) +-- semantic domain +type T_CDeclMetaL = ( ) +sem_CDeclMetaL_Cons :: T_CDeclMeta -> + T_CDeclMetaL -> + T_CDeclMetaL +sem_CDeclMetaL_Cons hd_ tl_ = + ( ) +sem_CDeclMetaL_Nil :: T_CDeclMetaL +sem_CDeclMetaL_Nil = + ( ) +-- CExpr ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + introducedNmS : HsNameS + usedNmS : HsNameS + alternatives: + alternative Var: + child ref : {ACoreBindRef} + visit 0: + local nm : {HsName} + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative String: + child str : {String} + alternative Integer: + child integer : {Integer} + alternative Tup: + child tag : {CTag} + alternative Let: + child categ : {CBindCateg} + child binds : CBindL + child body : CExpr + visit 0: + local usedNmSInBody : _ + local usedNmSInBinds : _ + alternative App: + child func : CExpr + child arg : CBound + alternative Lam: + child bind : CBind + child body : CExpr + visit 0: + local argNm : _ + alternative Case: + child expr : CExpr + child alts : CAltL + child dflt : CExpr + alternative CaseAltFail: + child failReason : {CaseAltFailReason} + child errorExpr : CExpr + alternative TupDel: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + alternative TupIns: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + alternative TupUpd: + child expr : CExpr + child tag : {CTag} + child nm : {HsName} + child offset : CExpr + child fldExpr : CExpr + alternative FFI: + child callconv : {FFIWay} + child safety : {String} + child impEnt : {ForeignEnt} + child ty : {Ty} + alternative Dbg: + child info : {String} + alternative Hole: + child uid : {UID} + alternative HoleLet: + child bindsUid : {UID} + child body : CExpr + alternative CoeArg: + alternative ImplsApp: + child func : CExpr + child uid : {ImplsVarId} + alternative ImplsLam: + child uid : {ImplsVarId} + child body : CExpr + alternative Ann: + child ann : CExprAnn + child expr : CExpr +-} +-- cata +sem_CExpr :: CExpr -> + T_CExpr +sem_CExpr (CExpr_Var _ref) = + (sem_CExpr_Var _ref) +sem_CExpr (CExpr_Int _int) = + (sem_CExpr_Int _int) +sem_CExpr (CExpr_Char _char) = + (sem_CExpr_Char _char) +sem_CExpr (CExpr_String _str) = + (sem_CExpr_String _str) +sem_CExpr (CExpr_Integer _integer) = + (sem_CExpr_Integer _integer) +sem_CExpr (CExpr_Tup _tag) = + (sem_CExpr_Tup _tag) +sem_CExpr (CExpr_Let _categ _binds _body) = + (sem_CExpr_Let _categ (sem_CBindL _binds) (sem_CExpr _body)) +sem_CExpr (CExpr_App _func _arg) = + (sem_CExpr_App (sem_CExpr _func) (sem_CBound _arg)) +sem_CExpr (CExpr_Lam _bind _body) = + (sem_CExpr_Lam (sem_CBind _bind) (sem_CExpr _body)) +sem_CExpr (CExpr_Case _expr _alts _dflt) = + (sem_CExpr_Case (sem_CExpr _expr) (sem_CAltL _alts) (sem_CExpr _dflt)) +sem_CExpr (CExpr_CaseAltFail _failReason _errorExpr) = + (sem_CExpr_CaseAltFail _failReason (sem_CExpr _errorExpr)) +sem_CExpr (CExpr_TupDel _expr _tag _nm _offset) = + (sem_CExpr_TupDel (sem_CExpr _expr) _tag _nm (sem_CExpr _offset)) +sem_CExpr (CExpr_TupIns _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupIns (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_TupUpd _expr _tag _nm _offset _fldExpr) = + (sem_CExpr_TupUpd (sem_CExpr _expr) _tag _nm (sem_CExpr _offset) (sem_CExpr _fldExpr)) +sem_CExpr (CExpr_FFI _callconv _safety _impEnt _ty) = + (sem_CExpr_FFI _callconv _safety _impEnt _ty) +sem_CExpr (CExpr_Dbg _info) = + (sem_CExpr_Dbg _info) +sem_CExpr (CExpr_Hole _uid) = + (sem_CExpr_Hole _uid) +sem_CExpr (CExpr_HoleLet _bindsUid _body) = + (sem_CExpr_HoleLet _bindsUid (sem_CExpr _body)) +sem_CExpr (CExpr_CoeArg) = + (sem_CExpr_CoeArg) +sem_CExpr (CExpr_ImplsApp _func _uid) = + (sem_CExpr_ImplsApp (sem_CExpr _func) _uid) +sem_CExpr (CExpr_ImplsLam _uid _body) = + (sem_CExpr_ImplsLam _uid (sem_CExpr _body)) +sem_CExpr (CExpr_Ann _ann _expr) = + (sem_CExpr_Ann (sem_CExprAnn _ann) (sem_CExpr _expr)) +-- semantic domain +type T_CExpr = ( HsNameS,HsNameS) +sem_CExpr_Var :: ACoreBindRef -> + T_CExpr +sem_CExpr_Var ref_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (acbrefNm ref_) of + { _nm -> + (case (Set.singleton _nm) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +sem_CExpr_Int :: Int -> + T_CExpr +sem_CExpr_Int int_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Char :: Char -> + T_CExpr +sem_CExpr_Char char_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_String :: String -> + T_CExpr +sem_CExpr_String str_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Integer :: Integer -> + T_CExpr +sem_CExpr_Integer integer_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Tup :: CTag -> + T_CExpr +sem_CExpr_Tup tag_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Let :: CBindCateg -> + T_CBindL -> + T_CExpr -> + T_CExpr +sem_CExpr_Let categ_ binds_ body_ = + (case (body_) of + { ( _bodyIintroducedNmS,_bodyIusedNmS) -> + (case (binds_) of + { ( _bindsIintroducedNmS,_bindsIusedNmS) -> + (case (_bindsIintroducedNmS `Set.union` _bodyIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_bodyIusedNmS `Set.difference` _bindsIintroducedNmS) of + { _usedNmSInBody -> + (case (case categ_ of + CBindCateg_Rec -> _bindsIusedNmS `Set.difference` _bindsIintroducedNmS + _ -> _bindsIusedNmS) of + { _usedNmSInBinds -> + (case (_usedNmSInBinds `Set.union` _usedNmSInBody) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) }) +sem_CExpr_App :: T_CExpr -> + T_CBound -> + T_CExpr +sem_CExpr_App func_ arg_ = + (case (func_) of + { ( _funcIintroducedNmS,_funcIusedNmS) -> + (case (_funcIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (hsnUnknown) of + { _argOnm -> + (case (arg_ _argOnm) of + { ( _argIusedNmS) -> + (case (_funcIusedNmS `Set.union` _argIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) +sem_CExpr_Lam :: T_CBind -> + T_CExpr -> + T_CExpr +sem_CExpr_Lam bind_ body_ = + (case (body_) of + { ( _bodyIintroducedNmS,_bodyIusedNmS) -> + (case (bind_) of + { ( _bindIintroducedNmS,_bindInm,_bindIusedNmS) -> + (case (_bindIintroducedNmS `Set.union` _bodyIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_bindInm) of + { _argNm -> + (case (Set.delete _argNm _bodyIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) +sem_CExpr_Case :: T_CExpr -> + T_CAltL -> + T_CExpr -> + T_CExpr +sem_CExpr_Case expr_ alts_ dflt_ = + (case (dflt_) of + { ( _dfltIintroducedNmS,_dfltIusedNmS) -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS `Set.union` _dfltIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (alts_) of + { ( _altsIusedNmS) -> + (case (_exprIusedNmS `Set.union` _altsIusedNmS `Set.union` _dfltIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) +sem_CExpr_CaseAltFail :: CaseAltFailReason -> + T_CExpr -> + T_CExpr +sem_CExpr_CaseAltFail failReason_ errorExpr_ = + (case (errorExpr_) of + { ( _errorExprIintroducedNmS,_errorExprIusedNmS) -> + (case (_errorExprIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_errorExprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +sem_CExpr_TupDel :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr +sem_CExpr_TupDel expr_ tag_ nm_ offset_ = + (case (offset_) of + { ( _offsetIintroducedNmS,_offsetIusedNmS) -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS `Set.union` _offsetIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_exprIusedNmS `Set.union` _offsetIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) +sem_CExpr_TupIns :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupIns expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIintroducedNmS,_fldExprIusedNmS) -> + (case (offset_) of + { ( _offsetIintroducedNmS,_offsetIusedNmS) -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS `Set.union` _offsetIintroducedNmS `Set.union` _fldExprIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_exprIusedNmS `Set.union` _offsetIusedNmS `Set.union` _fldExprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) +sem_CExpr_TupUpd :: T_CExpr -> + CTag -> + HsName -> + T_CExpr -> + T_CExpr -> + T_CExpr +sem_CExpr_TupUpd expr_ tag_ nm_ offset_ fldExpr_ = + (case (fldExpr_) of + { ( _fldExprIintroducedNmS,_fldExprIusedNmS) -> + (case (offset_) of + { ( _offsetIintroducedNmS,_offsetIusedNmS) -> + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS `Set.union` _offsetIintroducedNmS `Set.union` _fldExprIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_exprIusedNmS `Set.union` _offsetIusedNmS `Set.union` _fldExprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) }) +sem_CExpr_FFI :: FFIWay -> + String -> + ForeignEnt -> + Ty -> + T_CExpr +sem_CExpr_FFI callconv_ safety_ impEnt_ ty_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Dbg :: String -> + T_CExpr +sem_CExpr_Dbg info_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_Hole :: UID -> + T_CExpr +sem_CExpr_Hole uid_ = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_HoleLet :: UID -> + T_CExpr -> + T_CExpr +sem_CExpr_HoleLet bindsUid_ body_ = + (case (body_) of + { ( _bodyIintroducedNmS,_bodyIusedNmS) -> + (case (_bodyIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_bodyIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +sem_CExpr_CoeArg :: T_CExpr +sem_CExpr_CoeArg = + (case (Set.empty) of + { _lhsOintroducedNmS -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) +sem_CExpr_ImplsApp :: T_CExpr -> + ImplsVarId -> + T_CExpr +sem_CExpr_ImplsApp func_ uid_ = + (case (func_) of + { ( _funcIintroducedNmS,_funcIusedNmS) -> + (case (_funcIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_funcIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +sem_CExpr_ImplsLam :: ImplsVarId -> + T_CExpr -> + T_CExpr +sem_CExpr_ImplsLam uid_ body_ = + (case (body_) of + { ( _bodyIintroducedNmS,_bodyIusedNmS) -> + (case (_bodyIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_bodyIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +sem_CExpr_Ann :: T_CExprAnn -> + T_CExpr -> + T_CExpr +sem_CExpr_Ann ann_ expr_ = + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (ann_) of + { ( _annIusedNmS) -> + (case (_annIusedNmS `Set.union` _exprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) }) +-- CExprAnn ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Ty: + child ty : {Ty} + alternative Coe: + child coe : {RelevCoe} + alternative Debug: + child info : {String} +-} +-- cata +sem_CExprAnn :: CExprAnn -> + T_CExprAnn +sem_CExprAnn (CExprAnn_Ty _ty) = + (sem_CExprAnn_Ty _ty) +sem_CExprAnn (CExprAnn_Coe _coe) = + (sem_CExprAnn_Coe _coe) +sem_CExprAnn (CExprAnn_Debug _info) = + (sem_CExprAnn_Debug _info) +-- semantic domain +type T_CExprAnn = ( HsNameS) +sem_CExprAnn_Ty :: Ty -> + T_CExprAnn +sem_CExprAnn_Ty ty_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CExprAnn_Coe :: RelevCoe -> + T_CExprAnn +sem_CExprAnn_Coe coe_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CExprAnn_Debug :: String -> + T_CExprAnn +sem_CExprAnn_Debug info_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CImport ----------------------------------------------------- +{- + alternatives: + alternative Import: + child nm : {HsName} +-} +-- cata +sem_CImport :: CImport -> + T_CImport +sem_CImport (CImport_Import _nm) = + (sem_CImport_Import _nm) +-- semantic domain +type T_CImport = ( ) +sem_CImport_Import :: HsName -> + T_CImport +sem_CImport_Import nm_ = + ( ) +-- CImportL ---------------------------------------------------- +{- + alternatives: + alternative Cons: + child hd : CImport + child tl : CImportL + alternative Nil: +-} +-- cata +sem_CImportL :: CImportL -> + T_CImportL +sem_CImportL list = + (Prelude.foldr sem_CImportL_Cons sem_CImportL_Nil (Prelude.map sem_CImport list)) +-- semantic domain +type T_CImportL = ( ) +sem_CImportL_Cons :: T_CImport -> + T_CImportL -> + T_CImportL +sem_CImportL_Cons hd_ tl_ = + ( ) +sem_CImportL_Nil :: T_CImportL +sem_CImportL_Nil = + ( ) +-- CMetaBind --------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Plain: + alternative Function0: + alternative Function1: + alternative Apply0: +-} +-- cata +sem_CMetaBind :: CMetaBind -> + T_CMetaBind +sem_CMetaBind (CMetaBind_Plain) = + (sem_CMetaBind_Plain) +sem_CMetaBind (CMetaBind_Function0) = + (sem_CMetaBind_Function0) +sem_CMetaBind (CMetaBind_Function1) = + (sem_CMetaBind_Function1) +sem_CMetaBind (CMetaBind_Apply0) = + (sem_CMetaBind_Apply0) +-- semantic domain +type T_CMetaBind = ( HsNameS) +sem_CMetaBind_Plain :: T_CMetaBind +sem_CMetaBind_Plain = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaBind_Function0 :: T_CMetaBind +sem_CMetaBind_Function0 = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaBind_Function1 :: T_CMetaBind +sem_CMetaBind_Function1 = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaBind_Apply0 :: T_CMetaBind +sem_CMetaBind_Apply0 = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CMetaVal ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Val: + alternative Dict: + alternative DictClass: + child tracks : {[Track]} + alternative DictInstance: + child tracks : {[Track]} + alternative Track: + child track : {Track} +-} +-- cata +sem_CMetaVal :: CMetaVal -> + T_CMetaVal +sem_CMetaVal (CMetaVal_Val) = + (sem_CMetaVal_Val) +sem_CMetaVal (CMetaVal_Dict) = + (sem_CMetaVal_Dict) +sem_CMetaVal (CMetaVal_DictClass _tracks) = + (sem_CMetaVal_DictClass _tracks) +sem_CMetaVal (CMetaVal_DictInstance _tracks) = + (sem_CMetaVal_DictInstance _tracks) +sem_CMetaVal (CMetaVal_Track _track) = + (sem_CMetaVal_Track _track) +-- semantic domain +type T_CMetaVal = ( HsNameS) +sem_CMetaVal_Val :: T_CMetaVal +sem_CMetaVal_Val = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaVal_Dict :: T_CMetaVal +sem_CMetaVal_Dict = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaVal_DictClass :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictClass tracks_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaVal_DictInstance :: ([Track]) -> + T_CMetaVal +sem_CMetaVal_DictInstance tracks_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CMetaVal_Track :: Track -> + T_CMetaVal +sem_CMetaVal_Track track_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CMetas ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Tuple: + child x1 : CMetaBind + child x2 : CMetaVal +-} +-- cata +sem_CMetas :: CMetas -> + T_CMetas +sem_CMetas ( x1,x2) = + (sem_CMetas_Tuple (sem_CMetaBind x1) (sem_CMetaVal x2)) +-- semantic domain +type T_CMetas = ( HsNameS) +sem_CMetas_Tuple :: T_CMetaBind -> + T_CMetaVal -> + T_CMetas +sem_CMetas_Tuple x1_ x2_ = + (case (x2_) of + { ( _x2IusedNmS) -> + (case (x1_) of + { ( _x1IusedNmS) -> + (case (_x1IusedNmS `Set.union` _x2IusedNmS) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) }) }) +-- CModule ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + introducedNmS : HsNameS + usedNmS : HsNameS + alternatives: + alternative Mod: + child moduleNm : {HsName} + child imports : CImportL + child declMetas : CDeclMetaL + child expr : CExpr +-} +-- cata +sem_CModule :: CModule -> + T_CModule +sem_CModule (CModule_Mod _moduleNm _imports _declMetas _expr) = + (sem_CModule_Mod _moduleNm (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) +-- semantic domain +type T_CModule = ( HsNameS,HsNameS) +sem_CModule_Mod :: HsName -> + T_CImportL -> + T_CDeclMetaL -> + T_CExpr -> + T_CModule +sem_CModule_Mod moduleNm_ imports_ declMetas_ expr_ = + (case (expr_) of + { ( _exprIintroducedNmS,_exprIusedNmS) -> + (case (_exprIintroducedNmS) of + { _lhsOintroducedNmS -> + (case (_exprIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOintroducedNmS,_lhsOusedNmS) }) }) }) +-- CPat -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + usedNmS : HsNameS + alternatives: + alternative Var: + child pnm : {HsName} + alternative Con: + child tag : {CTag} + child rest : CPatRest + child binds : CPatFldL + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative BoolExpr: + child cexpr : {CExpr} +-} +-- cata +sem_CPat :: CPat -> + T_CPat +sem_CPat (CPat_Var _pnm) = + (sem_CPat_Var _pnm) +sem_CPat (CPat_Con _tag _rest _binds) = + (sem_CPat_Con _tag (sem_CPatRest _rest) (sem_CPatFldL _binds)) +sem_CPat (CPat_Int _int) = + (sem_CPat_Int _int) +sem_CPat (CPat_Char _char) = + (sem_CPat_Char _char) +sem_CPat (CPat_BoolExpr _cexpr) = + (sem_CPat_BoolExpr _cexpr) +-- semantic domain +type T_CPat = ( ([HsName]),HsNameS) +sem_CPat_Var :: HsName -> + T_CPat +sem_CPat_Var pnm_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) +sem_CPat_Con :: CTag -> + T_CPatRest -> + T_CPatFldL -> + T_CPat +sem_CPat_Con tag_ rest_ binds_ = + (case (binds_) of + { ( _bindsIfldNmL,_bindsIusedNmS) -> + (case (_bindsIfldNmL) of + { _lhsOfldNmL -> + (case (rest_) of + { ( _restIusedNmS) -> + (case (_restIusedNmS `Set.union` _bindsIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) }) }) +sem_CPat_Int :: Int -> + T_CPat +sem_CPat_Int int_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) +sem_CPat_Char :: Char -> + T_CPat +sem_CPat_Char char_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) +sem_CPat_BoolExpr :: CExpr -> + T_CPat +sem_CPat_BoolExpr cexpr_ = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) +-- CPatFld ----------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + usedNmS : HsNameS + alternatives: + alternative Fld: + child lbl : {HsName} + child offset : CExpr + child bind : CBind + child fldAnns : CBindAnnL + visit 0: + local fldNm : _ +-} +-- cata +sem_CPatFld :: CPatFld -> + T_CPatFld +sem_CPatFld (CPatFld_Fld _lbl _offset _bind _fldAnns) = + (sem_CPatFld_Fld _lbl (sem_CExpr _offset) (sem_CBind _bind) (sem_CBindAnnL _fldAnns)) +-- semantic domain +type T_CPatFld = ( ([HsName]),HsNameS) +sem_CPatFld_Fld :: HsName -> + T_CExpr -> + T_CBind -> + T_CBindAnnL -> + T_CPatFld +sem_CPatFld_Fld lbl_ offset_ bind_ fldAnns_ = + (case (bind_) of + { ( _bindIintroducedNmS,_bindInm,_bindIusedNmS) -> + (case (_bindInm) of + { _fldNm -> + (case ([_fldNm]) of + { _lhsOfldNmL -> + (case (fldAnns_) of + { ( _fldAnnsIusedNmS) -> + (case (offset_) of + { ( _offsetIintroducedNmS,_offsetIusedNmS) -> + (case (_offsetIusedNmS `Set.union` _bindIusedNmS `Set.union` _fldAnnsIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) }) }) }) }) +-- CPatFldL ---------------------------------------------------- +{- + visit 0: + synthesized attributes: + fldNmL : [HsName] + usedNmS : HsNameS + alternatives: + alternative Cons: + child hd : CPatFld + child tl : CPatFldL + alternative Nil: +-} +-- cata +sem_CPatFldL :: CPatFldL -> + T_CPatFldL +sem_CPatFldL list = + (Prelude.foldr sem_CPatFldL_Cons sem_CPatFldL_Nil (Prelude.map sem_CPatFld list)) +-- semantic domain +type T_CPatFldL = ( ([HsName]),HsNameS) +sem_CPatFldL_Cons :: T_CPatFld -> + T_CPatFldL -> + T_CPatFldL +sem_CPatFldL_Cons hd_ tl_ = + (case (tl_) of + { ( _tlIfldNmL,_tlIusedNmS) -> + (case (hd_) of + { ( _hdIfldNmL,_hdIusedNmS) -> + (case (_hdIfldNmL ++ _tlIfldNmL) of + { _lhsOfldNmL -> + (case (_hdIusedNmS `Set.union` _tlIusedNmS) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) }) }) +sem_CPatFldL_Nil :: T_CPatFldL +sem_CPatFldL_Nil = + (case ([]) of + { _lhsOfldNmL -> + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOfldNmL,_lhsOusedNmS) }) }) +-- CPatRest ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + usedNmS : HsNameS + alternatives: + alternative Var: + child nm : {HsName} + alternative Empty: +-} +-- cata +sem_CPatRest :: CPatRest -> + T_CPatRest +sem_CPatRest (CPatRest_Var _nm) = + (sem_CPatRest_Var _nm) +sem_CPatRest (CPatRest_Empty) = + (sem_CPatRest_Empty) +-- semantic domain +type T_CPatRest = ( HsNameS) +sem_CPatRest_Var :: HsName -> + T_CPatRest +sem_CPatRest_Var nm_ = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +sem_CPatRest_Empty :: T_CPatRest +sem_CPatRest_Empty = + (case (Set.empty) of + { _lhsOusedNmS -> + ( _lhsOusedNmS) }) +-- CodeAGItf --------------------------------------------------- +{- + visit 0: + synthesized attributes: + introducedModNmS : HsNameS + usedModNmS : HsNameS + alternatives: + alternative AGItf: + child module : CModule +-} +-- cata +sem_CodeAGItf :: CodeAGItf -> + T_CodeAGItf +sem_CodeAGItf (CodeAGItf_AGItf _module) = + (sem_CodeAGItf_AGItf (sem_CModule _module)) +-- semantic domain +type T_CodeAGItf = ( HsNameS,HsNameS) +data Inh_CodeAGItf = Inh_CodeAGItf {} +data Syn_CodeAGItf = Syn_CodeAGItf {introducedModNmS_Syn_CodeAGItf :: !(HsNameS),usedModNmS_Syn_CodeAGItf :: !(HsNameS)} +wrap_CodeAGItf :: T_CodeAGItf -> + Inh_CodeAGItf -> + Syn_CodeAGItf +wrap_CodeAGItf sem (Inh_CodeAGItf) = + (let ( _lhsOintroducedModNmS,_lhsOusedModNmS) = sem + in (Syn_CodeAGItf _lhsOintroducedModNmS _lhsOusedModNmS)) +sem_CodeAGItf_AGItf :: T_CModule -> + T_CodeAGItf +sem_CodeAGItf_AGItf module_ = + (case (module_) of + { ( _moduleIintroducedNmS,_moduleIusedNmS) -> + (case (collapseToModNm _moduleIintroducedNmS) of + { _lhsOintroducedModNmS -> + (case (collapseToModNm $ _moduleIusedNmS `Set.difference` _moduleIintroducedNmS) of + { _lhsOusedModNmS -> + ( _lhsOintroducedModNmS,_lhsOusedModNmS) }) }) }) diff --git a/src/UHC/Light/Compiler/Core/Utils.hs b/src/UHC/Light/Compiler/Core/Utils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Core/Utils.hs @@ -0,0 +1,175 @@ +module UHC.Light.Compiler.Core.Utils +( module UHC.Light.Compiler.AbstractCore.Utils +, RCEEnv +, FieldUpdateL, fuL2ExprL, fuMap +, fvsClosure, fvsTransClosure +, fvLAsArg, mkFvNm, fvLArgRepl, fvVarRepl +, FldOffset (..), foffMkOff, foffLabel +, FieldSplitL, fsL2PatL +, fsLReorder +, fuMkCExpr ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core.Subst +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.List +import Data.Maybe +import qualified Data.Set as Set +import Data.List +import qualified Data.Map as Map +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Control.Monad.State +import Data.Array +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Core.FvS +import UHC.Light.Compiler.Core.ModAsMap +import UHC.Light.Compiler.Core.ExtractFFE + + + +{-# LINE 46 "src/ehc/Core/Utils.chs" #-} +type RCEEnv = RCEEnv' CExpr CMetaVal CBind CBound CTy + +{-# LINE 62 "src/ehc/Core/Utils.chs" #-} +type FieldUpdateL e = AssocL HsName (e,Maybe Int) + +fuMap :: (HsName -> e -> (e',Int)) -> FieldUpdateL e -> FieldUpdateL e' +fuMap f = map (\(l,(e,_)) -> let (e',o) = f l e in (l,(e',Just o))) + +fuL2ExprL' :: (e -> CExpr) -> FieldUpdateL e -> [CExpr] +fuL2ExprL' f l = [ f e | (_,(e,_)) <- l ] + +fuL2ExprL :: FieldUpdateL CExpr -> [CExpr] +fuL2ExprL = fuL2ExprL' cexprTupFld + +fuReorder :: EHCOpts -> [HsName] -> FieldUpdateL CExpr -> (CBindL,FieldUpdateL (CExpr -> CExpr)) +fuReorder opts nL fuL + = let (fuL',offL,_,_) + = foldl + (\(fuL,offL,exts,dels) (n,(_,(f,_))) + -> let mkOff n lbl o + = let smaller l = rowLabCmp l lbl == LT + off = length (filter smaller dels) - length (filter smaller exts) + in acoreBind1Cat CBindCateg_Plain n (acoreBuiltinAddInt opts o off) + no = acoreVar n + in case f of + CExpr_TupIns _ t l o e -> ((l,(\r -> CExpr_TupIns r t l no e,Nothing)) : fuL,(mkOff n l o):offL,l:exts,dels ) + CExpr_TupUpd _ t l o e -> ((l,(\r -> CExpr_TupUpd r t l no e,Nothing)) : fuL,(mkOff n l o):offL,exts ,dels ) + CExpr_TupDel _ t l o -> ((l,(\r -> CExpr_TupDel r t l no ,Nothing)) : fuL,(mkOff n l o):offL,exts ,l:dels) + ) + ([],[],[],[]) + . zip nL + $ fuL + cmpFU (n1,_ ) (n2,_) = rowLabCmp n1 n2 + in (offL, sortBy cmpFU fuL') + +{-# LINE 96 "src/ehc/Core/Utils.chs" #-} +fuMkCExpr :: EHCOpts -> UID -> FieldUpdateL CExpr -> CExpr -> CExpr +fuMkCExpr opts u fuL r + = let (n:nL) = map (uidHNm . uidChild) . mkNewUIDL (length fuL + 1) $ u + (oL,fuL') = fuReorder opts nL fuL + bL = acoreBind1Cat CBindCateg_Plain n r : oL + in acoreLet CBindCateg_Strict bL $ foldl (\r (_,(f,_)) -> f r) (acoreVar n) $ fuL' + +{-# LINE 109 "src/ehc/Core/Utils.chs" #-} +fvsClosure :: FvS -> FvS -> FvS -> FvSMp -> FvSMp -> (FvSMp,FvSMp) +fvsClosure newS lamOuterS varOuterS fvmOuter fvmNew + = let fvmNew2 = Map.filterWithKey (\n _ -> n `Set.member` newS) fvmNew + fvlam s = lamOuterS `Set.intersection` s + fvvar s = varOuterS `Set.intersection` s + fv s = fvvar s `Set.union` s' + where s' = Set.unions $ map (\n -> Map.findWithDefault Set.empty n fvmOuter) $ Set.toList $ fvlam $ s + in (Map.map fv fvmNew2,Map.map (`Set.intersection` newS) fvmNew2) + +fvsTransClosure :: FvSMp -> FvSMp -> FvSMp +fvsTransClosure lamFvSMp varFvSMp + = let varFvSMp2 = Map.mapWithKey + (\n s -> s `Set.union` (Set.unions + $ map (\n -> panicJust "fvsTransClosure.1" $ Map.lookup n $ varFvSMp) + $ Set.toList + $ panicJust "fvsTransClosure.2" + $ Map.lookup n lamFvSMp + ) ) + varFvSMp + sz = sum . map Set.size . Map.elems + in if sz varFvSMp2 > sz varFvSMp + then fvsTransClosure lamFvSMp varFvSMp2 + else varFvSMp + +{-# LINE 135 "src/ehc/Core/Utils.chs" #-} +fvLAsArg :: CVarIntroMp -> FvS -> CVarIntroL +fvLAsArg cvarIntroMp fvS + = sortOn (cviLev . snd) + $ filter (\(_,cvi) -> cviLev cvi > cLevModule) + $ map (\n -> (n,cviLookup n cvarIntroMp)) + $ Set.toList fvS + +mkFvNm :: Int -> HsName -> HsName +mkFvNm i n = hsnUniqifyInt HsNameUniqifier_New i n -- hsnSuffix n ("~" ++ show i) + +fvLArgRepl :: Int -> CVarIntroL -> (CVarIntroL,CVarIntroL,CVarReplNmMp) +fvLArgRepl uniq argLevL + = let argNL = zipWith (\u (n,i) -> (mkFvNm u n,i)) [uniq..] argLevL + in ( argLevL + , argNL + , Map.fromList $ zipWith (\(o,_) (n,cvi) -> (o,(cvrFromCvi cvi) {cvrRepl = n})) argLevL argNL + ) + +fvVarRepl :: CVarReplNmMp -> HsName -> CExpr +fvVarRepl nMp n = maybe (acoreVar n) (acoreVar . cvrRepl) $ Map.lookup n nMp + +{-# LINE 162 "src/ehc/Core/Utils.chs" #-} +data FldOffset + = FldKnownOffset { foffLabel' :: !HsName, foffOffset :: !Int } + | FldComputeOffset { foffLabel' :: !HsName, foffCExpr :: !CExpr } + | FldImplicitOffset + +instance Eq FldOffset where + (FldKnownOffset _ o1) == (FldKnownOffset _ o2) = o1 == o2 + foff1 == foff2 = foffLabel foff1 == foffLabel foff2 + +instance Ord FldOffset where + (FldKnownOffset _ o1) `compare` (FldKnownOffset _ o2) = o1 `compare` o2 + foff1 `compare` foff2 = foffLabel foff1 `rowLabCmp` foffLabel foff2 + +foffMkOff :: EHCOpts -> FldOffset -> Int -> (Int,CExpr) +foffMkOff opts FldImplicitOffset o = (o,acoreInt opts o) +foffMkOff opts (FldKnownOffset _ o) _ = (o,acoreInt opts o) +foffMkOff _ (FldComputeOffset _ e) o = (o,e) + +foffLabel :: FldOffset -> HsName +foffLabel FldImplicitOffset = hsnUnknown +foffLabel foff = foffLabel' foff + +{-# LINE 186 "src/ehc/Core/Utils.chs" #-} +type FieldSplitL = AssocL FldOffset RPat + +fsL2PatL :: FieldSplitL -> [RPat] +fsL2PatL = assocLElts + +{-# LINE 199 "src/ehc/Core/Utils.chs" #-} +fsLReorder :: EHCOpts -> FieldSplitL -> FieldSplitL +fsLReorder opts fsL + = let (fsL',_) + = foldr + (\(FldComputeOffset l o,p) (fsL,exts) + -> let mkOff lbl exts o + = let nrSmaller = length . filter (\e -> rowLabCmp e lbl == LT) $ exts + in acoreBuiltinAddInt opts o nrSmaller + in ((FldComputeOffset l (mkOff l exts o),p):fsL,l:exts) + ) + ([],[]) + $ fsL + in rowCanonOrderBy compare fsL' + diff --git a/src/UHC/Light/Compiler/CoreRun.hs b/src/UHC/Light/Compiler/CoreRun.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun.hs @@ -0,0 +1,179 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun.ag) +module UHC.Light.Compiler.CoreRun(module UHC.Light.Compiler.CoreRun.Prim +, Mod (..), SExp (..), Exp (..), Alt (..), Pat (..) +, CRArray, CRMArray, emptyCRArray, mkCRArray, craLength, craAssocs, craAssocs' +, Bind +, unit +, RRef (..), noRRef +, Ref2Nm +, Nm2RefMp, nm2RefMpInverse, ref2nmEmpty, ref2nmUnion) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.Target +import UHC.Util.Utils +import UHC.Light.Compiler.Ty +import qualified Data.Map as Map +import Data.Maybe +import Data.Char +import Data.List +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import Control.Applicative +import UHC.Light.Compiler.CoreRun.Prim (RunPrim) +import UHC.Light.Compiler.Foreign + + + + + + + + + + + + + + + + + + + + + + +-- | Fast access sequence +type CRArray x = V.Vector x +type CRMArray x = MV.IOVector x + +{- +-- | Make array with lowerbound +mkCRArrayLwb :: Int -> [x] -> CRArray x +mkCRArrayLwb lwb xs = listArray (lwb,lwb+l-1) xs + where l = length xs +-} + +mkCRArray :: [x] -> CRArray x +-- mkCRArray = mkCRArrayLwb 0 +mkCRArray = V.fromList +{-# INLINE mkCRArray #-} + +emptyCRArray :: CRArray x +emptyCRArray = V.empty -- mkCRArray [] +{-# INLINE emptyCRArray #-} + +craLength :: CRArray x -> Int +craLength = V.length -- a = h + 1 - l +-- where (l,h) = bounds a +{-# INLINE craLength #-} + +-- | Content of array as association list, starting index at 'lwb' +craAssocs' :: Int -> CRArray x -> [(Int,x)] +craAssocs' lwb = zip [lwb ..] . V.toList +{-# INLINE craAssocs' #-} + +-- | Content of array as association list, starting index at 0 +craAssocs :: CRArray x -> [(Int,x)] +craAssocs = craAssocs' 0 +{-# INLINE craAssocs #-} + + + +-- | Bind, just an Exp, addressing is left implicit +type Bind = Exp + + + +-- | Equivalent of '()' +unit :: Exp +unit = Exp_Tup CTagRec emptyCRArray + + + +-- | Identifier references for use during running CoreRun +data RRef + -- | global reference to module and its entry + = RRef_Glb + { rrefMod :: !Int -- ^ module + , rrefEntry :: !Int -- ^ entry inside module + } + -- | local reference to on stack value + | RRef_Loc + { rrefLev :: !Int -- ^ level + , rrefEntry :: !Int -- ^ entry inside level + } + -- | tag of memory/constructor node referred to by other ref (not yet used) + | RRef_Tag + { rrefRef :: !RRef -- ^ of what this is the tag + } + -- | fld of memory/constructor node referred to by other ref + | RRef_Fld + { rrefRef :: !RRef -- ^ of what this is a field + , rrefEntry :: !Int -- ^ entry inside level + } + -- | debug variant, holding original name + | RRef_Dbg + { rrefNm :: !HsName + } + deriving (Eq,Ord) + +instance Show RRef where + show _ = "RRef" + +noRRef = RRef_Dbg hsnUnknown + + + +-- | RRef to HsName mapping for use during running when a more informative name is required. +-- The representation is lazily via function +type Ref2Nm = RRef -> Maybe HsName + + + +-- | HsName to RRef mapping for resolving references during translation to CoreRun +type Nm2RefMp = Map.Map HsName RRef + +-- | Inverse of a `Nm2RefMp` +nm2RefMpInverse :: Nm2RefMp -> Ref2Nm +nm2RefMpInverse m + | Map.null m = const Nothing + | otherwise = flip Map.lookup inv + where inv = Map.fromList [ (r,n) | (n,r) <- Map.toList m ] + +-- | Empty Ref2Nm +ref2nmEmpty :: Ref2Nm +ref2nmEmpty = const Nothing + +-- | Union, left-biased +ref2nmUnion :: Ref2Nm -> Ref2Nm -> Ref2Nm +ref2nmUnion m1 m2 = \r -> m1 r <|> m2 r + +-- Alt --------------------------------------------------------- +data Alt = Alt_Alt {ref2nm_Alt_Alt :: !(Ref2Nm),pat_Alt_Alt :: !(Pat),expr_Alt_Alt :: !(Exp)} +-- Exp --------------------------------------------------------- +data Exp = Exp_SExp {sexpr_Exp_SExp :: !(SExp)} + | Exp_Tup {tag_Exp_Tup :: !(CTag),args_Exp_Tup :: !((CRArray Exp))} + | Exp_Let {lev_Exp_Let :: !(Int),firstOff_Exp_Let :: !(Int),ref2nm_Exp_Let :: !(Ref2Nm),binds_Exp_Let :: !((CRArray Bind)),body_Exp_Let :: !(Exp)} + | Exp_App {func_Exp_App :: !(Exp),args_Exp_App :: !((CRArray Exp))} + | Exp_Lam {lev_Exp_Lam :: !(Int),nrArgs_Exp_Lam :: !(Int),nrBinds_Exp_Lam :: !(Int),stkDepth_Exp_Lam :: !(Int),ref2nm_Exp_Lam :: !(Ref2Nm),body_Exp_Lam :: !(Exp)} + | Exp_Force {expr_Exp_Force :: !(Exp)} + | Exp_Ret {expr_Exp_Ret :: !(Exp)} + | Exp_RetCase {nrBinds_Exp_RetCase :: !(Int),expr_Exp_RetCase :: !(Exp)} + | Exp_Tail {expr_Exp_Tail :: !(Exp)} + | Exp_Case {expr_Exp_Case :: !(SExp),alts_Exp_Case :: !((CRArray Alt))} + | Exp_FFI {prim_Exp_FFI :: !(RunPrim),args_Exp_FFI :: !((CRArray Exp))} + | Exp_Dbg {msg_Exp_Dbg :: !(String)} +-- Mod --------------------------------------------------------- +data Mod = Mod_Mod {ref2nm_Mod_Mod :: !(Ref2Nm),moduleNm_Mod_Mod :: !(HsName),moduleNr_Mod_Mod :: !(Int),stkDepth_Mod_Mod :: !(Int),binds_Mod_Mod :: !((CRArray Bind)),body_Mod_Mod :: !(Exp)} +-- Pat --------------------------------------------------------- +data Pat = Pat_Con {tag_Pat_Con :: !(CTag)} + | Pat_BoolExpr {expr_Pat_BoolExpr :: !(Exp)} +-- SExp -------------------------------------------------------- +data SExp = SExp_Var {ref_SExp_Var :: !(RRef)} + | SExp_Int {int_SExp_Int :: !(Int)} + | SExp_Char {char_SExp_Char :: !(Char)} + | SExp_String {str_SExp_String :: !(String)} + | SExp_Integer {integer_SExp_Integer :: !(Integer)} diff --git a/src/UHC/Light/Compiler/CoreRun/Pretty.hs b/src/UHC/Light/Compiler/CoreRun/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Pretty.hs @@ -0,0 +1,557 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/CoreRun/Pretty) +module UHC.Light.Compiler.CoreRun.Pretty(ppMod', ppExp') where + +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.CoreRun +import UHC.Light.Compiler.Ty.Pretty +import qualified Data.Vector as V +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty + + + + + + + + + + +-- | Not all AST datatypes are expressed as AG, inherited info therefore implemented manually +data InhPP + = InhPP + { r2nInhPP :: Ref2Nm + , optsInhPP :: EHCOpts + } + +mkEmptyInhPP :: EHCOpts -> InhPP +mkEmptyInhPP opts = InhPP ref2nmEmpty opts + +-- | Add new +r2nAdd :: Ref2Nm -> InhPP -> InhPP +r2nAdd r2n i@(InhPP {r2nInhPP=r2n', optsInhPP=opts}) + | CoreOpt_RunPPNames `elem` ehcOptCoreOpts opts = i {r2nInhPP = ref2nmUnion r2n r2n'} + | otherwise = i + +-- | PP using InhPP +ppRRef :: InhPP -> RRef -> PP_Doc +ppRRef inhpp r = ppMbPost ppCurly (r2nInhPP inhpp r) r + + + +ppMod'' :: InhPP -> Mod -> PP_Doc +ppMod'' inhpp x = pp_Syn_Mod $ wrap_Mod (sem_Mod x) (Inh_Mod {inhpp_Inh_Mod=inhpp}) + +ppExp'' :: InhPP -> Exp -> PP_Doc +ppExp'' inhpp x = pp_Syn_Exp $ wrap_Exp (sem_Exp x) (Inh_Exp {inhpp_Inh_Exp=inhpp}) + +ppSExp'' :: InhPP -> SExp -> PP_Doc +ppSExp'' inhpp x = ppExp'' inhpp (Exp_SExp x) + +ppAlt'' :: InhPP -> Alt -> PP_Doc +ppAlt'' inhpp x = pp_Syn_Alt $ wrap_Alt (sem_Alt x) (Inh_Alt {inhpp_Inh_Alt=inhpp}) + + + +ppMod' :: EHCOpts -> Mod -> PP_Doc +ppMod' opts = ppMod'' (mkEmptyInhPP opts) + +ppExp' :: EHCOpts -> Exp -> PP_Doc +ppExp' opts = ppExp'' (mkEmptyInhPP opts) + +ppSExp' :: EHCOpts -> SExp -> PP_Doc +ppSExp' opts = ppSExp'' (mkEmptyInhPP opts) + +ppAlt' :: EHCOpts -> Alt -> PP_Doc +ppAlt' opts = ppAlt'' (mkEmptyInhPP opts) + + + +instance Show Mod where + show _ = "Mod" + +instance Show Exp where + show _ = "Exp" + +instance Show SExp where + show _ = "SExp" + +instance Show Alt where + show _ = "Alt" + + + +instance PP Mod where + pp = ppMod' defaultEHCOpts + +instance PP Exp where + pp = ppExp' defaultEHCOpts + +instance PP SExp where + pp = ppSExp' defaultEHCOpts + +instance PP Alt where + pp = ppAlt' defaultEHCOpts + + + +instance PP RRef where + pp (RRef_Glb m e) = "#g" >|< ppDots [m,e] + pp (RRef_Loc l e) = "#l" >|< ppDots [l,e] + pp (RRef_Tag r ) = ppDots [pp r, pp "tg"] + pp (RRef_Fld r e) = ppDots [pp r, pp e] + pp (RRef_Dbg n ) = "##" >|< n + + + +ppBinds'' :: InhPP -> (Int -> RRef) -> Int -> CRArray Bind -> PP_Doc +ppBinds'' inhpp mkr off bs = vlist [ (ppRRef inhpp $ mkr $ off+i) >|< ":" >#< ppExp'' inhpp e | (i,e) <- craAssocs bs ] + +-- Alt --------------------------------------------------------- +{- + visit 0: + inherited attribute: + inhpp : InhPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Alt: + child ref2nm : {Ref2Nm} + child pat : Pat + child expr : Exp + visit 0: + local inhpp : _ +-} +-- cata +sem_Alt :: Alt -> + T_Alt +sem_Alt (Alt_Alt _ref2nm _pat _expr) = + (sem_Alt_Alt _ref2nm (sem_Pat _pat) (sem_Exp _expr)) +-- semantic domain +type T_Alt = InhPP -> + ( PP_Doc) +data Inh_Alt = Inh_Alt {inhpp_Inh_Alt :: !(InhPP)} +data Syn_Alt = Syn_Alt {pp_Syn_Alt :: !(PP_Doc)} +wrap_Alt :: T_Alt -> + Inh_Alt -> + Syn_Alt +wrap_Alt sem (Inh_Alt _lhsIinhpp) = + (let ( _lhsOpp) = sem _lhsIinhpp + in (Syn_Alt _lhsOpp)) +sem_Alt_Alt :: Ref2Nm -> + T_Pat -> + T_Exp -> + T_Alt +sem_Alt_Alt ref2nm_ pat_ expr_ = + (\ _lhsIinhpp -> + (case (r2nAdd ref2nm_ _lhsIinhpp) of + { _inhpp -> + (case (_inhpp) of + { _exprOinhpp -> + (case (_inhpp) of + { _patOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case (pat_ _patOinhpp) of + { ( _patIpp) -> + (case (_patIpp >#< "->" >#< _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) })) +-- Exp --------------------------------------------------------- +{- + visit 0: + inherited attribute: + inhpp : InhPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative SExp: + child sexpr : SExp + alternative Tup: + child tag : {CTag} + child args : {CRArray Exp} + alternative Let: + child lev : {Int} + child firstOff : {Int} + child ref2nm : {Ref2Nm} + child binds : {CRArray Bind} + child body : Exp + visit 0: + local inhpp : _ + alternative App: + child func : Exp + child args : {CRArray Exp} + alternative Lam: + child lev : {Int} + child nrArgs : {Int} + child nrBinds : {Int} + child stkDepth : {Int} + child ref2nm : {Ref2Nm} + child body : Exp + visit 0: + local inhpp : _ + alternative Force: + child expr : Exp + alternative Ret: + child expr : Exp + alternative RetCase: + child nrBinds : {Int} + child expr : Exp + alternative Tail: + child expr : Exp + alternative Case: + child expr : SExp + child alts : {CRArray Alt} + alternative FFI: + child prim : {RunPrim} + child args : {CRArray Exp} + alternative Dbg: + child msg : {String} +-} +-- cata +sem_Exp :: Exp -> + T_Exp +sem_Exp (Exp_SExp _sexpr) = + (sem_Exp_SExp (sem_SExp _sexpr)) +sem_Exp (Exp_Tup _tag _args) = + (sem_Exp_Tup _tag _args) +sem_Exp (Exp_Let _lev _firstOff _ref2nm _binds _body) = + (sem_Exp_Let _lev _firstOff _ref2nm _binds (sem_Exp _body)) +sem_Exp (Exp_App _func _args) = + (sem_Exp_App (sem_Exp _func) _args) +sem_Exp (Exp_Lam _lev _nrArgs _nrBinds _stkDepth _ref2nm _body) = + (sem_Exp_Lam _lev _nrArgs _nrBinds _stkDepth _ref2nm (sem_Exp _body)) +sem_Exp (Exp_Force _expr) = + (sem_Exp_Force (sem_Exp _expr)) +sem_Exp (Exp_Ret _expr) = + (sem_Exp_Ret (sem_Exp _expr)) +sem_Exp (Exp_RetCase _nrBinds _expr) = + (sem_Exp_RetCase _nrBinds (sem_Exp _expr)) +sem_Exp (Exp_Tail _expr) = + (sem_Exp_Tail (sem_Exp _expr)) +sem_Exp (Exp_Case _expr _alts) = + (sem_Exp_Case (sem_SExp _expr) _alts) +sem_Exp (Exp_FFI _prim _args) = + (sem_Exp_FFI _prim _args) +sem_Exp (Exp_Dbg _msg) = + (sem_Exp_Dbg _msg) +-- semantic domain +type T_Exp = InhPP -> + ( PP_Doc) +data Inh_Exp = Inh_Exp {inhpp_Inh_Exp :: !(InhPP)} +data Syn_Exp = Syn_Exp {pp_Syn_Exp :: !(PP_Doc)} +wrap_Exp :: T_Exp -> + Inh_Exp -> + Syn_Exp +wrap_Exp sem (Inh_Exp _lhsIinhpp) = + (let ( _lhsOpp) = sem _lhsIinhpp + in (Syn_Exp _lhsOpp)) +sem_Exp_SExp :: T_SExp -> + T_Exp +sem_Exp_SExp sexpr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _sexprOinhpp -> + (case (sexpr_ _sexprOinhpp) of + { ( _sexprIpp) -> + (case (_sexprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_Tup :: CTag -> + (CRArray Exp) -> + T_Exp +sem_Exp_Tup tag_ args_ = + (\ _lhsIinhpp -> + (case ("alloc" >#< ctagTag tag_ >|< ppParensCommas (map (ppExp'' _lhsIinhpp) $ V.toList args_)) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_Exp_Let :: Int -> + Int -> + Ref2Nm -> + (CRArray Bind) -> + T_Exp -> + T_Exp +sem_Exp_Let lev_ firstOff_ ref2nm_ binds_ body_ = + (\ _lhsIinhpp -> + (case (r2nAdd ref2nm_ _lhsIinhpp) of + { _inhpp -> + (case (_inhpp) of + { _bodyOinhpp -> + (case (body_ _bodyOinhpp) of + { ( _bodyIpp) -> + (case ("let" >#< ppBinds'' _inhpp (RRef_Loc lev_) firstOff_ binds_ >#< "in" >-< _bodyIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) })) +sem_Exp_App :: T_Exp -> + (CRArray Exp) -> + T_Exp +sem_Exp_App func_ args_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _funcOinhpp -> + (case (func_ _funcOinhpp) of + { ( _funcIpp) -> + (case ("app" >#< ppParens _funcIpp >|< ppParensCommas (map (ppExp'' _lhsIinhpp) $ V.toList args_)) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_Lam :: Int -> + Int -> + Int -> + Int -> + Ref2Nm -> + T_Exp -> + T_Exp +sem_Exp_Lam lev_ nrArgs_ nrBinds_ stkDepth_ ref2nm_ body_ = + (\ _lhsIinhpp -> + (case (r2nAdd ref2nm_ _lhsIinhpp) of + { _inhpp -> + (case (_inhpp) of + { _bodyOinhpp -> + (case (body_ _bodyOinhpp) of + { ( _bodyIpp) -> + (case ("\\" >|< "@" >|< lev_ >#< ppCommas [if nrArgs_ > 0 then pp nrArgs_ else pp "thk", pp nrBinds_, pp stkDepth_] >#< "->" >#< _bodyIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) })) +sem_Exp_Force :: T_Exp -> + T_Exp +sem_Exp_Force expr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case ("eval" >|< ppParens _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_Ret :: T_Exp -> + T_Exp +sem_Exp_Ret expr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case ("ret" >|< ppParens _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_RetCase :: Int -> + T_Exp -> + T_Exp +sem_Exp_RetCase nrBinds_ expr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case ("retcase" >|< nrBinds_ >|< ppParens _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_Tail :: T_Exp -> + T_Exp +sem_Exp_Tail expr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case ("tail" >|< ppParens _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_Case :: T_SExp -> + (CRArray Alt) -> + T_Exp +sem_Exp_Case expr_ alts_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case ("case" >#< _exprIpp >#< "of" + >-< indent 1 (vlist $ map (ppAlt'' _lhsIinhpp) $ V.toList alts_)) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_Exp_FFI :: RunPrim -> + (CRArray Exp) -> + T_Exp +sem_Exp_FFI prim_ args_ = + (\ _lhsIinhpp -> + (case ("ffi" >#< show prim_ >|< ppParensCommas (map (ppExp'' _lhsIinhpp) $ V.toList args_)) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_Exp_Dbg :: String -> + T_Exp +sem_Exp_Dbg msg_ = + (\ _lhsIinhpp -> + (case (ppCurly $ "dbg:" >#< msg_) of + { _lhsOpp -> + ( _lhsOpp) })) +-- Mod --------------------------------------------------------- +{- + visit 0: + inherited attribute: + inhpp : InhPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Mod: + child ref2nm : {Ref2Nm} + child moduleNm : {HsName} + child moduleNr : {Int} + child stkDepth : {Int} + child binds : {CRArray Bind} + child body : Exp + visit 0: + local inhpp : _ +-} +-- cata +sem_Mod :: Mod -> + T_Mod +sem_Mod (Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _binds _body) = + (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth _binds (sem_Exp _body)) +-- semantic domain +type T_Mod = InhPP -> + ( PP_Doc) +data Inh_Mod = Inh_Mod {inhpp_Inh_Mod :: !(InhPP)} +data Syn_Mod = Syn_Mod {pp_Syn_Mod :: !(PP_Doc)} +wrap_Mod :: T_Mod -> + Inh_Mod -> + Syn_Mod +wrap_Mod sem (Inh_Mod _lhsIinhpp) = + (let ( _lhsOpp) = sem _lhsIinhpp + in (Syn_Mod _lhsOpp)) +sem_Mod_Mod :: Ref2Nm -> + HsName -> + Int -> + Int -> + (CRArray Bind) -> + T_Exp -> + T_Mod +sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ binds_ body_ = + (\ _lhsIinhpp -> + (case (r2nAdd ref2nm_ _lhsIinhpp) of + { _inhpp -> + (case (_inhpp) of + { _bodyOinhpp -> + (case (body_ _bodyOinhpp) of + { ( _bodyIpp) -> + (case ("module" >#< moduleNm_ >#< ppCommas [moduleNr_, stkDepth_] >|< ":" >#< _bodyIpp + >-< ppBinds'' _inhpp (RRef_Glb moduleNr_) 0 binds_) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) })) +-- Pat --------------------------------------------------------- +{- + visit 0: + inherited attribute: + inhpp : InhPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Con: + child tag : {CTag} + alternative BoolExpr: + child expr : Exp +-} +-- cata +sem_Pat :: Pat -> + T_Pat +sem_Pat (Pat_Con _tag) = + (sem_Pat_Con _tag) +sem_Pat (Pat_BoolExpr _expr) = + (sem_Pat_BoolExpr (sem_Exp _expr)) +-- semantic domain +type T_Pat = InhPP -> + ( PP_Doc) +sem_Pat_Con :: CTag -> + T_Pat +sem_Pat_Con tag_ = + (\ _lhsIinhpp -> + (case (pp $ ctagTag tag_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_Pat_BoolExpr :: T_Exp -> + T_Pat +sem_Pat_BoolExpr expr_ = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _exprOinhpp -> + (case (expr_ _exprOinhpp) of + { ( _exprIpp) -> + (case (_exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +-- SExp -------------------------------------------------------- +{- + visit 0: + inherited attribute: + inhpp : InhPP + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Var: + child ref : {RRef} + alternative Int: + child int : {Int} + alternative Char: + child char : {Char} + alternative String: + child str : {String} + alternative Integer: + child integer : {Integer} +-} +-- cata +sem_SExp :: SExp -> + T_SExp +sem_SExp (SExp_Var _ref) = + (sem_SExp_Var _ref) +sem_SExp (SExp_Int _int) = + (sem_SExp_Int _int) +sem_SExp (SExp_Char _char) = + (sem_SExp_Char _char) +sem_SExp (SExp_String _str) = + (sem_SExp_String _str) +sem_SExp (SExp_Integer _integer) = + (sem_SExp_Integer _integer) +-- semantic domain +type T_SExp = InhPP -> + ( PP_Doc) +sem_SExp_Var :: RRef -> + T_SExp +sem_SExp_Var ref_ = + (\ _lhsIinhpp -> + (case (ppRRef _lhsIinhpp ref_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_SExp_Int :: Int -> + T_SExp +sem_SExp_Int int_ = + (\ _lhsIinhpp -> + (case (pp int_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_SExp_Char :: Char -> + T_SExp +sem_SExp_Char char_ = + (\ _lhsIinhpp -> + (case (pp $ show char_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_SExp_String :: String -> + T_SExp +sem_SExp_String str_ = + (\ _lhsIinhpp -> + (case (pp $ show str_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_SExp_Integer :: Integer -> + T_SExp +sem_SExp_Integer integer_ = + (\ _lhsIinhpp -> + (case (pp integer_) of + { _lhsOpp -> + ( _lhsOpp) })) diff --git a/src/UHC/Light/Compiler/CoreRun/Prim.hs b/src/UHC/Light/Compiler/CoreRun/Prim.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Prim.hs @@ -0,0 +1,208 @@ +module UHC.Light.Compiler.CoreRun.Prim +( RunPrim (..) +, showRunPrim +, allRunPrimMp ) +where +import qualified Data.Map as Map + +{-# LINE 21 "src/ehc/CoreRun/Prim.chs" #-} +-- | Primitives. +-- Assumption: name of primitive starts with 3 choosable char + exact name of prim +data RunPrim + = + -- Int arithmetic + RP_primAddInt + | RP_primSubInt + | RP_primMulInt + | RP_primDivInt + | RP_primEqInt + | RP_primLeInt + | RP_primNeInt + + -- UHC.IOBase: Exception handling + | RP_primCatchException + + -- UHC.MutVar + | RP_primNewMutVar + | RP_primReadMutVar + | RP_primWriteMutVar + | RP_primSameMutVar + + -- UHC.Base + | RP_primPackedStringToInteger + | RP_primPackedStringNull -- :: PackedString -> Bool + | RP_primPackedStringHead -- :: PackedString -> Char + | RP_primPackedStringTail -- :: PackedString -> PackedString + | RP_primShowInteger + + -- UHC.Base: Bounded + | RP_primMaxInt + | RP_primMinInt + + -- UHC.Prims: conversion + | RP_primIntegerToInt32 + | RP_primIntToInteger + | RP_primIntegerToInt + + -- System.IO + -- * The IO monad + + -- IO -- instance MonadFix + | RP_fixIO -- :: (a -> IO a) -> IO a + + -- * Files and handles + + -- FilePath -- :: String + + -- Handle -- abstract, instance of: Eq, Show. + + -- ** Standard handles + + -- | Three handles are allocated during program initialisation, + -- and are initially open. + + | RP_stdin + | RP_stdout + | RP_stderr -- :: Handle + + -- * Opening and closing files + + -- ** Opening files + + | RP_withFile + | RP_openFile -- :: FilePath -> IOMode -> IO Handle + -- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), + + -- ** Closing files + + | RP_hClose -- :: Handle -> IO () + + -- ** Special cases + + -- | These functions are also exported by the "Prelude". + + | RP_readFile -- :: FilePath -> IO String + | RP_writeFile -- :: FilePath -> String -> IO () + | RP_appendFile -- :: FilePath -> String -> IO () + + -- ** File locking + + -- $locking + + -- * Operations on handles + + -- ** Determining and changing the size of a file + + | RP_hFileSize -- :: Handle -> IO Integer +-- #ifdef __GLASGOW_HASKELL__ + | RP_hSetFileSize -- :: Handle -> Integer -> IO () +-- #endif + + -- ** Detecting the end of input + + | RP_hIsEOF -- :: Handle -> IO Bool + | RP_isEOF -- :: IO Bool + + -- ** Buffering operations + + -- BufferMode(NoBuffering,LineBuffering,BlockBuffering), + | RP_hSetBuffering -- :: Handle -> BufferMode -> IO () + | RP_hGetBuffering -- :: Handle -> IO BufferMode + | RP_hFlush -- :: Handle -> IO () + + -- ** Repositioning handles + + | RP_hGetPosn -- :: Handle -> IO HandlePosn + | RP_hSetPosn -- :: HandlePosn -> IO () + -- HandlePosn, -- abstract, instance of: Eq, Show. + + | RP_hSeek -- :: Handle -> SeekMode -> Integer -> IO () + -- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), +-- #if !defined(__NHC__) + | RP_hTell -- :: Handle -> IO Integer +-- #endif + + -- ** Handle properties + + | RP_hIsOpen + | RP_hIsClosed -- :: Handle -> IO Bool + | RP_hIsReadable + | RP_hIsWritable -- :: Handle -> IO Bool + | RP_hIsSeekable -- :: Handle -> IO Bool + + -- ** Terminal operations (not portable: GHC\/Hugs only) + +-- #if !defined(__NHC__) + | RP_hIsTerminalDevice -- :: Handle -> IO Bool + + | RP_hSetEcho -- :: Handle -> Bool -> IO () + | RP_hGetEcho -- :: Handle -> IO Bool +-- #endif + + -- ** Showing handle state (not portable: GHC only) + +-- #ifdef __GLASGOW_HASKELL__ + | RP_hShow -- :: Handle -> IO String +-- #endif + + -- * Text input and output + + -- ** Text input + | RP_hWaitForInput -- :: Handle -> Int -> IO Bool + | RP_hReady -- :: Handle -> IO Bool + | RP_hGetChar -- :: Handle -> IO Char + | RP_hGetLine -- :: Handle -> IO [Char] + | RP_hLookAhead -- :: Handle -> IO Char + | RP_hGetContents -- :: Handle -> IO [Char] + -- ** Text output + + | RP_hPutChar -- :: Handle -> Char -> IO () + | RP_hPutStr -- :: Handle -> [Char] -> IO () + | RP_hPutStrLn -- :: Handle -> [Char] -> IO () + | RP_hPrint -- :: Show a => Handle -> a -> IO () + + -- ** Special cases for standard input and output + + -- | These functions are also exported by the "Prelude". + + | RP_interact -- :: (String -> String) -> IO () + -- putChar -- :: Char -> IO () + -- putStr -- :: String -> IO () + -- putStrLn -- :: String -> IO () + -- print -- :: Show a => a -> IO () + -- getChar -- :: IO Char + -- getLine -- :: IO String + -- getContents -- :: IO String + | RP_readIO -- :: Read a => String -> IO a + | RP_readLn -- :: Read a => IO a + + -- * Binary input and output + | RP_withBinaryFile + | RP_openBinaryFile -- :: FilePath -> IOMode -> IO Handle + | RP_hSetBinaryMode -- :: Handle -> Bool -> IO () + | RP_hPutBuf -- :: Handle -> Ptr a -> Int -> IO () + | RP_hGetBuf -- :: Handle -> Ptr a -> Int -> IO Int +-- #if !defined(__NHC__) && !defined(__HUGS__) + | RP_hPutBufNonBlocking -- :: Handle -> Ptr a -> Int -> IO Int + | RP_hGetBufNonBlocking -- :: Handle -> Ptr a -> Int -> IO Int +-- #endif + -- * Temporary files + + | RP_openTempFile + | RP_openBinaryTempFile + + -- * Additional ones + | RP_primShowHandle -- :: Handle -> String + | RP_primEqHandle -- :: Handle -> Handle -> Bool + + deriving (Show, Eq, Ord, Enum, Bounded) + +{-# LINE 214 "src/ehc/CoreRun/Prim.chs" #-} +-- | Show prim without initial 3 chars +showRunPrim :: RunPrim -> String +showRunPrim p = drop 3 $ show p + +{-# LINE 220 "src/ehc/CoreRun/Prim.chs" #-} +allRunPrimMp :: Map.Map String RunPrim +allRunPrimMp = Map.fromList [ (showRunPrim p, p) | p <- [ minBound .. maxBound ] ] + diff --git a/src/UHC/Light/Compiler/CoreRun/Run.hs b/src/UHC/Light/Compiler/CoreRun/Run.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Run.hs @@ -0,0 +1,141 @@ +module UHC.Light.Compiler.CoreRun.Run +( module Control.Monad.RWS.Strict, module Control.Monad, module Control.Monad.Error +, RunRd (..), emptyRunRd +, RunSt (..), emptyRunSt +, RunSem (..) +, RunT', RunT +, err +, runCoreRun +, modifyIORefM ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.CoreRun +import UHC.Light.Compiler.CoreRun.Prim +import qualified UHC.Util.FastSeq as Seq +import qualified Data.Map as Map +import UHC.Util.Pretty +import Data.Maybe +import Data.Monoid +import Data.IORef +import Control.Monad +import Control.Monad.Error +import Control.Monad.RWS.Strict + +{-# LINE 39 "src/ehc/CoreRun/Run.chs" #-} +data RunRd + = RunRd + {- cenvLamMp :: LamMp + -} + +emptyRunRd + = RunRd + +{-# LINE 63 "src/ehc/CoreRun/Run.chs" #-} +data RunSt + = RunSt + {- cenvLamMp :: LamMp + -} + +emptyRunSt + = RunSt + +{-# LINE 73 "src/ehc/CoreRun/Run.chs" #-} +-- | Factored out stuff, not much in it but intended to accomodate variability in running +class (Monad m, MonadIO m, Functor m) => RunSem r s v m a + -- | r -> a s + -- , s -> a r + | r s -> v a + where + -- | Provide initial state + rsemInitial :: m (r,s,a) + + -- | Setup whatever needs to be setup + rsemSetup :: EHCOpts -> [Mod] -> Mod -> RunT' r s v m () + + -- | Set tracing on/off + rsemSetTrace :: Bool -> RunT' r s v m () + rsemSetTrace _ = return () + + -- | Exp + rsemExp :: Exp -> RunT' r s v m a + + -- | SExp + rsemSExp :: SExp -> RunT' r s v m a + + -- | Alt + rsemAlt :: Alt -> RunT' r s v m a + rsemAlt a = do + case a of + Alt_Alt {expr_Alt_Alt=e} -> rsemExp e + {-# INLINE rsemAlt #-} + + -- | Force evaluation, subsumes rsemDeref + rsemEvl :: v -> RunT' r s v m a + + -- | Dereference: get rid of intermediate indirections + rsemDeref :: v -> RunT' r s v m a + + -- | Apply primitive to arguments + rsemPrim :: RunPrim -> CRArray v -> RunT' r s v m a + + -- | Push, i.e. lift/put from v to internal machinery + rsemPush :: v -> RunT' r s v m a + -- | Pop, i.e. lift/get from internal machinery to v + rsemPop :: a -> RunT' r s v m v + -- | Construct a data constr/tuple + rsemNode :: Int -> CRMArray v -> RunT' r s v m v + + -- | GC new level of roots (followed by multiple pushes followed by single pop for all) + rsemGcEnterRootLevel :: RunT' r s v m () + rsemGcEnterRootLevel = return () + {-# INLINE rsemGcEnterRootLevel #-} + -- | GC push as root + rsemGcPushRoot :: v -> RunT' r s v m () + rsemGcPushRoot _ = return () + {-# INLINE rsemGcPushRoot #-} + -- | GC pop as root + rsemGcLeaveRootLevel :: RunT' r s v m () + rsemGcLeaveRootLevel = return () + {-# INLINE rsemGcLeaveRootLevel #-} + +{-# LINE 136 "src/ehc/CoreRun/Run.chs" #-} +-- type RunT' s m a = ErrorT Err (RWST r w s m) a +-- type RunT m a = RunT' RunRd RunWr RunSt m a +-- type RunT' s m a = ErrorT Err (StateT s m) a +type RunT' r s v m a = ErrorT Err (RWST r () s m) a +type RunT v m a = RunT' RunRd RunSt v m a + +{-# LINE 148 "src/ehc/CoreRun/Run.chs" #-} +err :: (RunSem r s v m a, PP msg) => msg -> RunT' r s v m b +err msg = throwError $ rngLift emptyRange Err_PP $ pp msg + +{-# LINE 158 "src/ehc/CoreRun/Run.chs" #-} +runCoreRun + :: forall r s v m a . + (RunSem r s v m a) + => EHCOpts + -> [Mod] + -> Mod + -> RunT' r s v m a + -> m (Either Err v) -- RunT' r s v m a +runCoreRun opts modImpL mod m = do + (r, s, _ :: a) <- rsemInitial + -- let s = error "runCoreRun.RWS" + -- r = error "runCoreRun.Reader" + (e, _, _) <- + runRWST (runErrorT $ do + rsemSetup opts modImpL mod + (m >>= rsemPop >>= rsemDeref >>= rsemPop)) + r s + return e + +{-# LINE 183 "src/ehc/CoreRun/Run.chs" #-} +modifyIORefM :: IORef a -> (a -> IO a) -> IO () +modifyIORefM r m = readIORef r >>= m >>= writeIORef r +{-# INLINE modifyIORefM #-} diff --git a/src/UHC/Light/Compiler/CoreRun/Run/Val.hs b/src/UHC/Light/Compiler/CoreRun/Run/Val.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Run/Val.hs @@ -0,0 +1,827 @@ +{-# LANGUAGE MagicHash #-} +-- {-# OPTIONS_GHC -O3 #-} + +module UHC.Light.Compiler.CoreRun.Run.Val +( module System.IO +, module Data.IORef +, module Data.Int, module Data.Word +, module GHC.Ptr +, RVal (..) +, mkTuple, mkUnit +, RValV, RValMV +, HSMarshall (..) +, HpPtr, nullPtr, isNullPtr, newHeap, Heap (..) +, heapGetM, heapGetM', heapAllocM, heapAllocAsPtrM, heapUpdM, heapSetM, heapSetM' +, RValCxt (..), emptyRValCxt +, mustReturn, needNotReturn, rvalRetEvl, rvalPrimargEvl +, vecReverseForM_ +, mvecAllocInit, mvecAlloc, mvecFillFromV, mvecFillFromMV, mvecAllocFillFromV, mvecAppend, mvecToList +, mvecReverseForM_ +, ptr2valM, ref2valM +, RValEnv (..), newRValEnv +, renvTopFrameM +, dumpEnvM +, updTopFrameM +, renvFrStkPush1, renvFrStkReversePushMV +, renvFrStkPop1, renvFrStkPopMV, renvFrStkReversePopMV, renvFrStkReversePopInMV +, rsemTr', rsemTr +, RValT ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.CoreRun +import UHC.Light.Compiler.CoreRun.Run +import UHC.Light.Compiler.CoreRun.Pretty +import UHC.Util.Pretty +import Control.Monad.Primitive +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import qualified Data.Vector.Generic as GV +import Data.Data +import Data.Typeable +import System.IO +import System.IO.Unsafe +import Data.IORef +import Data.Int +import Data.Word +import qualified Data.ByteString.Char8 as BSC8 +import GHC.Ptr (Ptr (..)) +import GHC.Exts (Addr#) + +{-# LINE 63 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Representation of run value +data RVal + = + -- Value representations for running itself: literals + RVal_Lit + { rvalSExp :: !SExp -- ^ a simple literal + } + | RVal_Char {-# UNPACK #-} !Char + | RVal_Int {-# UNPACK #-} !Int +{- + | RVal_Int8 {-# UNPACK #-} !Int8 + | RVal_Int16 {-# UNPACK #-} !Int16 +-} + | RVal_Int32 {-# UNPACK #-} !Int32 +{- + | RVal_Int64 {-# UNPACK #-} !Int64 + | RVal_Word {-# UNPACK #-} !Word + | RVal_Word8 {-# UNPACK #-} !Word8 + | RVal_Word16 {-# UNPACK #-} !Word16 + | RVal_Word32 {-# UNPACK #-} !Word32 + | RVal_Word64 {-# UNPACK #-} !Word64 +-} + | RVal_Integer !Integer + | RVal_Float {-# UNPACK #-} !Float + | RVal_Double {-# UNPACK #-} !Double + | RVal_PackedString !BSC8.ByteString -- ^ packed string, equivalent of low level C string (could be replaced by something more efficient) + + -- Value representations for running itself: function, application, etc + | RVal_Lam + { rvalBody :: !Exp -- ^ a Exp_Lam, which also encodes a thunk + , rvalSLRef :: !(IORef HpPtr) -- ^ static link to enclosing stack frame + } + | RVal_Thunk -- ^ special case of Lam taking 0 params + { rvalBody :: !Exp -- ^ Exp taking no arguments (thunk) + , rvalSLRef :: !(IORef HpPtr) -- ^ static link to enclosing stack frame + } + | RVal_Node + { rvalTag :: !Int -- ^ node tag + , rvalNdVals :: !RValMV -- ^ fields + } + | RVal_App + { rvalFun :: !RVal -- ^ a RVal_App or RVal_PApp + , rvalArgs :: !RValMV -- ^ already applied args + } + | RVal_Frame + { rvalRef2Nm :: Ref2Nm -- ^ ref to name mapping + , rvalSLRef :: !(IORef HpPtr) -- ^ immediately outer lexical level frame + , rvalLev :: !Int -- ^ the lexical level this frame is on + , rvalFrVals :: !RValMV -- ^ actual frame values, either literals or pointers to heap locations (so we can update them, share them) + , rvalFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame + } + | RVal_Ptr + { rvalPtrRef :: !(IORef HpPtr) -- ^ ptr/index into heap + } + | RVal_Fwd + { rvalPtr :: !HpPtr -- ^ forwarding ptr, only used during GC + } + | RVal_BlackHole + | RVal_None + + -- Value representations for library or runtime env (not Core specific) + | RHsV_MutVar !(IORef RVal) -- ^ mutable var + | RHsV_Handle !Handle -- ^ IO handle + | RHsV_Addr Addr# -- ^ Addr inside Ptr + +instance Show RVal where + show _ = "RVal" + +ppRVal' :: (HpPtr -> IO (Maybe RVal)) -> RVal -> IO PP_Doc +ppRVal' lkptr rval = case rval of + RVal_Lit e -> dfltpp e + RVal_Char v -> dfltpp $ show v + RVal_Int v -> dfltpp v +{- + RVal_Int8 v -> dfltpp $ show v + RVal_Int16 v -> dfltpp $ show v +-} + RVal_Int32 v -> dfltpp $ show v +{- + RVal_Int64 v -> dfltpp $ show v + RVal_Word v -> dfltpp $ show v + RVal_Word8 v -> dfltpp $ show v + RVal_Word16 v -> dfltpp $ show v + RVal_Word32 v -> dfltpp $ show v + RVal_Word64 v -> dfltpp $ show v +-} + RVal_Integer v -> dfltpp v + RVal_Float v -> dfltpp v + RVal_Double v -> dfltpp $ show v + RVal_PackedString v -> dfltpp $ show v + RVal_Lam b slref -> dfltpp b + RVal_Thunk e slref -> return $ ppBrackets e + RVal_Node t vs -> do + vl <- mvecToList vs + return $ t >|< ppBracketsCommas vl + RVal_App f as -> dfltpp f -- return $ ppBrackets $ f >|< "@" >|< (ppParensCommas $ V.toList as) + RVal_Ptr pref -> do + p <- readIORef pref + vpp <- lkptr p >>= maybe (return empty) (\v -> ppRVal' lkptr v >>= \vpp -> return $ " -> " >|< vpp) + return $ "*" >|< p >|< vpp + RVal_Fwd p -> return $ "f*" >|< p + RVal_Frame _ slref lv vs spref -> do + sl <- readIORef slref + sp <- readIORef spref + vl <- mvecToList vs + vlpp <- forM (zip [0..(sp-1)] vl) $ \(i,v) -> ppRVal' lkptr v >>= \vpp -> return $ i >|< ":" >#< vpp + return $ (ppBracketsCommas $ ["sl=" >|< sl, "lev=" >|< lv, "sz=" >|< MV.length vs, "sp=" >|< sp]) + >-< vlist vlpp + RVal_BlackHole -> dfltpp "Hole" + RVal_None -> dfltpp "None" + RHsV_MutVar v -> dfltpp "MutVar" + RHsV_Handle h -> dfltpp $ show h + RHsV_Addr p -> dfltpp $ show (Ptr p) + where + dfltpp :: PP x => x -> IO PP_Doc + dfltpp = return . pp + +ppRValWithHp :: Heap -> RVal -> IO PP_Doc +ppRValWithHp hp = ppRVal' (\p -> heapGetM'' hp p >>= (return . Just)) + +ppRVal :: RVal -> IO PP_Doc +ppRVal = ppRVal' (\_ -> return Nothing) + +instance PP RVal where + pp rval = unsafePerformIO (ppRVal rval) + +{-# LINE 191 "src/ehc/CoreRun/Run/Val.chs" #-} +mkTuple :: (RunSem RValCxt RValEnv RVal m a) => [RVal] -> RValT m a +mkTuple vs = liftIO (mvecAllocFillFromV $ mkCRArray vs) >>= rsemNode 0 >>= rsemPush +{-# INLINE mkTuple #-} + +mkUnit :: (RunSem RValCxt RValEnv RVal m a) => RValT m a +mkUnit = mkTuple [] +{-# INLINE mkUnit #-} + +{-# LINE 201 "src/ehc/CoreRun/Run/Val.chs" #-} +-- Vector of RVal +type RValV = CRArray RVal + +-- Mutable vector of RVal +type RValMV = CRMArray RVal + +{-# LINE 214 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Marshalling from/to Haskell values +class HSMarshall hs where + -- | Marshall to Haskell value, also parameterized by evaluator + hsMarshall :: (RunSem RValCxt RValEnv RVal m a) => (RVal -> RValT m a) -> RVal -> RValT m hs + + -- | Unmarshall from Haskell value + hsUnmarshall :: (RunSem RValCxt RValEnv RVal m a) => hs -> RValT m a + +{-# LINE 224 "src/ehc/CoreRun/Run/Val.chs" #-} +instance HSMarshall Int where + hsMarshall _ (RVal_Int v) = return v + hsUnmarshall v = rsemPush $ RVal_Int v + {-# INLINE hsUnmarshall #-} + +instance HSMarshall Integer where + hsMarshall _ (RVal_Integer v) = return v + hsUnmarshall v = rsemPush $ RVal_Integer v + {-# INLINE hsUnmarshall #-} + +instance HSMarshall Bool where + hsMarshall _ (RVal_Node t _) = return $ t == tagBoolTrue + hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Bool:" >#< v + hsUnmarshall b = liftIO (mvecAllocFillFromV emptyCRArray) >>= rsemNode (if b then tagBoolTrue else tagBoolFalse) >>= rsemPush + {-# INLINE hsUnmarshall #-} + +instance HSMarshall Char where + hsMarshall _ (RVal_Char v) = return v + hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall Char:" >#< v + hsUnmarshall v = rsemPush $ RVal_Char v + {-# INLINE hsUnmarshall #-} + +instance HSMarshall (Ptr a) where + hsMarshall _ (RHsV_Addr v) = return $ Ptr v + hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall (Ptr a):" >#< v + hsUnmarshall (Ptr v) = rsemPush $ RHsV_Addr v + {-# INLINE hsUnmarshall #-} + +instance HSMarshall [RVal] where + hsMarshall evl (RVal_Node t as) + | t == tagListCons = liftIO (MV.read as 1) >>= evl >>= rsemPop >>= hsMarshall evl >>= \tl -> liftIO (MV.read as 0) >>= \hd -> return (hd : tl) + | otherwise = return [] + hsMarshall _ v = err $ "CoreRun.Run.Val.HSMarshall [RVal]:" >#< v + + hsUnmarshall [] = liftIO (mvecAllocFillFromV emptyCRArray) >>= rsemNode tagListNil >>= rsemPush + hsUnmarshall (h:t) = hsUnmarshall t >>= rsemPop >>= \t' -> (liftIO $ mvecAllocFillFromV $ mkCRArray [h, t']) >>= rsemNode tagListCons >>= rsemPush + +instance HSMarshall x => HSMarshall [x] where + hsMarshall evl x = hsMarshall evl x >>= mapM (\v -> evl v >>= rsemPop >>= hsMarshall evl) + {-# INLINE hsMarshall #-} + + hsUnmarshall v = forM v (\e -> hsUnmarshall e >>= rsemPop) >>= hsUnmarshall + {-# INLINE hsUnmarshall #-} + +{-# LINE 281 "src/ehc/CoreRun/Run/Val.chs" #-} +deriving instance Typeable IOMode +deriving instance Data IOMode + +{-# LINE 290 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | HpPtr is index into a heap +type HpPtr = Int + +nullPtr :: HpPtr +nullPtr = -1 + +isNullPtr = (== nullPtr) + +data Heap + = Heap + { hpVals :: {-# UNPACK #-} !RValMV -- ^ value array + , hpFirst :: {-# UNPACK #-} !HpPtr -- ^ the ptr of hpVals ! 0 + , hpFree :: {-# UNPACK #-} !(IORef HpPtr) -- ^ first array location free for alloc + , hpSemispaceMultiplier :: {-# UNPACK #-} !(IORef Rational) -- ^ multiplier by which to enlarge/shrink subsequent semispace + } + +newHeap :: Int -> IO Heap +newHeap sz = do + vs <- mvecAllocInit sz + fr <- newIORef 0 + ml <- newIORef 1.5 + return $ Heap vs 0 fr ml + +{-# LINE 315 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Garbage collect heap (TBD) +heapGcM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal +-- heapGcM = err $ "CoreRun.Run.Val.heapGcM: GC not yet implemented" +heapGcM curV = do + -- rsemSetTrace True + -- rsemTr' True $ "GC starts, curV=" >#< curV + -- rsemTr $ "GC starts" + env@(RValEnv {renvHeap=hp@(Heap {hpVals=vsOld, hpSemispaceMultiplier=mlRef, hpFirst=offOld, hpFree=hpFrRef}), renvGcRootStack=rootStkRef, renvTopFrame=topFrRef, renvStack=stkRef, renvGlobals=globals}) <- get + env' <- liftIO $ do + ml <- readIORef mlRef + let szOld = MV.length vsOld + szNew = (round $ fromIntegral szOld * ml) :: Int + offNew = offOld + szOld + lwbOld = offOld + upbOld = offNew + vsNew <- mvecAllocInit szNew + greyref <- newIORef offNew + let -- copy content of old ptr to new loc, leaving a forwarding on to the old location + copyp p + -- is this indeed an old ptr? + | p >= lwbOld && p < upbOld = do + let pOld = p + iOld = pOld - offOld + v <- MV.read vsOld iOld + case v of + RVal_Fwd pNew -> do + -- putStrLn $ "GC copyp Fwd p=" ++ show pOld ++ ", pNew=" ++ show pNew + return pNew + v -> do + pNew <- readIORef greyref + let iNew = pNew - offNew + MV.write vsNew iNew v + MV.write vsOld iOld (RVal_Fwd pNew) + writeIORef greyref (pNew+1) + -- putStrLn $ "GC copyp Val p=" ++ show pOld ++ ", pNew=" ++ show pNew ++ ", v=" ++ show (pp v) + return pNew + | otherwise = do + -- putStrLn $ "GC copyp None p=" ++ show p + return p + + -- inspect RVal_Ptr only + copypv v = do + case v of + RVal_Ptr pref -> modifyIORefM pref copyp + _ -> return () + + -- inspect, possibly copy internal part of a RVal, stops with a ptr which later is dealt with (to prevent too deep stack growth), exploiting the in between grey/black area as queue + copyv v = do + -- putStrLn $ "GC copyv 1 v=" ++ show (pp v) + case v of + RVal_Ptr pref -> modifyIORefM pref copyp + RVal_Frame {rvalSLRef=slref, rvalFrVals=vs, rvalFrSP=spref} + -> modifyIORefM slref copyp >> readIORef spref >>= \sp -> mvecForM_' 0 sp vs copyv + RVal_Node {rvalNdVals=vs} -> mvecForM_ vs copyv + RVal_App {rvalFun=f, rvalArgs=as} -> copyv f >> mvecForM_ as copyv + RVal_Thunk {rvalSLRef=slref} -> modifyIORefM slref copyp + RVal_Lam {rvalSLRef=slref} -> modifyIORefM slref copyp + _ -> return () + -- putStrLn $ "GC copyv 2 v=" ++ show (pp v) + + -- inspect, follow, copy content of RVal + follow pBlk pGry + | pBlk < pGry = MV.read vsNew (pBlk-offNew) >>= copyv >> follow (pBlk+1) pGry + | otherwise = do + pGry' <- readIORef greyref + if pBlk < pGry' then follow pBlk pGry' else return pBlk + + -- initial copy: top frame + modifyIORefM topFrRef copyp -- $ \topFr -> {- if isNullPtr topFr then return topFr else -} copyp topFr + + -- initial copy: stack + modifyIORefM stkRef $ mapM copyp + + -- initial copy: globals + globals' <- V.forM globals copyp + + -- initial copy: the RVal to be put on the heap + copyv curV + + -- initial copy: additional roots + readIORef rootStkRef >>= mapM_ (mapM_ copyv) + + -- follow with initial values of grey and black (0) + readIORef greyref >>= follow offNew >>= \p -> writeIORef hpFrRef (p - offNew) + + -- final: + return $ env {renvGlobals = globals', renvHeap = hp {hpVals=vsNew, hpFirst=offNew}} + + put env' + -- rsemTr $ "GC done" + -- rsemTr' True $ "GC done, curV=" >#< curV + -- rsemSetTrace False + return curV + +{-# LINE 411 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Allocate on the heap +heapAllocM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m HpPtr +heapAllocM v = do + hp@(Heap {hpVals=vs, hpFirst=off, hpFree=fr}) <- gets renvHeap + p <- liftIO $ readIORef fr + if p >= MV.length vs + then heapGcM v >>= heapAllocM + else liftIO $ do + MV.write vs p v + writeIORef fr (p + 1) + return $ p + off + +-- | Allocate on the heap, packing as RVal_Ptr +heapAllocAsPtrM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal +heapAllocAsPtrM v = do + p <- heapAllocM v + liftIO (newIORef p) >>= (return . RVal_Ptr) + +{- +-} +-- | Get a value from the heap +-- heapGetM'' :: PrimMonad m => Heap -> HpPtr -> m RVal +heapGetM'' :: Heap -> HpPtr -> IO RVal +heapGetM'' hp@(Heap {hpVals=vs, hpFirst=off}) p = MV.read vs (p - off) +{-# INLINE heapGetM'' #-} + +-- | Get a value from the heap +heapGetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RValT m RVal +heapGetM' hp p = liftIO $ heapGetM'' hp p +{-# INLINE heapGetM' #-} + +-- | Get a value from the heap +heapGetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RValT m RVal +heapGetM p = do + hp <- gets renvHeap + heapGetM' hp p +{-# INLINE heapGetM #-} + +-- | Set a value in the heap +heapSetM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> RVal -> RValT m () +heapSetM' hp@(Heap {hpVals=vs, hpFirst=off}) p v = liftIO $ MV.write vs (p - off) v +{-# INLINE heapSetM' #-} + +-- | Set a value in the heap +heapSetM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RVal -> RValT m () +heapSetM p v = do + hp <- gets renvHeap + heapSetM' hp p v +{-# INLINE heapSetM #-} + +-- | Update a value in the heap +heapUpdM' :: (RunSem RValCxt RValEnv RVal m x) => Heap -> HpPtr -> (RVal -> RValT m RVal) -> RValT m () +heapUpdM' hp@(Heap {hpVals=vs, hpFirst=off}) p f = do + let p' = p - off + v <- liftIO $ MV.read vs p' + v' <- f v + liftIO $ MV.write vs p' v' +{-# INLINE heapUpdM' #-} + +-- | Update a value in the heap +heapUpdM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> (RVal -> RValT m RVal) -> RValT m () +heapUpdM p f = do + hp <- gets renvHeap + heapUpdM' hp p f +{-# INLINE heapUpdM #-} + +{-# LINE 483 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Environment: context/reader +data RValCxt + = RValCxt + { rcxtInRet :: !Bool -- ^ in returning context, True by default + -- , rcxtDoTrace :: !Bool -- ^ tracing + } + +emptyRValCxt :: RValCxt +emptyRValCxt = RValCxt True -- False + +{-# LINE 495 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Set return context to True +mustReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a +mustReturn = local (\r -> r {rcxtInRet = True}) +{-# INLINE mustReturn #-} + +-- | Set return context to False +needNotReturn :: RunSem RValCxt RValEnv RVal m x => RValT m a -> RValT m a +needNotReturn = local (\r -> r {rcxtInRet = False}) +{-# INLINE needNotReturn #-} + +-- | Variation of `rsemEvl` in return context +rvalRetEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x +rvalRetEvl = mustReturn . rsemEvl +{-# INLINE rvalRetEvl #-} + +-- | Variation of `rsemEvl` in primitve argument context +rvalPrimargEvl :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m x +rvalPrimargEvl x = rvalRetEvl x >>= rsemPop >>= rsemDeref +{-# INLINE rvalPrimargEvl #-} + +{-# LINE 521 "src/ehc/CoreRun/Run/Val.chs" #-} +{- +-- | Loop over a vector, starting at lower bound 'l', ending before 'h' +vecLoop :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m () +vecLoop l h m v = loop l + where loop l | l < h = m v l >> loop (l+1) + | otherwise = return () +{-# INLINE vecLoop #-} +-} + +-- | Loop over a vector from upb to lwb, starting before 'h', ending at lower bound 'l' +vecLoopReverse :: Monad m => Int -> Int -> (V.Vector a -> Int -> m b) -> V.Vector a -> m () +vecLoopReverse l h m v = loop (h-1) + where loop h | l <= h = m v h >> loop (h-1) + | otherwise = return () +{-# INLINE vecLoopReverse #-} + + +{-# LINE 540 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Right to left forM_ +vecReverseForM_ :: Monad m => V.Vector a -> (a -> m x) -> m () +vecReverseForM_ v m = vecLoopReverse 0 (V.length v) (\_ i -> m (v V.! i)) v +{-# INLINE vecReverseForM_ #-} + +{-# LINE 551 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Allocate a mutable vector of given size +mvecAllocWith :: PrimMonad m => Int -> a -> m (MV.MVector (PrimState m) a) +mvecAllocWith = MV.replicate +{-# INLINE mvecAllocWith #-} + +-- | Allocate a mutable vector of given size, init to default value +mvecAllocInit :: Int -> IO RValMV +mvecAllocInit sz = mvecAllocWith sz RVal_None +{-# INLINE mvecAllocInit #-} + +-- | Allocate a mutable vector of given size +mvecAlloc :: PrimMonad m => Int -> m (MV.MVector (PrimState m) a) +mvecAlloc = MV.new +{-# INLINE mvecAlloc #-} + +-- | Loop over a mutable vector, updating the vector as a side effect, starting at lower bound 'l', ending before 'h' +mvecLoop :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a) +mvecLoop l h m v = loop l + where loop l | l < h = m v l >> loop (l+1) + | otherwise = return v +{-# INLINE mvecLoop #-} + +-- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l' +mvecLoopReverse :: PrimMonad m => Int -> Int -> (MV.MVector (PrimState m) a -> Int -> m b) -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a) +mvecLoopReverse l h m v = loop (h-1) + where loop h | l <= h = m v h >> loop (h-1) + | otherwise = return v +{-# INLINE mvecLoopReverse #-} + +-- | Loop over a mutable vector from upb to lwb, updating the vector as a side effect, starting before 'h', ending at lower bound 'l' +mvecLoopReverseAccum :: PrimMonad m => acc -> Int -> Int -> (acc -> Int -> m acc) -> MV.MVector (PrimState m) a -> m acc +mvecLoopReverseAccum a l h m v = loop (h-1) a + where loop h a | l <= h = m a h >>= loop (h-1) + | otherwise = return a +{-# INLINE mvecLoopReverseAccum #-} + +-- | Convert to a list +mvecToList :: PrimMonad m => MV.MVector (PrimState m) a -> m [a] +mvecToList v = mvecLoopReverseAccum [] 0 (MV.length v) (\l i -> MV.read v i >>= \a -> return (a:l)) v + +-- | Fill a mutable vector from a unmutable vector, starting with filling at the given lowerbound +mvecFillFromV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> CRArray a -> m () +mvecFillFromV lwb toarr frarr = forM_ (craAssocs' lwb frarr) $ \(i,e) -> MV.write toarr i e +{-# INLINE mvecFillFromV #-} + +-- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements +mvecFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m () +mvecFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (i+lwbDiff)) frarr >> return () + where lwbDiff = lwbTo - lwbFr +{-# INLINE mvecFillFromMV' #-} + +-- | Fill a mutable vector from another mutable vector, starting with copying at the given lowerbounds, copying size elements, but reversing the given vector +mvecReverseFillFromMV' :: PrimMonad m => Int -> Int -> Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m () +-- mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoop lwbFr (lwbFr+sz) (\v i -> MV.read v (upbFr1-i) >>= MV.write toarr (i+lwbDiff)) frarr >> return () +mvecReverseFillFromMV' lwbTo lwbFr sz toarr frarr = mvecLoopReverse lwbFr (lwbFr+sz) (\v i -> MV.read v i >>= MV.write toarr (upbFr1 - i + lwbTo)) frarr >> return () + where lwbDiff = lwbTo - lwbFr + upbFr1 = lwbFr + sz - 1 +{-# INLINE mvecReverseFillFromMV' #-} + +-- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound +mvecFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m () +-- mvecFillFromMV lwb toarr frarr = mvecLoop 0 (MV.length frarr) (\v i -> MV.read frarr i >>= MV.write toarr (i+lwb)) frarr >> return () +mvecFillFromMV lwb toarr frarr = mvecFillFromMV' lwb 0 (MV.length frarr) toarr frarr +{-# INLINE mvecFillFromMV #-} +-- {-# SPECIALIZE mvecFillFromMV :: Int -> MV.MVector (PrimState IO) a -> MV.MVector (PrimState IO) a -> IO () #-} + +-- | Fill a mutable vector from another mutable vector, starting with filling at the given lowerbound, but reversing the given vector +mvecReverseFillFromMV :: PrimMonad m => Int -> MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m () +mvecReverseFillFromMV lwb toarr frarr = mvecReverseFillFromMV' lwb 0 (MV.length frarr) toarr frarr +{- +mvecReverseFillFromMV lwb toarr frarr = mvecLoop 0 l (\v i -> MV.read frarr (l1-i) >>= MV.write toarr (i+lwb)) frarr >> return () + where l = MV.length frarr + l1 = l - 1 +-} +{-# INLINE mvecReverseFillFromMV #-} + +-- | Alloc and fill vector of size taken from fixed vec +mvecAllocFillFromV :: PrimMonad m => CRArray a -> m (MV.MVector (PrimState m) a) +mvecAllocFillFromV frarr = mvecAlloc (V.length frarr) >>= \toarr -> mvecFillFromV 0 toarr frarr >> return toarr +{-# INLINE mvecAllocFillFromV #-} + +-- | Loop over a mutable vector, updating the vector as a side effect, with explicit range +mvecForM_' :: PrimMonad m => Int -> Int -> MV.MVector (PrimState m) a -> (a -> m b) -> m () +mvecForM_' lwb upb v m = mvecLoop lwb upb (\v i -> MV.read v i >>= m) v >> return () +{-# INLINE mvecForM_' #-} + +-- | Loop over a mutable vector, updating the vector as a side effect +mvecForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m b) -> m () +mvecForM_ v m = mvecForM_' 0 (MV.length v) v m +{-# INLINE mvecForM_ #-} + +-- | Append mutable 2 vectors +mvecAppend :: PrimMonad m => MV.MVector (PrimState m) a -> MV.MVector (PrimState m) a -> m (MV.MVector (PrimState m) a) +mvecAppend v1 v2 = + mvecAlloc l12 >>= mvecLoop 0 l1 (\v i -> MV.read v1 i >>= MV.write v i) >>= mvecLoop l1 l12 (\v i -> MV.read v2 (i-l1) >>= MV.write v i) + where + l1 = MV.length v1 + l2 = MV.length v2 + l12 = l1 + l2 + +{-# LINE 653 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Right to left forM_ +mvecReverseForM_ :: PrimMonad m => MV.MVector (PrimState m) a -> (a -> m x) -> m () +mvecReverseForM_ v m = mvecLoopReverse 0 (MV.length v) (\v i -> MV.read v i >>= m) v >> return () +{-# INLINE mvecReverseForM_ #-} + +{-# LINE 664 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Dereference a possibly RVal_Ptr +ptr2valM :: (RunSem RValCxt RValEnv RVal m x) => RVal -> RValT m RVal +ptr2valM v = case v of + RVal_Ptr pref -> liftIO (readIORef pref) >>= heapGetM >>= \v' -> case v' of + RVal_Thunk {} -> return v + _ -> ptr2valM v' + _ -> return v +{-# INLINE ptr2valM #-} + +-- | Dereference a RRef +ref2valM :: (RunSem RValCxt RValEnv RVal m x) => RRef -> RValT m RVal +ref2valM r = do + -- rsemTr $ "R: " ++ show (pp r) + env <- get + case r of + RRef_Glb m e -> do + modFrame <- heapGetM (renvGlobals env V.! m) + liftIO $ MV.read (rvalFrVals modFrame) e + RRef_Loc l o -> do + topfrp <- renvTopFrameM + topfr <- heapGetM topfrp + access topfr + where + access (RVal_Frame {rvalLev=frlev, rvalFrVals=vs}) | l == frlev = do + -- rsemTr $ "R o=" ++ show o ++ " len(vs)=" ++ show (MV.length vs) + liftIO $ MV.read vs o + access (RVal_Frame {rvalLev=frlev, rvalSLRef=slref}) = do + sl <- liftIO $ readIORef slref + -- rsemTr $ "R sl=" ++ show sl ++ " frlev=" ++ show frlev ++ " l=" ++ show l + heapGetM sl >>= access + access v = + err $ "CoreRun.Run.Val.ref2valM.RRef_Loc.access:" >#< r >#< "in" >#< v + RRef_Fld r e -> do + v <- ptr2valM =<< ref2valM r -- >>= rsemDeref + case v of + RVal_Node _ vs -> liftIO $ MV.read vs e + _ -> err $ "CoreRun.Run.Val.ref2valM.RRef_Fld:" >#< e >#< "in" >#< v + _ -> err $ "CoreRun.Run.Val.ref2valM.r:" >#< r +{-# INLINE ref2valM #-} + +{-# LINE 711 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Frame holding locals indexed by RRef_Loc +type RValFrame = HpPtr -- points to heap to a RVal_Frame + +-- | Frame Stack +type RValStack = [RValFrame] + +-- | Environment: state +data RValEnv + = RValEnv + { renvGlobals :: !(CRArray RValFrame) -- ^ per module frame of globals + , renvStack :: !(IORef RValStack) -- ^ stack of frames, except for the top + , renvTopFrame :: !(IORef RValFrame) -- ^ current frame, the actual top of the stack + -- , renvFrSP :: !(IORef Int) -- ^ top of expr stack embedded in higher end of top frame + , renvHeap :: !Heap -- ^ heap + , renvDoTrace :: !Bool + , renvGcRootStack :: !(IORef [[RVal]]) -- ^ stack of roots for GC, use is optional + } + +newRValEnv :: Int -> IO RValEnv +newRValEnv hpSz = do + st <- newIORef [] + tp <- newIORef nullPtr + hp <- newHeap hpSz + -- sp <- newIORef 0 + rtst <- newIORef [] + return $ RValEnv V.empty st tp hp False rtst + +{-# LINE 740 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Get the top most frame from the stack, 'nullPtr' if absent +renvTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m HpPtr +renvTopFrameM = do + (RValEnv {renvTopFrame=tf}) <- get + liftIO $ readIORef tf +{-# INLINE renvTopFrameM #-} + +{-# LINE 749 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Get all non empty stack frames, still split up in (possibly null) top frame and rest of stack +renvAllFrameM' :: (RunSem RValCxt RValEnv RVal m x) => RValT m (Maybe HpPtr,[HpPtr]) +renvAllFrameM' = do + topfrp <- renvTopFrameM + env <- get + st <- liftIO $ readIORef (renvStack env) + return (if isNullPtr topfrp then Nothing else Just topfrp, st) + +-- | Get all non empty stack frames +renvAllFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m [HpPtr] +renvAllFrameM = do + (mbtop,st) <- renvAllFrameM' + return $ maybe [] (:[]) mbtop ++ st + +{-# LINE 765 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Dump environment +dumpPpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m PP_Doc +dumpPpEnvM extensive = do + stkfrs <- renvAllFrameM + env <- get + let hp = renvHeap env + hpfr <- liftIO $ readIORef (hpFree hp) + needRet <- asks rcxtInRet + let dash = "====================" + header1 = dash >-< "rcxtInRet=" >|< needRet + header2 = ppCurly $ "Heap =" >|< hpfr >|< "/" >|< MV.length (hpVals hp) >|< ", Stack =" >|< ppBracketsCommas stkfrs + footer1 = dash + hpPP <- dumpHeap hp hpfr + glPP <- dumpGlobals hp (renvGlobals env) + frPPs <- forM stkfrs $ dumpFrame hp + if extensive + then return $ header1 >-< header2 >-< hpPP >-< glPP >-< "====== Frames ======" >-< (indent 2 $ vlist frPPs) >-< footer1 + else return $ header2 + where + dumpFrame hp fp = do + fr@(RVal_Frame {rvalFrVals=vs, rvalFrSP=spref}) <- heapGetM fp + sp <- liftIO $ readIORef spref + -- pps <- ppa 0 hp sp vs + (liftIO $ ppRValWithHp hp fr) >>= \frpp -> return $ "Frame ptr=" >|< fp >|< " sp=" >|< sp >-< (indent 2 $ frpp) -- >-< (indent 2 $ vlist pps)) + dumpGlobals hp glbls = do + pps <- forM [0 .. V.length glbls - 1] $ \i -> do + dumpFrame hp (glbls V.! i) + return $ "====== Globals ======" >-< indent 2 (vlist pps) + dumpHeap hp@(Heap {hpFirst=off}) hpfr = do + pps <- ppa off hp hpfr (hpVals hp) + return $ "======= Heap =======" >-< indent 2 (vlist pps) + ppb hp k v = (liftIO $ ppRValWithHp hp v) >>= \vpp -> return $ k >|< ":" >#< vpp + ppa off hp sz vs = forM [0 .. sz - 1] $ \i -> liftIO (MV.read vs i) >>= ppb hp (i + off) + +{-# LINE 801 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Dump environment +dumpEnvM :: (RunSem RValCxt RValEnv RVal m x) => Bool -> RValT m () +dumpEnvM extensive = dumpPpEnvM extensive >>= \p -> liftIO $ putPPLn p >> hFlush stdout + +{-# LINE 811 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Update top frame +updTopFrameM :: (RunSem RValCxt RValEnv RVal m x) => (RVal -> RValT m RVal) -> RValT m () +updTopFrameM f = renvTopFrameM >>= flip heapUpdM f +{-# INLINE updTopFrameM #-} + +{-# LINE 823 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Push on the stack embedded in the top frame +renvFrStkPush' :: RunSem RValCxt RValEnv RVal m x => (Int -> RValMV -> v -> IO Int) -> v -> RValT m () +renvFrStkPush' pushvOn v = do + (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get + liftIO $ do + (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref + sp <- readIORef spref + sp' <- pushvOn sp frvs v + writeIORef spref sp' + +-- | Push on the stack embedded in the top frame +renvFrStkPush1 :: RunSem RValCxt RValEnv RVal m x => RVal -> RValT m () +renvFrStkPush1 = renvFrStkPush' (\sp frvs v -> MV.write frvs sp v >> return (sp + 1)) +{-# INLINE renvFrStkPush1 #-} + +-- | Push on the stack embedded in the top frame +renvFrStkPushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m () +renvFrStkPushMV = renvFrStkPush' (\sp frvs vs -> mvecFillFromMV sp frvs vs >> return (sp + MV.length vs)) +{-# INLINE renvFrStkPushMV #-} + +-- | Push reversed on the stack embedded in the top frame +renvFrStkReversePushMV :: RunSem RValCxt RValEnv RVal m x => RValMV -> RValT m () +renvFrStkReversePushMV = renvFrStkPush' (\sp frvs vs -> mvecReverseFillFromMV sp frvs vs >> return (sp + MV.length vs)) +{-# INLINE renvFrStkReversePushMV #-} + +{-# LINE 850 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Pop from the stack embedded in the top frame +renvFrStkPop' :: RunSem RValCxt RValEnv RVal m x => (RValMV -> Int -> IO v) -> Int -> RValT m v +renvFrStkPop' popvFrom sz = do + (RValEnv {renvTopFrame=frref, renvHeap=hp}) <- get + liftIO $ do + (RVal_Frame {rvalFrVals=frvs, rvalFrSP=spref}) <- heapGetM'' hp =<< readIORef frref + sp <- readIORef spref + let sp' = sp - sz + writeIORef spref sp' + popvFrom frvs sp' + +-- | Pop from the stack embedded in the top frame +renvFrStkPop :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m () +renvFrStkPop = renvFrStkPop' (\_ _ -> return ()) +{-# INLINE renvFrStkPop #-} + +-- | Pop from the stack embedded in the top frame +renvFrStkPop1 :: RunSem RValCxt RValEnv RVal m x => RValT m RVal +renvFrStkPop1 = renvFrStkPop' MV.read 1 +{-# INLINE renvFrStkPop1 #-} + +-- | Pop from the stack embedded in the top frame +renvFrStkPopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m () +renvFrStkPopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecFillFromMV' lwbTo sp sz vs frvs) sz +{-# INLINE renvFrStkPopInMV #-} + +-- | Pop from the stack embedded in the top frame +renvFrStkPopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV +-- renvFrStkPopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecFillFromMV' 0 sp sz vs frvs >> return vs) sz +renvFrStkPopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkPopInMV 0 sz vs >> return vs +{-# INLINE renvFrStkPopMV #-} + +-- | Pop from the stack embedded in the top frame +renvFrStkReversePopInMV :: RunSem RValCxt RValEnv RVal m x => Int -> Int -> RValMV -> RValT m () +renvFrStkReversePopInMV lwbTo sz vs = renvFrStkPop' (\frvs sp -> mvecReverseFillFromMV' lwbTo sp sz vs frvs) sz +{-# INLINE renvFrStkReversePopInMV #-} + +-- | Pop from the stack embedded in the top frame +renvFrStkReversePopMV :: RunSem RValCxt RValEnv RVal m x => Int -> RValT m RValMV +-- renvFrStkReversePopMV sz = renvFrStkPop' (\frvs sp -> mvecAlloc sz >>= \vs -> mvecReverseFillFromMV' 0 sp sz vs frvs >> return vs) sz +renvFrStkReversePopMV sz = (liftIO $ mvecAlloc sz) >>= \vs -> renvFrStkReversePopInMV 0 sz vs >> return vs +{-# INLINE renvFrStkReversePopMV #-} + +{-# LINE 899 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | Trace +rsemTr' :: (PP msg, RunSem RValCxt RValEnv RVal m x) => Bool -> msg -> RValT m () +rsemTr' dumpExtensive msg = whenM (gets renvDoTrace) $ do + liftIO $ putStrLn $ show $ pp msg + dumpEnvM dumpExtensive + liftIO $ hFlush stdout + +-- | Trace +rsemTr :: (PP msg, RunSem RValCxt RValEnv RVal m x) => msg -> RValT m () +rsemTr = rsemTr' False + +{-# LINE 916 "src/ehc/CoreRun/Run/Val.chs" #-} +-- | RunT' variant for Val +type RValT m a = RunT' RValCxt RValEnv RVal m a +-- type RValT m a = RunT' () () RValEnv m a + + diff --git a/src/UHC/Light/Compiler/CoreRun/Run/Val/Prim.hs b/src/UHC/Light/Compiler/CoreRun/Run/Val/Prim.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Run/Val/Prim.hs @@ -0,0 +1,278 @@ +-- {-# LANGUAGE MagicHash #-} +-- {-# OPTIONS_GHC -O2 #-} + +module UHC.Light.Compiler.CoreRun.Run.Val.Prim +( rvalPrim ) +where +import UHC.Light.Compiler.CoreRun.Prim +import UHC.Light.Compiler.CoreRun.Run.Val +import UHC.Light.Compiler.CoreRun.Run +import UHC.Light.Compiler.CoreRun +import UHC.Util.Pretty +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import qualified Data.ByteString.Char8 as BSC8 + +{-# LINE 35 "src/ehc/CoreRun/Run/Val/Prim.chs" #-} +-- | Apply primitive to arguments +rvalPrim :: (RunSem RValCxt RValEnv RVal m a) => RunPrim -> RValV -> RValT m a +rvalPrim pr as = do + as' <- forM (V.toList as) $ \a -> rsemDeref a >>= rsemPop + -- let as' = V.toList as + -- rsemTr $ "Prim:" >#< show pr >|< ppParensCommas as' + case (pr, as') of + -- Int arithmetic + (RP_primAddInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 + i2 + (RP_primSubInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 - i2 + (RP_primMulInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 * i2 + (RP_primDivInt, [RVal_Int i1, RVal_Int i2]) -> rsemPush $ RVal_Int $ i1 `div` i2 + (RP_primEqInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 == i2 + (RP_primLeInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 <= i2 + (RP_primNeInt, [RVal_Int i1, RVal_Int i2]) -> hsUnmarshall $ i1 /= i2 + + -- Exception handling + (RP_primCatchException, [x, hdl]) -> rsemEvl x -- err $ "Not impl: RP_primCatchException" -- TBD + + -- MutVar + {- + (RP_primNewMutVar, [x, s]) -> (liftIO $ newIORef x) >>= \mv -> mkTuple [s, RHsV_MutVar mv] + (RP_primReadMutVar, [RHsV_MutVar mv, s]) -> (liftIO $ readIORef mv) >>= \v -> mkTuple [s, v] + (RP_primWriteMutVar, [RHsV_MutVar mv, v, s]) -> (liftIO $ writeIORef mv v) >> rsemPush s + (RP_primSameMutVar, _) -> err $ "Not impl: RP_primSameMutVar" -- TBD + -} + + -- Base + (RP_primPackedStringToInteger, [RVal_PackedString x]) -> rsemPush $ RVal_Integer $ read $ BSC8.unpack x + (RP_primPackedStringNull, [RVal_PackedString x]) -> hsUnmarshall $ BSC8.null x + (RP_primPackedStringHead, [RVal_PackedString x]) -> rsemPush $ RVal_Char $ BSC8.head x + (RP_primPackedStringTail, [RVal_PackedString x]) -> rsemPush $ RVal_PackedString $ BSC8.tail x + (RP_primShowInteger, [RVal_Integer x]) -> hsUnmarshall $ show x + + -- Base: Bounded + (RP_primMaxInt, _) -> rsemPush $ RVal_Int $ maxBound + (RP_primMinInt, _) -> rsemPush $ RVal_Int $ minBound + + -- Prims: conversion + (RP_primIntegerToInt32, [RVal_Integer x]) -> rsemPush $ RVal_Int32 $ fromIntegral x + (RP_primIntToInteger , [RVal_Int x]) -> rsemPush $ RVal_Integer $ fromIntegral x + (RP_primIntegerToInt , [RVal_Integer x]) -> rsemPush $ RVal_Int $ fromIntegral x + + -- IO +{- + -- * The IO monad + + -- IO -- instance MonadFix + | RP_fixIO -- :: (a -> IO a) -> IO a + + -- * Files and handles + + -- FilePath -- :: String + + -- Handle -- abstract, instance of: Eq, Show. + + -- ** Standard handles + + -- | Three handles are allocated during program initialisation, + -- and are initially open. + +-} + -- | RP_stdin, RP_stdout, RP_stderr -- :: Handle + (RP_stdin , _) -> rsemPush $ RHsV_Handle stdin + (RP_stdout, _) -> rsemPush $ RHsV_Handle stdout + (RP_stderr, _) -> rsemPush $ RHsV_Handle stderr +{- + + -- * Opening and closing files + + -- ** Opening files + + | RP_withFile + | RP_openFile -- :: FilePath -> IOMode -> IO Handle + -- IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode), + +-} + -- ** Closing files + + -- | RP_hClose -- :: Handle -> IO () + (RP_hClose, [RHsV_Handle h]) -> primIO (hClose h) + +{- + -- ** Special cases + + -- | These functions are also exported by the "Prelude". + + | RP_readFile -- :: FilePath -> IO String + | RP_writeFile -- :: FilePath -> String -> IO () + | RP_appendFile -- :: FilePath -> String -> IO () + + -- ** File locking + + -- $locking +-} + + -- * Operations on handles + + -- ** Determining and changing the size of a file + + -- | RP_hFileSize -- :: Handle -> IO Integer + (RP_hFileSize, [RHsV_Handle h]) -> primInputIO (hFileSize h) + -- #ifdef __GLASGOW_HASKELL__ + -- | RP_hSetFileSize -- :: Handle -> Integer -> IO () + (RP_hSetFileSize, [RHsV_Handle h, RVal_Integer i]) -> primIO (hSetFileSize h i) + -- #endif + + -- ** Detecting the end of input + + -- | RP_hIsEOF -- :: Handle -> IO Bool + (RP_hIsEOF, [RHsV_Handle h]) -> primInputIO (hIsEOF h) +{- + | RP_isEOF -- :: IO Bool +-} + -- ** Buffering operations + +{- + -- BufferMode(NoBuffering,LineBuffering,BlockBuffering), + -- | RP_hSetBuffering -- :: Handle -> BufferMode -> IO () + (RP_hSetBuffering, [RHsV_Handle h, RVal_Int m]) -> primInputIO (hSetBuffering h m) + | RP_hGetBuffering -- :: Handle -> IO BufferMode +-} + -- | RP_hFlush -- :: Handle -> IO () + (RP_hFlush, [RHsV_Handle h]) -> primIO (hFlush h) + +{- + -- ** Repositioning handles + + | RP_hGetPosn -- :: Handle -> IO HandlePosn + | RP_hSetPosn -- :: HandlePosn -> IO () + -- HandlePosn, -- abstract, instance of: Eq, Show. + + | RP_hSeek -- :: Handle -> SeekMode -> Integer -> IO () + -- SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd), + -- #if !defined(__NHC__) + | RP_hTell -- :: Handle -> IO Integer + -- #endif + + -- ** Handle properties + + | RP_hIsOpen + | RP_hIsClosed -- :: Handle -> IO Bool + | RP_hIsReadable + | RP_hIsWritable -- :: Handle -> IO Bool + | RP_hIsSeekable -- :: Handle -> IO Bool + + -- ** Terminal operations (not portable: GHC\/Hugs only) + + -- #if !defined(__NHC__) + | RP_hIsTerminalDevice -- :: Handle -> IO Bool + + | RP_hSetEcho -- :: Handle -> Bool -> IO () + | RP_hGetEcho -- :: Handle -> IO Bool + -- #endif + + -- ** Showing handle state (not portable: GHC only) + + -- #ifdef __GLASGOW_HASKELL__ +-} + -- | RP_hShow -- :: Handle -> IO String + (RP_hShow, [RHsV_Handle h]) -> primInputIO (hShow h) +{- + -- #endif + + -- * Text input and output + + -- ** Text input +-} + -- | RP_hWaitForInput -- :: Handle -> Int -> IO Bool + (RP_hWaitForInput, [RHsV_Handle h, RVal_Int i]) -> primInputIO (hWaitForInput h i) +{- + | RP_hReady -- :: Handle -> IO Bool +-} + -- | RP_hGetChar -- :: Handle -> IO Char + (RP_hGetChar, [RHsV_Handle h]) -> primInputIO (hGetChar h) + -- | RP_hGetLine -- :: Handle -> IO [Char] + (RP_hGetLine, [RHsV_Handle h]) -> primInputIO (hGetLine h) + -- | RP_hLookAhead -- :: Handle -> IO Char + (RP_hLookAhead, [RHsV_Handle h]) -> primInputIO (hLookAhead h) + -- | RP_hGetContents -- :: Handle -> IO [Char] + (RP_hGetContents, [RHsV_Handle h]) -> primInputIO (hGetContents h) +{- + -- ** Text output + +-} + -- | RP_hPutChar -- :: Handle -> Char -> IO () + (RP_hPutChar, [RHsV_Handle h, x]) -> primOutputIO (hPutChar h) x + -- | RP_hPutStr -- :: Handle -> [Char] -> IO () + (RP_hPutStr, [RHsV_Handle h, x]) -> primOutputIO (hPutStr h) x +{- + | RP_hPutStrLn -- :: Handle -> [Char] -> IO () + | RP_hPrint -- :: Show a => Handle -> a -> IO () + + -- ** Special cases for standard input and output + + -- | These functions are also exported by the "Prelude". + + | RP_interact -- :: (String -> String) -> IO () + -- putChar -- :: Char -> IO () + -- putStr -- :: String -> IO () + -- putStrLn -- :: String -> IO () + -- print -- :: Show a => a -> IO () + -- getChar -- :: IO Char + -- getLine -- :: IO String + -- getContents -- :: IO String + | RP_readIO -- :: Read a => String -> IO a + | RP_readLn -- :: Read a => IO a + + -- * Binary input and output + | RP_withBinaryFile + | RP_openBinaryFile -- :: FilePath -> IOMode -> IO Handle +-} + -- | RP_hSetBinaryMode -- :: Handle -> Bool -> IO () + (RP_hSetBinaryMode, [RHsV_Handle h, b]) -> primOutputIO (hSetBinaryMode h) b + -- | RP_hPutBuf -- :: Handle -> Ptr a -> Int -> IO () + (RP_hPutBuf, [RHsV_Handle h, RHsV_Addr a, RVal_Int i]) -> primIO (hPutBuf h (Ptr a) i) + -- | RP_hGetBuf -- :: Handle -> Ptr a -> Int -> IO Int + (RP_hGetBuf, [RHsV_Handle h, RHsV_Addr a, RVal_Int i]) -> primInputIO (hGetBuf h (Ptr a) i) +{- + -- #if !defined(__NHC__) && !defined(__HUGS__) +-} + -- | RP_hPutBufNonBlocking -- :: Handle -> Ptr a -> Int -> IO Int + (RP_hPutBufNonBlocking, [RHsV_Handle h, RHsV_Addr a, RVal_Int i]) -> primIO (hPutBufNonBlocking h (Ptr a) i) + -- | RP_hGetBufNonBlocking -- :: Handle -> Ptr a -> Int -> IO Int + (RP_hGetBufNonBlocking, [RHsV_Handle h, RHsV_Addr a, RVal_Int i]) -> primInputIO (hGetBufNonBlocking h (Ptr a) i) +{- + -- #endif + -- * Temporary files + + | RP_openTempFile + | RP_openBinaryTempFile +-} + -- * Additional ones + -- | RP_primShowHandle -- :: Handle -> String + (RP_primShowHandle, [RHsV_Handle h]) -> hsUnmarshall $ show h + -- | RP_primEqHandle -- :: Handle -> Handle -> Bool + (RP_primEqHandle, [RHsV_Handle h1, RHsV_Handle h2]) -> hsUnmarshall $ h1 == h2 + + (pr, _) -> err $ "CoreRun.Run.Val.Prim:" >#< show pr + +{-# LINE 281 "src/ehc/CoreRun/Run/Val/Prim.chs" #-} +-- | Voidify IO on RVal level, i.e. make IO () +-- rvalVoid :: (RunSem RValCxt RValEnv RVal m RVal) => RValT m a -> RValT m RVal +rvalVoid :: (RunSem RValCxt RValEnv RVal m a) => RValT m b -> RValT m a +rvalVoid m = m >> mkUnit +{-# INLINE rvalVoid #-} + +-- | IO, no result +primIO :: (RunSem RValCxt RValEnv RVal m a) => IO x -> RValT m a +primIO io = rvalVoid $ liftIO $ io +-- {-# INLINE primIO #-} + +-- | Input-like IO +primInputIO :: (RunSem RValCxt RValEnv RVal m a, HSMarshall x) => IO x -> RValT m a +primInputIO io = (liftIO $ io) >>= hsUnmarshall +-- {-# INLINE primInputIO #-} + +-- | Output-like IO +primOutputIO :: (RunSem RValCxt RValEnv RVal m a, HSMarshall x) => (x -> IO ()) -> RVal -> RValT m a +primOutputIO io x = rvalVoid $ hsMarshall rvalPrimargEvl x >>= (liftIO . io) +-- {-# INLINE primOutputIO #-} + diff --git a/src/UHC/Light/Compiler/CoreRun/Run/Val/RunExplStk.hs b/src/UHC/Light/Compiler/CoreRun/Run/Val/RunExplStk.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Run/Val/RunExplStk.hs @@ -0,0 +1,312 @@ +-- {-# LANGUAGE MagicHash #-} +-- {-# OPTIONS_GHC -O2 #-} + +module UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk +( cmodRun ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.CoreRun +import UHC.Light.Compiler.CoreRun.Run +import UHC.Light.Compiler.CoreRun.Run.Val +import UHC.Light.Compiler.CoreRun.Run.Val.Prim +import UHC.Light.Compiler.CoreRun.Pretty +import UHC.Util.Pretty +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import qualified Data.ByteString.Char8 as BSC8 + +{-# LINE 38 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +-- | Allocate a new frame +explStkAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> Int -> Int -> Int -> RValT m HpPtr +explStkAllocFrameM r2n sl lev sz nrArgs = do + a <- liftIO $ mvecAllocInit (sz+10) -- TBD: stack overflow somewhere... + when (nrArgs > 0) $ renvFrStkReversePopInMV 0 nrArgs a + slref <- liftIO $ newIORef sl + spref <- liftIO $ newIORef nrArgs + p <- heapAllocM $ RVal_Frame r2n slref lev a spref + return p + +-- | Push a new stack frame +explStkPushFrameM :: (RunSem RValCxt RValEnv RVal m x) => HpPtr -> RValT m () +explStkPushFrameM frptr = do + (RValEnv {renvStack=st, renvTopFrame=tf}) <- get + liftIO $ do + t <- readIORef tf + unless (isNullPtr t) $ modifyIORef st (t:) + writeIORef tf frptr +{-# INLINE explStkPushFrameM #-} + +-- | Allocate and push a new stack frame +explStkPushAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> Int -> Int -> Int -> RValT m () +explStkPushAllocFrameM r2n sl lev sz nrArgs = do + p <- explStkAllocFrameM r2n sl lev sz nrArgs + explStkPushFrameM p +{- + (RValEnv {renvStack=st, renvTopFrame=tf}) <- get + liftIO $ do + t <- readIORef tf + unless (isNullPtr t) $ modifyIORef st (t:) + writeIORef tf p +-} +{-# INLINE explStkPushAllocFrameM #-} + +-- | Allocate and replace top stack frame +explStkReplaceAllocFrameM :: (RunSem RValCxt RValEnv RVal m x) => Ref2Nm -> HpPtr -> Int -> Int -> Int -> RValT m () +explStkReplaceAllocFrameM r2n sl lev sz nrArgs = do + p <- explStkAllocFrameM r2n sl lev sz nrArgs + (RValEnv {renvTopFrame=tf}) <- get + liftIO $ writeIORef tf p +{-# INLINE explStkReplaceAllocFrameM #-} + +-- | Pop a stack frame, copying the top of the stack embedded in the frame +explStkPopFrameM :: (RunSem RValCxt RValEnv RVal m x) => RValT m HpPtr +explStkPopFrameM = do + (RValEnv {renvStack=stref, renvTopFrame=tfref}) <- get + liftIO $ do + tf <- readIORef tfref + stk <- readIORef stref + case stk of + [] -> writeIORef tfref nullPtr + (h:t) -> do + writeIORef tfref h + writeIORef stref t + return tf +{-# INLINE explStkPopFrameM #-} + +{-# LINE 101 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +cmodRun :: (RunSem RValCxt RValEnv RVal m ()) => EHCOpts -> Mod -> RValT m () +cmodRun opts (Mod_Mod {body_Mod_Mod=e}) = do + -- dumpEnvM True + rsemExp e + -- v <- renvFrStkPop1 + -- return v + +{-# LINE 118 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +-- | Apply Lam in context of static link with exact right amount of params, otherwise the continuation is used +rvalExplStkAppLam :: RunSem RValCxt RValEnv RVal m () => HpPtr -> Exp -> Int -> (Int -> RValT m ()) -> RValT m () +rvalExplStkAppLam sl f nrActualArgs failcont = do + case f of + Exp_Lam {lev_Exp_Lam=l, nrArgs_Exp_Lam=nrRequiredArgs, stkDepth_Exp_Lam=sz, ref2nm_Exp_Lam=r2n, body_Exp_Lam=b} + | nrActualArgs == nrRequiredArgs -> do + -- rsemTr $ "V app lam ==" + needRet <- asks rcxtInRet + if needRet + then do + explStkPushAllocFrameM r2n sl l sz nrActualArgs + rsemExp b + v <- renvFrStkPop1 + explStkPopFrameM + renvFrStkPush1 v + else do + explStkReplaceAllocFrameM r2n sl l sz nrActualArgs + mustReturn $ rsemExp b + | otherwise -> failcont nrRequiredArgs + _ -> err $ "CoreRun.Run.Val.rvalExplStkAppLam:" >#< f +-- {-# SPECIALIZE rvalExplStkAppLam :: HpPtr -> Exp -> RValMV -> (Int -> RValT IO RVal) -> RValT IO RVal #-} +-- {-# INLINE rvalExplStkAppLam #-} + +{-# LINE 143 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +-- | Apply. Assume: function 'f' is already evaluated (responsibility lies outside) +rvalExplStkApp :: RunSem RValCxt RValEnv RVal m () => RVal -> Int -> RValT m () +rvalExplStkApp f nrActualArgs = do + -- rsemTr $ "V app f(" ++ show (MV.length as) ++ "): " ++ show (pp f) + case f of + RVal_Lam {rvalSLRef=slref, rvalBody=b} -> do + sl <- liftIO $ readIORef slref + rvalExplStkAppLam sl b nrActualArgs $ \narg -> do + if nrActualArgs < narg + then do + -- rsemTr $ "V app lam <" + renvFrStkReversePopMV nrActualArgs >>= \as -> heapAllocAsPtrM (RVal_App f as) >>= renvFrStkPush1 + else do + -- rsemTr $ "V app lam >" + ap <- mustReturn $ rvalExplStkApp f narg >>= rsemPop >>= rsemDeref >>= rsemPop + rvalExplStkApp ap (nrActualArgs - narg) + RVal_App appf appas + | nrActualArgs > 0 -> do + -- rsemTr $ "V app app" + renvFrStkReversePushMV appas >> rvalExplStkApp appf (nrActualArgs + MV.length appas) + _ -> err $ "CoreRun.Run.Val.rvalExplStkApp:" >#< f +-- {-# SPECIALIZE rvalExplStkApp :: RunSem RValCxt RValEnv RVal IO RVal => RVal -> RValMV -> RValT IO RVal #-} +-- {-# INLINE rvalExplStkApp #-} + +{-# LINE 169 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +-- | rsemExp for RVal, without explicit use of expr stack, i.e. implicit stack via Haskell thereby preventing correct GC +rvalExplStkExp :: RunSem RValCxt RValEnv RVal m () => Exp -> RValT m () +{-# SPECIALIZE rvalExplStkExp :: RunSem RValCxt RValEnv RVal IO () => Exp -> RValT IO () #-} +-- {-# INLINE rvalExplStkExp #-} +rvalExplStkExp e = do + -- rsemTr' True $ "E:" >#< e + -- e' <- case e of + case e of + -- app, call + Exp_App f as -> do + vecReverseForM_ as rsemExp + rsemExp f >>= rsemPop >>= ptr2valM >>= \f' -> rvalExplStkApp f' (V.length as) + + -- heap node + Exp_Tup t as -> do + V.forM_ as rsemExp + renvFrStkPopMV (V.length as) >>= rsemNode (ctagTag t) >>= rsemPush + + -- lam as is, being a heap allocated thunk when 0 args are required + Exp_Lam {nrArgs_Exp_Lam=na} + | na == 0 -> mk RVal_Thunk >>= heapAllocAsPtrM >>= rsemPush + | otherwise -> mk RVal_Lam >>= heapAllocAsPtrM >>= rsemPush + where mk rv = do + sl <- renvTopFrameM + slref <- liftIO $ newIORef sl + return $ rv e slref + + -- let + Exp_Let {firstOff_Exp_Let=fillFrom, ref2nm_Exp_Let=r2n, binds_Exp_Let=bs, body_Exp_Let=b} -> do + V.forM_ bs rsemExp + rsemExp b + + -- case, scrutinee already evaluated + Exp_Case e as -> do + v <- ptr2valM =<< rsemPop =<< rsemSExp e + case v of + RVal_Node {rvalTag=tg} -> rsemAlt $ as V.! tg + _ -> err $ "CoreRun.Run.Val.RunExplStk.rvalExplStkExp.Case: scrutinee:" >#< v + + -- force evaluation immediately + Exp_Force e -> rsemExp e >>= rsemPop >>= rsemEvl + + -- setup for context requiring a return (TBD: should be done via CPS style, but is other issue) + Exp_Ret e -> mustReturn $ rsemExp e + + -- setup for context requiring a return from case alternative + Exp_RetCase _ e -> rsemExp e + + -- setup for context not requiring a return + Exp_Tail e -> needNotReturn $ rsemExp e + + -- simple expressions + Exp_SExp se -> rsemSExp se + + -- FFI + Exp_FFI pr as -> V.mapM_ rsemExp as >> renvFrStkPopMV (V.length as) >>= (liftIO . V.freeze) >>= rsemPrim pr + + e -> err $ "CoreRun.Run.Val.RunExplStk.rvalExplStkExp:" >#< e + + -- rsemTr' True $ "E->:" >#< (e) -- >-< e') + -- return e' + +{-# LINE 233 "src/ehc/CoreRun/Run/Val/RunExplStk.chs" #-} +instance + ( Monad m, MonadIO m, Functor m + ) => RunSem RValCxt RValEnv RVal m () + where + -- {-# SPECIALIZE instance RunSem RValCxt RValEnv RVal IO () #-} + rsemInitial = do + s <- liftIO $ newRValEnv 1000 -- 100000 -- + return (emptyRValCxt, s, undefined) + + rsemSetup opts modImpL mod@(Mod_Mod {moduleNr_Mod_Mod=mainModNr}) = do + -- rsemSetTrace True + rsemGcEnterRootLevel + let modAllL = modImpL ++ [mod] + ms <- liftIO $ MV.new (maximum (map moduleNr_Mod_Mod modAllL) + 1) + forM_ modAllL $ \(Mod_Mod {ref2nm_Mod_Mod=r2n, moduleNr_Mod_Mod=nr, binds_Mod_Mod=bs, stkDepth_Mod_Mod=sz}) -> do + -- construct frame for each module + explStkPushAllocFrameM r2n nullPtr 0 sz 0 + -- holding all local defs + V.forM_ bs rsemExp + p <- explStkPopFrameM + -- and store the frame into the array holding module frames + (liftIO $ MV.write ms nr p >> newIORef p) >>= \r -> rsemGcPushRoot (RVal_Ptr r) + -- get the module array and store it as the globals + ms' <- liftIO $ V.freeze ms + modify $ \env -> env {renvGlobals = ms'} + -- use the main module's stackframe for evaluating 'main' + explStkPushFrameM $ ms' V.! mainModNr + rsemGcLeaveRootLevel + rsemSetTrace $ CoreOpt_RunTrace `elem` ehcOptCoreOpts opts + + rsemSetTrace doTrace = modify $ \env -> + env {renvDoTrace = doTrace} + + rsemExp = rvalExplStkExp + + rsemSExp se = do + case se of + SExp_Int v -> rsemPush $ RVal_Int v + SExp_Char v -> rsemPush $ RVal_Char v + SExp_Var r -> do v <- ref2valM r + -- rsemTr $ "R->V:" >#< v + rsemPush v + SExp_String v -> rsemPush $ RVal_PackedString $ BSC8.pack v + _ -> rsemPush (RVal_Lit se) + {-# INLINE rsemSExp #-} + + rsemEvl v = do + -- rsemGcEnterRootLevel + -- rsemGcPushRoot v + case v of + RVal_Ptr {rvalPtrRef=pref} -> do + rsemGcEnterRootLevel + rsemGcPushRoot v + liftIO (readIORef pref) >>= evlPtr pref + rsemGcLeaveRootLevel + RVal_BlackHole -> err $ "CoreRun.Run.Val.rsemEvl.RVal_BlackHole:" >#< "Black hole" + _ -> return () -- rsemPush v + -- rsemGcLeaveRootLevel + rsemPush v + where + evlPtr pref p = do + hp <- gets renvHeap + v <- heapGetM' hp p + case v of + RVal_Thunk {rvalSLRef=slref, rvalBody=e} -> do + -- rsemGcPushRoot v + sl <- liftIO $ readIORef slref + heapSetM' hp p RVal_BlackHole + v' <- rvalExplStkAppLam sl e 0 $ \_ -> err $ "CoreRun.Run.Val.rsemEvl.RVal_Thunk:" >#< e + hp <- gets renvHeap + p <- liftIO (readIORef pref) + v'' <- rsemPop v' + heapSetM' hp p v'' + return v'' + RVal_Ptr {rvalPtrRef=pref} -> do + v' <- evlPtr pref =<< liftIO (readIORef pref) + hp <- gets renvHeap + p <- liftIO (readIORef pref) + heapSetM' hp p v' + return v' + v -> do + return v + + rsemDeref v = do + v' <- ptr2valM v + -- rsemTr $ "Deref:" >#< (v >-< v') + rsemPush v' + {-# INLINE rsemDeref #-} + + -- apply a known primitive + rsemPrim = rvalPrim + {-# INLINE rsemPrim #-} + + rsemPush = renvFrStkPush1 + {-# INLINE rsemPush #-} + rsemPop = \_ -> renvFrStkPop1 + {-# INLINE rsemPop #-} + rsemNode t vs = heapAllocAsPtrM $ RVal_Node t vs + {-# INLINE rsemNode #-} + + + rsemGcEnterRootLevel = gets renvGcRootStack >>= \r -> liftIO $ modifyIORef r $ ([]:) + {-# INLINE rsemGcEnterRootLevel #-} + + rsemGcPushRoot v = gets renvGcRootStack >>= \r -> liftIO $ modifyIORef r $ \(h:t) -> (v:h) : t + {-# INLINE rsemGcPushRoot #-} + + rsemGcLeaveRootLevel = gets renvGcRootStack >>= \r -> liftIO $ modifyIORef r tail + {-# INLINE rsemGcLeaveRootLevel #-} + diff --git a/src/UHC/Light/Compiler/CoreRun/Run/Val/RunImplStk.hs b/src/UHC/Light/Compiler/CoreRun/Run/Val/RunImplStk.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CoreRun/Run/Val/RunImplStk.hs @@ -0,0 +1,273 @@ +-- {-# LANGUAGE MagicHash #-} +-- {-# OPTIONS_GHC -O2 #-} + +module UHC.Light.Compiler.CoreRun.Run.Val.RunImplStk +( cmodRun ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.CoreRun +import UHC.Light.Compiler.CoreRun.Run +import UHC.Light.Compiler.CoreRun.Run.Val +import UHC.Light.Compiler.CoreRun.Run.Val.Prim +import UHC.Light.Compiler.CoreRun.Pretty +import UHC.Util.Pretty +import qualified Data.Vector as V +import qualified Data.Vector.Mutable as MV +import qualified Data.ByteString.Char8 as BSC8 + +{-# LINE 38 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +-- | Fill (part of) a frame starting at 'lwb' +fillFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => Int -> RValMV -> RVal -> RValT m () +fillFrameM lwb as (RVal_Frame {rvalFrVals=frArr}) = do + liftIO $ mvecFillFromMV lwb frArr as +{-# INLINE fillFrameM #-} + +{-# LINE 46 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +-- | Allocate a new frame +implStkAllocFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => Ref2Nm -> HpPtr -> Int -> Int -> RValMV -> RValT m HpPtr +implStkAllocFrameM r2n sl lev sz as = do + a <- liftIO $ mvecAllocInit sz + slref <- liftIO $ newIORef sl + spref <- liftIO $ newIORef sz -- (MV.length as) -- stack is not used, GC looks up until this location + let fr = RVal_Frame r2n slref lev a spref + fillFrameM 0 as fr + heapAllocM fr + +-- | Allocate and push a new stack frame +implStkPushAllocFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => Ref2Nm -> HpPtr -> Int -> Int -> RValMV -> RValT m () +implStkPushAllocFrameM r2n sl lev sz as = do + p <- implStkAllocFrameM r2n sl lev sz as + (RValEnv {renvStack=st, renvTopFrame=tf}) <- get + liftIO $ do + t <- readIORef tf + unless (isNullPtr t) $ modifyIORef st (t:) + writeIORef tf p +{-# INLINE implStkPushAllocFrameM #-} + +-- | Allocate and replace top stack frame +implStkReplaceAllocFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => Ref2Nm -> HpPtr -> Int -> Int -> RValMV -> RValT m () +implStkReplaceAllocFrameM r2n sl lev sz as = do + p <- implStkAllocFrameM r2n sl lev sz as + (RValEnv {renvTopFrame=tf}) <- get + liftIO $ writeIORef tf p +{-# INLINE implStkReplaceAllocFrameM #-} + +-- | Pop a stack frame +implStkPopFrameM :: (RunSem RValCxt RValEnv RVal m RVal) => RValT m () +implStkPopFrameM = do + (RValEnv {renvStack=st, renvTopFrame=tf}) <- get + liftIO $ do + stk <- readIORef st + case stk of + [] -> writeIORef tf nullPtr + (h:t) -> do + writeIORef tf h + writeIORef st t +{-# INLINE implStkPopFrameM #-} + +{-# LINE 94 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +cmodRun :: (RunSem RValCxt RValEnv RVal m RVal) => EHCOpts -> Mod -> RValT m RVal +cmodRun opts (Mod_Mod {body_Mod_Mod=e}) = do + -- dumpEnvM True + v <- rsemExp e + return v + +{-# LINE 110 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +-- | Apply Lam in context of static link with exact right amount of params, otherwise the continuation is used +rvalImplStkAppLam :: RunSem RValCxt RValEnv RVal m RVal => HpPtr -> Exp -> RValMV -> (Int -> RValT m RVal) -> RValT m RVal +rvalImplStkAppLam sl f as failcont = do + case f of + Exp_Lam {lev_Exp_Lam=l, nrArgs_Exp_Lam=narg, stkDepth_Exp_Lam=sz, ref2nm_Exp_Lam=r2n, body_Exp_Lam=b} + | MV.length as == narg -> do + -- rsemTr $ "V app lam ==" + needRet <- asks rcxtInRet + if needRet + then do + implStkPushAllocFrameM r2n sl l sz as + v <- rsemExp b + implStkPopFrameM + return v + else do + implStkReplaceAllocFrameM r2n sl l sz as + mustReturn $ rsemExp b + | otherwise -> failcont narg + _ -> err $ "CoreRun.Run.Val.rvalImplStkAppLam:" >#< f +-- {-# SPECIALIZE rvalImplStkAppLam :: HpPtr -> Exp -> RValMV -> (Int -> RValT IO RVal) -> RValT IO RVal #-} +-- {-# INLINE rvalImplStkAppLam #-} + +-- | Apply. Assume: function 'f' is already evaluated (responsibility lies outside) +rvalImplStkApp :: RunSem RValCxt RValEnv RVal m RVal => RVal -> RValMV -> RValT m RVal +rvalImplStkApp f as = do + -- rsemTr $ "V app f(" ++ show (MV.length as) ++ "): " ++ show (pp f) + case f of + RVal_Lam {rvalSLRef=slref, rvalBody=b} -> do + sl <- liftIO $ readIORef slref + rvalImplStkAppLam sl b as $ \narg -> do + if MV.length as < narg + then do + -- rsemTr $ "V app lam <" + return $ RVal_App f as + else do + -- rsemTr $ "V app lam >" + ap <- {- mustReturn $ -} rvalImplStkApp f (MV.take narg as) + rvalImplStkApp ap (MV.drop narg as) + RVal_App appf appas + | MV.length as > 0 -> do + -- rsemTr $ "V app app" + (liftIO $ mvecAppend appas as) >>= rvalImplStkApp appf + _ -> err $ "CoreRun.Run.Val.rvalImplStkApp:" >#< f +-- {-# SPECIALIZE rvalImplStkApp :: RunSem RValCxt RValEnv RVal IO RVal => RVal -> RValMV -> RValT IO RVal #-} +-- {-# INLINE rvalImplStkApp #-} + +{-# LINE 158 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +-- | rsemExp for RVal, without explicit use of expr stack, i.e. implicit stack via Haskell thereby preventing correct GC +rvalImplStkExp :: RunSem RValCxt RValEnv RVal m RVal => Exp -> RValT m RVal +-- {-# SPECIALIZE rvalImplStkExp :: RunSem RValCxt RValEnv RVal IO RVal => Exp -> RValT IO RVal #-} +{-# INLINE rvalImplStkExp #-} +rvalImplStkExp e = do + -- rsemTr $ "E:" >#< e + -- e' <- case e of + case e of + -- app, call + Exp_App f as -> do + f' <- {- mustReturn $ -} rsemExp f {- >>= rsemEvl -} + V.mapM rsemExp as >>= (liftIO . V.thaw) >>= rvalImplStkApp f' + + -- heap node + Exp_Tup t as -> do + as' <- V.mapM rsemExp as >>= (liftIO . mvecAllocFillFromV) + rsemNode (ctagTag t) as' + + -- lam as is, being a heap allocated thunk when 0 args are required + Exp_Lam {nrArgs_Exp_Lam=na} + | na == 0 -> mk RVal_Thunk >>= heapAllocM >>= (liftIO . newIORef) >>= (return . RVal_Ptr) + | otherwise -> mk RVal_Lam + where mk rv = do + sl <- renvTopFrameM + slref <- liftIO $ newIORef sl + return $ rv e slref + + -- let + Exp_Let {firstOff_Exp_Let=fillFrom, ref2nm_Exp_Let=r2n, binds_Exp_Let=bs, body_Exp_Let=b} -> do + bs' <- (liftIO . V.thaw) =<< V.forM bs rsemExp + fr <- renvTopFrameM >>= heapGetM -- >>= rsemDeref + fillFrameM fillFrom bs' fr + rsemExp b + + -- case, scrutinee already evaluated + Exp_Case e as -> do + (RVal_Node {rvalTag=tg}) <- {- rsemDeref =<< -} rsemSExp e + rsemAlt $ as V.! tg + + -- force evaluation immediately + Exp_Force e -> rsemExp e >>= rsemPop >>= rsemEvl + + -- setup for context requiring a return (TBD: should be done via CPS style, but is other issue) + Exp_Ret e -> mustReturn $ rsemExp e + + -- setup for context requiring a return from case alternative + Exp_RetCase _ e -> rsemExp e + + -- setup for context not requiring a return + Exp_Tail e -> needNotReturn $ rsemExp e + + -- simple expressions + Exp_SExp se -> rsemSExp se + + -- FFI + Exp_FFI pr as -> V.mapM rsemExp as >>= rsemPrim pr + + e -> err $ "CoreRun.Run.Val.RunExplStk.rvalImplStkExp:" >#< e + + -- rsemTr $ "E->:" >#< (e >-< e') + -- return e' + + +{-# LINE 223 "src/ehc/CoreRun/Run/Val/RunImplStk.chs" #-} +instance + ( Monad m, MonadIO m, Functor m + ) => RunSem RValCxt RValEnv RVal m RVal + where + {-# SPECIALIZE instance RunSem RValCxt RValEnv RVal IO RVal #-} + rsemInitial = do + s <- liftIO $ newRValEnv 100000 + return (emptyRValCxt, s, undefined) + + rsemSetup opts modImpL mod = {- local (const emptyRValCxt) $ -} do + -- (liftIO $ newRValEnv 100000) >>= put + let modAllL = mod : modImpL + ms <- liftIO $ MV.new (maximum (map moduleNr_Mod_Mod modAllL) + 1) + forM_ modAllL $ \(Mod_Mod {ref2nm_Mod_Mod=r2n, moduleNr_Mod_Mod=nr, binds_Mod_Mod=bs}) -> do + bs' <- (liftIO . V.thaw) =<< V.forM bs rsemExp + p <- implStkAllocFrameM r2n nullPtr 0 (MV.length bs') bs' + liftIO $ MV.write ms nr p + ms' <- liftIO $ V.freeze ms + modify $ \env -> env {renvGlobals = ms'} + rsemSetTrace $ CoreOpt_RunTrace `elem` ehcOptCoreOpts opts + -- return RVal_None + + rsemSetTrace doTrace = modify $ \env -> + env {renvDoTrace = doTrace} + + rsemExp = rvalImplStkExp + + rsemSExp se = do + case se of + SExp_Int v -> rsemPush $ RVal_Int v + SExp_Char v -> rsemPush $ RVal_Char v + SExp_Var r -> do v <- ref2valM r + -- rsemTr $ "R->V:" >#< v + rsemPush v + SExp_String v -> rsemPush $ RVal_PackedString $ BSC8.pack v + _ -> rsemPush (RVal_Lit se) + {-# INLINE rsemSExp #-} + + -- TBD + rsemEvl v = case v of + RVal_Ptr {rvalPtrRef=pref} -> liftIO (readIORef pref) >>= evlPtr + RVal_BlackHole -> err $ "CoreRun.Run.Val.rsemEvl.RVal_BlackHole:" >#< "Black hole" + _ -> return v + where + evlPtr p = do + hp <- gets renvHeap + v <- heapGetM' hp p + -- rsemTr $ "Evl: *" >|< p >|< ":" >#< v + v' <- case v of + RVal_Thunk {rvalSLRef=slref, rvalBody=e} -> do + sl <- liftIO $ readIORef slref + heapSetM' hp p RVal_BlackHole + v' <- liftIO (mvecAlloc 0) >>= \v -> rvalImplStkAppLam sl e v $ \_ -> err $ "CoreRun.Run.Val.rsemEvl.RVal_Thunk:" >#< e + heapSetM' hp p v' + return v' + RVal_Ptr {rvalPtrRef=pref} -> do + v' <- evlPtr =<< liftIO (readIORef pref) + heapSetM' hp p v' + return v' + v -> return v + -- rsemTr $ "Evl->: *" >|< p >|< ":" >#< (v >-< v') + return v' + + rsemDeref v = do + v' <- ptr2valM v + -- rsemTr $ "Deref:" >#< (v >-< v') + return v' + {-# INLINE rsemDeref #-} + + -- apply a known primitive + rsemPrim = rvalPrim + {-# INLINE rsemPrim #-} + + rsemPush = return + {-# INLINE rsemPush #-} + rsemPop = return + {-# INLINE rsemPop #-} + rsemNode t vs = return $ RVal_Node t vs + {-# INLINE rsemNode #-} + + diff --git a/src/UHC/Light/Compiler/Deriving.hs b/src/UHC/Light/Compiler/Deriving.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Deriving.hs @@ -0,0 +1,402 @@ +module UHC.Light.Compiler.Deriving +( DerivCls (..), DerivClsFld (..), DerivClsMp +, emptyDerivCls +, dccMkTy +, mkDerivClsMp ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.AbstractCore +import qualified Data.Map as Map +import Data.List +import UHC.Util.Utils +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.Trf.Canonic + + + +{-# LINE 25 "src/ehc/Deriving.chs" #-} +data DerivClsExtraCtxt + = DerivClsExtraCtxt_Fixed -- fixed predicate, independent of type over which is derived + { dccClsClNm :: !HsName -- class name + , dccClsTyNm :: !HsName -- and its type arg + } + +data DerivCls + = DerivCls + { dclNm :: !HsName -- name of class + , dclFldL :: ![DerivClsFld] -- field info + , dclExtraCtxt :: ![DerivClsExtraCtxt] -- additional instances to prove (and use) + } + +data DerivClsFld + = DerivClsFld + { dcfNm :: !HsName -- name of class field + , dcfTy :: !Ty -- type of class field, expanded w.r.t. type synonyms + , dcfMkCPat :: -- make the pattern for each alternative + Int -- index of alternative (the actual Enum ordering) + -> CTag -- tag + -> Int -- arity + -> Maybe [HsName] -- optional list of names for constituents + -> CPat + , dcfInitialArgL :: ![HsName] -- initial arguments for function, passed to dcfFoldSubsCExpr + , dcfInitialSubArgL :: DataTagInfo -> [CExpr] -- initial arguments for constituents + , dcfNrOmitTailArg :: !Int -- nr of args not passed, i.e. how much to omit for partial app + , dcfFoldSubsCExpr :: UID -- construct out of constituents + -> RCEEnv + -> DataTagInfo -- this tag info + -> (Int,Int) -- (index (a la toEnum), nr of alts) + -> [HsName] -- names of initial args (usually same as dcfInitialArgL) + -> [CExpr] -- constituents + -> CExpr + , dcfNoArgSubsCExpr :: RCEEnv + -> [(DataTagInfo,[CExpr])] -- all tag info + sub calls parameterized with appropriate instance + -> Int -- nr of alts + -> CExpr -- instance under construction + -> [CExpr] -- instances corresponding to dclExtraCtxt + -> [HsName] -- names of initial args (usually same as dcfInitialArgL) + -> CExpr -- when class member takes no args + , dcfAllTagLtCExpr :: !CExpr -- when tags are < previous + , dcfAllTagGtCExpr :: !CExpr -- when tags are > previous + , dcfWrapCase :: -- wrap case expr in derived function + EHCOpts + -> DataGamInfo -- info of data ty + -> Int -- nr of alts + -> HsName -- name of expr inspected by case expr + -> [HsName] -- names of initial args (usually same as dcfInitialArgL) + -> CExpr -- case expr + -> CExpr + } + +type DerivClsMp = Map.Map HsName DerivCls + +{-# LINE 81 "src/ehc/Deriving.chs" #-} +emptyDerivCls :: DerivCls +emptyDerivCls = DerivCls hsnUnknown [] [] + +{-# LINE 86 "src/ehc/Deriving.chs" #-} +dccMkTy :: DerivClsExtraCtxt -> Ty +dccMkTy (DerivClsExtraCtxt_Fixed clNm tyNm) = appConApp clNm [appCon tyNm] + +{-# LINE 93 "src/ehc/Deriving.chs" #-} +mkDerivClsMp :: FIEnv -> ValGam -> DataGam -> DerivClsMp +mkDerivClsMp fe valGam dataGam + = Map.unions + $ map (uncurry Map.singleton) + $ [ + -- Eq + {- + mkc ehbnClassEq [] + [ + -- Eq((==)) + mkf ehbnClassEqFldEq + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + (\_ _ _ _ _ vs + -> case vs of + [] -> true + _ -> foldr1 and vs + ) + Nothing -- no zero arg + false false + nowrap + ] + -} + + -- Ord + mkc ehbnClassOrd [] + [ + -- Ord(compare) + mkf ehbnClassOrdFldCompare + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + (\uniq env _ _ _ vs + -> case vs of + [] -> eq + _ -> foldr1 (\l r -> acoreStrictSatCaseTy env (Just (nStrict,acoreTyErr "Deriving.Ord.compare")) l + [ acoreAlt (acorePatTagArityMbNms (rceEHCOpts env) (orderingTag eqNm) 0 Nothing) r + , acoreAlt (acorePatTagArityMbNms (rceEHCOpts env) (orderingTag ltNm) 0 Nothing) lt + , acoreAlt (acorePatTagArityMbNms (rceEHCOpts env) (orderingTag gtNm) 0 Nothing) gt + ] + ) vs + where n = mkHNm uniq + nStrict = hsnUniqifyEval n + ) + Nothing -- no zero arg + gt lt + nowrap + ] + + -- Enum + , mkc ehbnClassEnum [DerivClsExtraCtxt_Fixed (fn ehbnClassEnum) hsnInt] + [ + -- Enum(enumFrom) + mkf ehbnClassEnumFldEnumFrom + Nothing -- only data constructor patterns + (take 1 hsnLclSupply) + Nothing -- no extra args for recursion on constituents + 0 + nononzeroargs + (Just $ + \_ dtiSubs nrOfAlts self _ [argFrom] + -> let (dti,_) = last' (panic "Deriving.Enum.enumFrom.dtiSubs") dtiSubs + in acoreBuiltinApp opts ehbnClassEnumFldEnumFromTo [self,acoreVar argFrom,CExpr_Tup (dtiCTag dti)] + ) + undef undef + nowrap + -- Enum(enumFromThen) + , mkf ehbnClassEnumFldEnumFromThen + Nothing -- only data constructor patterns + (take 2 hsnLclSupply) + Nothing -- no extra args for recursion on constituents + 0 + nononzeroargs + (Just $ + \_ dtiSubs nrOfAlts self _ [argFrom,argThen] + -> let (dti1,_) = head dtiSubs + (dti2,_) = last' (panic "Deriving.Enum.enumFromThen.dtiSubs") dtiSubs + in acoreBuiltinApp opts ehbnClassEnumFldEnumFromThenTo + [ self + , acoreVar argFrom + , acoreVar argThen + , acoreIf opts Nothing + (acoreBuiltinApp opts ehbnPrimGtInt + [ acoreBuiltinApp opts ehbnClassEnumFldFromEnum [self, acoreVar argFrom] + , acoreBuiltinApp opts ehbnClassEnumFldFromEnum [self, acoreVar argThen] + ] + ) + (CExpr_Tup (dtiCTag dti1)) + (CExpr_Tup (dtiCTag dti2)) + ] + ) + undef undef + nowrap + -- Enum(fromEnum) + , mkf ehbnClassEnumFldFromEnum + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + (\_ env _ (altInx,_) _ [] + -> acoreInt opts altInx + ) + Nothing -- no zero arg + undef undef + nowrap + -- Enum(toEnum) + , mkf ehbnClassEnumFldToEnum + (Just $ \altInx _ _ _ -> CPat_Int altInx) + [] + Nothing -- no extra args for recursion on constituents + 0 + (\_ _ dti _ _ [] + -> CExpr_Tup (dtiCTag dti) + ) + Nothing -- no zero arg + undef undef + (\opts dgi nrOfAlts cNm _ body + -> let cNmv = acoreVar cNm + cNm1 = hsnUniqifyStr HsNameUniqifier_Evaluated "boundCheck" cNm + in acoreIf opts (Just cNm1) + (acoreBuiltinApp opts ehbnPrimGtInt [cNmv,acoreInt opts (nrOfAlts-1)]) + (acoreBuiltinError opts $ "too high for toEnum to " ++ show (dgiTyNm dgi)) + (acoreIf opts (Just cNm1) + (acoreBuiltinApp opts ehbnPrimGtInt [acoreInt opts 0,cNmv]) + (acoreBuiltinError opts $ "too low for toEnum to " ++ show (dgiTyNm dgi)) + body + ) + ) + -- Enum(succ) + , mkf ehbnClassEnumFldSucc + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + (\_ env dti (altInx,nrOfAlts) _ [] + -> if altInx < nrOfAlts - 1 + then acoreInt opts $ altInx + 1 + else acoreBuiltinError opts $ "cannot succ last constructor: " ++ show (dtiConNm dti) + ) + Nothing -- no zero arg + undef undef + nowrap + -- Enum(pred) + , mkf ehbnClassEnumFldPred + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + (\_ env dti (altInx,_) _ [] + -> if altInx > 0 + then acoreInt opts $ altInx - 1 + else acoreBuiltinError opts $ "cannot pred first constructor: " ++ show (dtiConNm dti) + ) + Nothing -- no zero arg + undef undef + nowrap + ] + + -- Bounded + {- + , mkc ehbnClassBounded [] + [ + -- Bounded(maxBound) + mkf ehbnClassBoundedFldMaxBound + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + nononzeroargs + (Just $ + \_ dtiSubs _ _ _ _ + -> let (dti,subs) = last dtiSubs + in acoreTagTup (dtiCTag dti) subs + ) + undef undef + nowrap + -- Bounded(minBound) + , mkf ehbnClassBoundedFldMinBound + Nothing -- only data constructor patterns + [] + Nothing -- no extra args for recursion on constituents + 0 + nononzeroargs + (Just $ + \_ dtiSubs _ _ _ _ + -> let (dti,subs) = head dtiSubs + in acoreTagTup (dtiCTag dti) subs + ) + undef undef + nowrap + ] + -} + + -- Show + , mkc ehbnClassShow [] + [ + -- Show(showsPrec) + mkf ehbnClassShowFldShowsPrec + Nothing -- only data constructor patterns + [precDepthNm] + (Just $ \dti -> [acoreInt opts $ maybe (fixityAppPrio + 1) ((+1) . fst) $ dtiMbFixityPrio dti]) + 1 + (\_ _ dti _ [dNm] vs + -> let mk needParen v = acoreApp (acoreVar $ fn ehbnPrelShowParen) [needParen,v] + in case (vs,dtiMbFixityPrio dti) of + ([],_) + -> showString $ tag2str (dtiCTag dti) + ([v1,v2],Just (p,_)) + -> mk (acoreBuiltinGtInt opts (acoreVar dNm) p) + $ foldr1 compose ([v1] ++ [ showString $ " " ++ tag2str (dtiCTag dti) ++ " " ] ++ [v2]) + _ -> mk (acoreBuiltinGtInt opts (acoreVar dNm) fixityAppPrio) + $ foldr1 compose ([showString $ tag2str (dtiCTag dti) ++ " "] ++ intersperse (showString " ") vs) + ) + Nothing -- no zero arg + undef undef + nowrap + ] + + -- Ix + {- + -} + , mkc ehbnClassIx [] + [ + -- Ix(range) + -- Ix(index) + -- Ix(inRange) + ] + + -- Read + , mkc ehbnClassRead [] + [ + -- Read(readsPrec) + mkf ehbnClassReadFldReadsPrec + Nothing -- only data constructor patterns + [precDepthNm,remInputNm] + Nothing -- no extra args for recursion on constituents + 0 + nononzeroargs + (Just $ + \env dtiSubs _ _ _ [dNm,rNm] + -> let mkSub (dti,subCalls) + = acoreApp (acoreVar $ fn ehbnPrelReadParen) [needParen,v,acoreVar rNm] + where nSub = length subCalls + nms seed = take (nSub+1) $ hsnLclSupplyWith $ mkHNmHidden seed + remNmL = nms "v" + nmL = zip4 (nms "uv") (rNm:remNmL) (nms "u") remNmL + nmLRemFinal = last' (panic "Deriving.nmLRemFinal") remNmL + mkLamTup x res rem cont = acoreLam1Ty x (acoreTyErr "Deriving.Read.mkLamTup.lam") $ acoreMatchTupleTy env [res,rem] (acoreTyErr "Deriving.Read.mkLamTup.tup") cont (acoreVar x) + mkLamStr str x res rem cont = mkLamTup x res rem $ acoreMatchStringTy env str (acoreTyErr "Deriving.Read.mkLamStr.match") cont nil (acoreVar res) + mkConcatMapTup lam prio rem subCall = acoreApp (acoreVar $ fn ehbnPrelConcatMap) [lam,acoreApp subCall [prio,acoreVar rem]] + mkConcatMapStr lam rem = acoreApp (acoreVar $ fn ehbnPrelConcatMap) [lam,acoreApp (acoreVar $ fn ehbnPrelLex) [acoreVar rem]] + mkPrio prio = acoreInt opts (prio + 1) + mkRes resL rem = acoreBuiltinListSingleton opts $ acoreTup [acoreTagTup (dtiCTag dti) $ map acoreVar resL,acoreVar rem] + mkConRead (resrem,remprev,res,rem) = \cont -> mkConcatMapStr (mkLamStr (tag2str (dtiCTag dti)) resrem res rem cont) remprev + mkSubReads tlNmL subCalls = [ (\cont -> mkConcatMapTup (mkLamTup resrem res rem cont) (mkPrio fixityAppPrio) remPrev subCall, res) | ((resrem,remPrev,res,rem),subCall) <- zip tlNmL subCalls ] + (needParen,v) + = case (subCalls,dtiMbFixityPrio dti,nmL) of + ([subCall1,subCall2],Just (p,_),(subNms1:conNms:subNms2:_)) + -> ( acoreBuiltinGtInt opts (acoreVar dNm) p + , acoreLam1Ty rNm (acoreTyErr "Deriving.Read.") $ sub1 $ mkConRead conNms $ sub2 $ mkRes subResNmL nmLRemFinal + ) + where ([sub1,sub2],subResNmL) = unzip $ mkSubReads [subNms1,subNms2] subCalls + (_,_,(conNms:subNmsL)) + -> ( acoreBuiltinGtInt opts (acoreVar dNm) fixityAppPrio + , acoreLam1Ty rNm (acoreTyErr "Deriving.Read.") $ foldr ($) (mkRes subResNmL nmLRemFinal) (mkConRead conNms : subs) + ) + where (subs,subResNmL) = unzip $ mkSubReads subNmsL subCalls + + in foldr1 (\ds e -> acoreApp (acoreVar $ fn ehbnPrelConcat2) [ds,e]) + $ map mkSub dtiSubs + ) + undef undef + nowrap + ] + ] + where mkc c extraCtxt flds + = (c', DerivCls c' flds extraCtxt) + where c' = fn c + mkf f mbMkPat as mbAsSubs omTl cAllMatch mbCNoArg cLT cGT wrap + = DerivClsFld f' (tyCanonic (emptyTyBetaRedEnv' fe) t) mkPat as asSubs omTl cAllMatch cNoArg cLT cGT wrap + where f' = fn f + (t,_) = valGamLookupTy f' valGam + mkPat = maybe (const $ acorePatTagArityMbNms opts) id mbMkPat + asSubs = maybe (const []) id mbAsSubs + cNoArg = maybe (\_ _ _ _ _ _ -> undef) id mbCNoArg + fn f = ehcOptBuiltin opts f + false, true :: CExpr + false = acoreVar $ fn ehbnBoolFalse + true = acoreVar $ fn ehbnBoolTrue + nil = CExpr_Tup $ ctagNil opts + and l r = (acoreVar $ fn ehbnBoolAnd) `acoreApp` [l,r] + compose l r = (acoreVar $ fn ehbnPrelCompose) `acoreApp` [l,r] + showString s = (acoreVar $ fn ehbnPrelShowString) `acoreApp` [acoreBuiltinString opts s] + eq = acoreVar eqNm + lt = acoreVar ltNm + gt = acoreVar gtNm + undef = acoreBuiltinUndefined opts + tag2str = show . hsnQualified . ctagNm + orderingTag conNm + = dtiCTag + $ dgiDtiOfCon conNm + $ panicJust "mkDerivClsMp.dataGamLookup" + $ dataGamLookup (fn ehbnDataOrdering) dataGam + nowrap _ _ _ _ _ x = x + nononzeroargs _ _ _ _ _ _ = undef + opts = feEHCOpts fe + eqNm = fn ehbnDataOrderingAltEQ + ltNm = fn ehbnDataOrderingAltLT + gtNm = fn ehbnDataOrderingAltGT + precDepthNm = mkHNm "d" + remInputNm = mkHNm "r" + diff --git a/src/UHC/Light/Compiler/EH.hs b/src/UHC/Light/Compiler/EH.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH.hs @@ -0,0 +1,345 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/EH.ag) +module UHC.Light.Compiler.EH(AGItf (..), Decl (..), Decls, TyExpr (..), Expr (..), PatExpr (..) +, ExprAnn (..), PatExprAnn (..), TyExprAnn (..) +, mkLet +, TyExprs, TyVar (..), TyVars, CaseAlt (..), CaseAlts, DataConstr (..), DataConstrs +, mkCase, mkCase', mkIf, mkIf', mkError, mkStr, mkAlt +, KiExpr (..), KiExprAnn (..) +, RecExpr (..), RecPatExpr (..), RowTyExpr (..), DataField (..), DataFields, DataFieldExpr (..), DataFieldPatExpr (..) +, module UHC.Light.Compiler.Base.Target +, mkLet', mkIf'' +, ehIsDeclVal +, PrExpr (..), PrExprs +, mkUnit, mkError' +, FuncDep (..), FuncDeps +, MbTyExpr +, mkEH) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.HS (Range) +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import UHC.Light.Compiler.Base.Target (FFIWay) +import UHC.Light.Compiler.Foreign + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +ehIsDeclVal :: Decl -> Bool +ehIsDeclVal (Decl_Val _ _ _) = True +ehIsDeclVal _ = False + + + +mkLet' :: Bool -> Range -> Maybe [Decl] -> Expr -> Expr +mkLet' isStrict r md e + = case md of + Just d@(_:_) -> rngLift r Expr_Let isStrict d e + _ -> e + +mkLet :: Range -> Maybe [Decl] -> Expr -> Expr +mkLet = mkLet' False + + + +mkUnit :: Range -> Expr +mkUnit r = rngLift r Expr_Rec (rngLift r RecExpr_Empty) + + + +mkError':: HsName -> Range -> String -> Expr +mkError' e r m + = appTopApp [rngLift r Expr_Var e,mkStr r (show r ++ ": " ++ m)] + +mkError :: Range -> String -> Expr +mkError = mkError' hsnError + +mkStr :: Range -> String -> Expr +mkStr r s + = rngLift r Expr_SConst s + + + +mkIf'' :: [HsName] -> Range -> Expr -> Expr -> Expr -> Maybe UIDS -> UIDS -> Expr +mkIf'' (bn:tn:fn:_) r c t e i failS + = case c of + Expr_Con _ n + | n == tn -> t + | n == fn -> e + _ -> mkCase' r + ( rngLift r Expr_TypeAs False (rngLift r TyExpr_Con bn) c ) + i failS False + [ mkAlt r (rngLift r PatExpr_Con tn) t + , mkAlt r (rngLift r PatExpr_Con fn) e + ] + + + +mkIf' :: [HsName] -> Range -> Expr -> Expr -> Expr -> Expr +mkIf' ns r c t e = mkIf'' ns r c t e Nothing Set.empty + + + +mkIf :: Range -> Expr -> Expr -> Expr -> Expr +mkIf = mkIf' [hsnBool,hsnTrue,hsnFalse] + + + +mkAlt :: Range -> PatExpr -> Expr -> CaseAlt +mkAlt r p e = rngLift r CaseAlt_Pat p e + + + +mkCase' :: Range -> Expr -> Maybe UIDS -> UIDS -> Bool -> [CaseAlt] -> Expr +mkCase' r c id failS istup as + = rngLift r Expr_Case c as id failS istup + +mkCase :: Range -> Expr -> [(PatExpr,Expr)] -> Expr +mkCase r c as + = mkCase' r c Nothing Set.empty False [ mkAlt r p e | (p,e) <- as ] + + + +mkEH :: (Range -> x) -> x +mkEH = rngLift emptyRange + + + +instance AppLike Expr () {- ExprAnn () -} where + appRngApp1 r = rngLift r Expr_App + appRngTop r = rngLift r Expr_AppTop + appRngVar r = rngLift r Expr_Var . mkHNm + appRngCon r = rngLift r Expr_Con . mkHNm + appRngPar r = rngLift r Expr_Parens + appProdApp l + = mkEH Expr_Rec $ mkEH RecExpr_Empty `mkRow` l + where mkRow = foldl (\r e -> mkEH RecExpr_Ext r Nothing e) + + + +instance AppLike PatExpr () {- PatExprAnn () -} where + appRngApp1 r = rngLift r PatExpr_App + appRngTop r = rngLift r PatExpr_AppTop + appRngVar r = rngLift r PatExpr_Var . mkHNm + appRngCon r = rngLift r PatExpr_Con . mkHNm + appRngPar r = rngLift r PatExpr_Parens + appProdApp l + = mkEH PatExpr_Rec $ mkEH RecPatExpr_Empty `mkRow` l + where mkRow = foldl (\r e -> mkEH RecPatExpr_Ext r Nothing e) + + + +instance AppLike TyExpr () {- TyExprAnn () -} where + appRngApp1 r = rngLift r TyExpr_App + appRngTop r = rngLift r TyExpr_AppTop + appRngVar r = rngLift r TyExpr_Var . mkHNm + appRngCon r = rngLift r TyExpr_Con . mkHNm + appRngPar r = rngLift r TyExpr_Parens + appProdApp l + = mkEH TyExpr_Row $ mkEH RowTyExpr_Empty `mkRow` l + where mkRow = foldl (\r e -> mkEH RowTyExpr_Ext r Nothing e) + appMbAnn1 (TyExpr_Ann r a x) = Just (x, TyExpr_Ann r a) + appMbAnn1 _ = Nothing + appMbTop1 (TyExpr_AppTop r x) = Just (x, TyExpr_AppTop r) + appMbTop1 (TyExpr_Parens r x) = Just (x, TyExpr_Parens r) + appMbTop1 x = appMbAnn1 x + appMbApp1 (TyExpr_App _ f a) = Just (f,a) + appMbApp1 _ = Nothing + appMbCon (TyExpr_Con _ n) = Just n + appMbCon _ = Nothing + + + +instance AppLike KiExpr () {- KiExprAnn () -} where + appRngApp1 r = rngLift r KiExpr_App + appRngTop r = rngLift r KiExpr_AppTop + appRngVar r = rngLift r KiExpr_Var . mkHNm + appRngCon r = rngLift r KiExpr_Con . mkHNm + appRngPar r = rngLift r KiExpr_Parens + +-- AGItf ------------------------------------------------------- +data AGItf = AGItf_AGItf {expr_AGItf_AGItf :: !(Expr)} +-- CaseAlt ----------------------------------------------------- +data CaseAlt = CaseAlt_Pat {hsrange_CaseAlt_Pat :: !(Range),patExpr_CaseAlt_Pat :: !(PatExpr),expr_CaseAlt_Pat :: !(Expr)} +-- CaseAlts ---------------------------------------------------- +type CaseAlts = [CaseAlt] +-- DataConstr -------------------------------------------------- +data DataConstr = DataConstr_Constr {hsrange_DataConstr_Constr :: !(Range),conNm_DataConstr_Constr :: !(HsName),mbFixityPrio_DataConstr_Constr :: !((Maybe (Int,Fixity))),fields_DataConstr_Constr :: !(DataFields),mbGadtTyExpr_DataConstr_Constr :: !(MbTyExpr)} +-- DataConstrs ------------------------------------------------- +type DataConstrs = [DataConstr] +-- DataField --------------------------------------------------- +data DataField = DataField_Field {hsrange_DataField_Field :: !(Range),mbLabels_DataField_Field :: !((Maybe [HsName])),tyExpr_DataField_Field :: !(TyExpr)} +-- DataFieldExpr ----------------------------------------------- +data DataFieldExpr = DataFieldExpr_Upd {hsrange_DataFieldExpr_Upd :: !(Range),dataFieldExpr_DataFieldExpr_Upd :: !(DataFieldExpr),nm_DataFieldExpr_Upd :: !(HsName),expr_DataFieldExpr_Upd :: !(Expr)} + | DataFieldExpr_Con {hsrange_DataFieldExpr_Con :: !(Range),nm_DataFieldExpr_Con :: !(HsName)} + | DataFieldExpr_Expr {hsrange_DataFieldExpr_Expr :: !(Range),expr_DataFieldExpr_Expr :: !(Expr)} +-- DataFieldPatExpr -------------------------------------------- +data DataFieldPatExpr = DataFieldPatExpr_Ext {hsrange_DataFieldPatExpr_Ext :: !(Range),dataFieldPatExpr_DataFieldPatExpr_Ext :: !(DataFieldPatExpr),nm_DataFieldPatExpr_Ext :: !(HsName),patExpr_DataFieldPatExpr_Ext :: !(PatExpr)} + | DataFieldPatExpr_Con {hsrange_DataFieldPatExpr_Con :: !(Range),nm_DataFieldPatExpr_Con :: !(HsName)} +-- DataFields -------------------------------------------------- +type DataFields = [DataField] +-- Decl -------------------------------------------------------- +data Decl = Decl_TySig {hsrange_Decl_TySig :: !(Range),nm_Decl_TySig :: !(HsName),tyExpr_Decl_TySig :: !(TyExpr)} + | Decl_Val {hsrange_Decl_Val :: !(Range),patExpr_Decl_Val :: !(PatExpr),expr_Decl_Val :: !(Expr)} + | Decl_Data {hsrange_Decl_Data :: !(Range),isNewtype_Decl_Data :: !(Bool),tyNm_Decl_Data :: !(HsName),tyVars_Decl_Data :: !(TyVars),constrs_Decl_Data :: !(DataConstrs),mbGenerInfo_Decl_Data :: !((Maybe Int))} + | Decl_KiSig {hsrange_Decl_KiSig :: !(Range),nm_Decl_KiSig :: !(HsName),kiExpr_Decl_KiSig :: !(KiExpr)} + | Decl_FFI {hsrange_Decl_FFI :: !(Range),callconv_Decl_FFI :: !(FFIWay),safety_Decl_FFI :: !(String),impEnt_Decl_FFI :: !(ForeignEnt),nm_Decl_FFI :: !(HsName),tyExpr_Decl_FFI :: !(TyExpr)} + | Decl_Type {hsrange_Decl_Type :: !(Range),tyNm_Decl_Type :: !(HsName),tyExpr_Decl_Type :: !(TyExpr)} + | Decl_FFE {hsrange_Decl_FFE :: !(Range),nm_Decl_FFE :: !(HsName),callconv_Decl_FFE :: !(FFIWay),expEnt_Decl_FFE :: !(ForeignEnt),expr_Decl_FFE :: !(Expr),tyExpr_Decl_FFE :: !(TyExpr)} + | Decl_GenerRep {hsrange_Decl_GenerRep :: !(Range),maxArity_Decl_GenerRep :: !(Int),tyNm_Decl_GenerRep :: !(HsName),conNmL_Decl_GenerRep :: !(([HsName])),recFldNmL_Decl_GenerRep :: !(([(HsName,[HsName])]))} + | Decl_FusionDecl {hsrange_Decl_FusionDecl :: !(Range),fuseNm_Decl_FusionDecl :: !(HsName)} + | Decl_FusionConv {hsrange_Decl_FusionConv :: !(Range),conNm_Decl_FusionConv :: !(HsName),absNm_Decl_FusionConv :: !(HsName)} + | Decl_Class {hsrange_Decl_Class :: !(Range),tyPrExpr_Decl_Class :: !(TyExpr),funcDeps_Decl_Class :: !(FuncDeps),mbDefaultInstNm_Decl_Class :: !((Maybe HsName)),decls_Decl_Class :: !(Decls),generDerivs_Decl_Class :: !(([(HsName,HsName)]))} + | Decl_Instance {hsrange_Decl_Instance :: !(Range),mbNmElim_Decl_Instance :: !((Maybe (HsName,Bool))),instVariant_Decl_Instance :: !(InstVariant),tyPrExpr_Decl_Instance :: !(TyExpr),decls_Decl_Instance :: !(Decls)} + | Decl_InstanceIntro {hsrange_Decl_InstanceIntro :: !(Range),mbNmElim_Decl_InstanceIntro :: !((Maybe (HsName))),expr_Decl_InstanceIntro :: !(Expr),prExpr_Decl_InstanceIntro :: !(PrExpr)} + | Decl_Default {hsrange_Decl_Default :: !(Range),nm_Decl_Default :: !(HsName),tyExprs_Decl_Default :: !(TyExprs)} +-- Decls ------------------------------------------------------- +type Decls = [Decl] +-- Expr -------------------------------------------------------- +data Expr = Expr_IConst {hsrange_Expr_IConst :: !(Range),int_Expr_IConst :: !(Int)} + | Expr_CConst {hsrange_Expr_CConst :: !(Range),char_Expr_CConst :: !(Char)} + | Expr_Con {hsrange_Expr_Con :: !(Range),nm_Expr_Con :: !(HsName)} + | Expr_Var {hsrange_Expr_Var :: !(Range),nm_Expr_Var :: !(HsName)} + | Expr_App {hsrange_Expr_App :: !(Range),func_Expr_App :: !(Expr),arg_Expr_App :: !(Expr)} + | Expr_Let {hsrange_Expr_Let :: !(Range),isStrict_Expr_Let :: !(Bool),decls_Expr_Let :: !(Decls),body_Expr_Let :: !(Expr)} + | Expr_Lam {hsrange_Expr_Lam :: !(Range),arg_Expr_Lam :: !(PatExpr),body_Expr_Lam :: !(Expr)} + | Expr_AppTop {hsrange_Expr_AppTop :: !(Range),expr_Expr_AppTop :: !(Expr)} + | Expr_Parens {hsrange_Expr_Parens :: !(Range),expr_Expr_Parens :: !(Expr)} + | Expr_TypeAs {hsrange_Expr_TypeAs :: !(Range),isScoped_Expr_TypeAs :: !(Bool),tyExpr_Expr_TypeAs :: !(TyExpr),expr_Expr_TypeAs :: !(Expr)} + | Expr_Ann {hsrange_Expr_Ann :: !(Range),ann_Expr_Ann :: !(ExprAnn),expr_Expr_Ann :: !(Expr)} + | Expr_AppImpred {hsrange_Expr_AppImpred :: !(Range),func_Expr_AppImpred :: !(Expr),arg_Expr_AppImpred :: !(Expr)} + | Expr_SConst {hsrange_Expr_SConst :: !(Range),str_Expr_SConst :: !(String)} + | Expr_Case {hsrange_Expr_Case :: !(Range),expr_Expr_Case :: !(Expr),alts_Expr_Case :: !(CaseAlts),mbCaseIds_Expr_Case :: !((Maybe UIDS)),caseFailS_Expr_Case :: !(UIDS),isTupOfArg_Expr_Case :: !(Bool)} + | Expr_DataFields {hsrange_Expr_DataFields :: !(Range),dataFieldExpr_Expr_DataFields :: !(DataFieldExpr)} + | Expr_Rec {hsrange_Expr_Rec :: !(Range),recExpr_Expr_Rec :: !(RecExpr)} + | Expr_Sel {hsrange_Expr_Sel :: !(Range),expr_Expr_Sel :: !(Expr),lbl_Expr_Sel :: !(HsName)} + | Expr_Undefined {hsrange_Expr_Undefined :: !(Range)} + | Expr_CaseAltFail {hsrange_Expr_CaseAltFail :: !(Range),caseId_Expr_CaseAltFail :: !(UID)} + | Expr_AppImpl {hsrange_Expr_AppImpl :: !(Range),func_Expr_AppImpl :: !(Expr),argPr_Expr_AppImpl :: !(PrExpr),arg_Expr_AppImpl :: !(Expr)} + | Expr_LamImpl {hsrange_Expr_LamImpl :: !(Range),argPr_Expr_LamImpl :: !(PrExpr),arg_Expr_LamImpl :: !(PatExpr),body_Expr_LamImpl :: !(Expr)} + | Expr_DynVar {hsrange_Expr_DynVar :: !(Range),nm_Expr_DynVar :: !(HsName)} + | Expr_IIConst {hsrange_Expr_IIConst :: !(Range),integer_Expr_IIConst :: !(Integer)} +-- ExprAnn ----------------------------------------------------- +data ExprAnn = ExprAnn_Empty {} +-- FuncDep ----------------------------------------------------- +data FuncDep = FuncDep_Dep {hsrange_FuncDep_Dep :: !(Range),fromTvs_FuncDep_Dep :: !(TyVars),toTvs_FuncDep_Dep :: !(TyVars)} +-- FuncDeps ---------------------------------------------------- +type FuncDeps = [FuncDep] +-- KiExpr ------------------------------------------------------ +data KiExpr = KiExpr_Con {hsrange_KiExpr_Con :: !(Range),nm_KiExpr_Con :: !(HsName)} + | KiExpr_Var {hsrange_KiExpr_Var :: !(Range),nm_KiExpr_Var :: !(HsName)} + | KiExpr_App {hsrange_KiExpr_App :: !(Range),func_KiExpr_App :: !(KiExpr),arg_KiExpr_App :: !(KiExpr)} + | KiExpr_AppTop {hsrange_KiExpr_AppTop :: !(Range),kiExpr_KiExpr_AppTop :: !(KiExpr)} + | KiExpr_Parens {hsrange_KiExpr_Parens :: !(Range),kiExpr_KiExpr_Parens :: !(KiExpr)} + | KiExpr_Ann {hsrange_KiExpr_Ann :: !(Range),ann_KiExpr_Ann :: !(KiExprAnn),kiExpr_KiExpr_Ann :: !(KiExpr)} +-- KiExprAnn --------------------------------------------------- +data KiExprAnn = KiExprAnn_Empty {} +-- MbTyExpr ---------------------------------------------------- +type MbTyExpr = Maybe (TyExpr) +-- PatExpr ----------------------------------------------------- +data PatExpr = PatExpr_IConst {hsrange_PatExpr_IConst :: !(Range),int_PatExpr_IConst :: !(Int)} + | PatExpr_CConst {hsrange_PatExpr_CConst :: !(Range),char_PatExpr_CConst :: !(Char)} + | PatExpr_Con {hsrange_PatExpr_Con :: !(Range),nm_PatExpr_Con :: !(HsName)} + | PatExpr_Var {hsrange_PatExpr_Var :: !(Range),nm_PatExpr_Var :: !(HsName)} + | PatExpr_VarAs {hsrange_PatExpr_VarAs :: !(Range),nm_PatExpr_VarAs :: !(HsName),patExpr_PatExpr_VarAs :: !(PatExpr)} + | PatExpr_App {hsrange_PatExpr_App :: !(Range),func_PatExpr_App :: !(PatExpr),arg_PatExpr_App :: !(PatExpr)} + | PatExpr_AppTop {hsrange_PatExpr_AppTop :: !(Range),patExpr_PatExpr_AppTop :: !(PatExpr)} + | PatExpr_Parens {hsrange_PatExpr_Parens :: !(Range),patExpr_PatExpr_Parens :: !(PatExpr)} + | PatExpr_Ann {hsrange_PatExpr_Ann :: !(Range),ann_PatExpr_Ann :: !(PatExprAnn),patExpr_PatExpr_Ann :: !(PatExpr)} + | PatExpr_TypeAs {hsrange_PatExpr_TypeAs :: !(Range),tyExpr_PatExpr_TypeAs :: !(TyExpr),patExpr_PatExpr_TypeAs :: !(PatExpr)} + | PatExpr_SConst {hsrange_PatExpr_SConst :: !(Range),str_PatExpr_SConst :: !(String)} + | PatExpr_Rec {hsrange_PatExpr_Rec :: !(Range),recPatExpr_PatExpr_Rec :: !(RecPatExpr)} + | PatExpr_DataFields {hsrange_PatExpr_DataFields :: !(Range),dataFieldPatExpr_PatExpr_DataFields :: !(DataFieldPatExpr)} + | PatExpr_Irrefutable {hsrange_PatExpr_Irrefutable :: !(Range),patExpr_PatExpr_Irrefutable :: !(PatExpr)} + | PatExpr_Bang {hsrange_PatExpr_Bang :: !(Range),patExpr_PatExpr_Bang :: !(PatExpr)} + | PatExpr_Expr {hsrange_PatExpr_Expr :: !(Range),expr_PatExpr_Expr :: !(Expr),mbConst_PatExpr_Expr :: !((Maybe SrcConst))} +-- PatExprAnn -------------------------------------------------- +data PatExprAnn = PatExprAnn_Empty {} +-- PrExpr ------------------------------------------------------ +data PrExpr = PrExpr_Class {hsrange_PrExpr_Class :: !(Range),nm_PrExpr_Class :: !(HsName),tyExprs_PrExpr_Class :: !(TyExprs)} + | PrExpr_Arrow {hsrange_PrExpr_Arrow :: !(Range),arg_PrExpr_Arrow :: !(PrExpr),res_PrExpr_Arrow :: !(PrExpr)} + | PrExpr_Forall {hsrange_PrExpr_Forall :: !(Range),tyVar_PrExpr_Forall :: !(HsName),prExpr_PrExpr_Forall :: !(PrExpr)} + | PrExpr_Lacks {hsrange_PrExpr_Lacks :: !(Range),rowTyExpr_PrExpr_Lacks :: !(RowTyExpr),nm_PrExpr_Lacks :: !(HsName)} + | PrExpr_DynVar {hsrange_PrExpr_DynVar :: !(Range),nm_PrExpr_DynVar :: !(HsName),tyExpr_PrExpr_DynVar :: !(TyExpr)} + | PrExpr_Eq {hsrange_PrExpr_Eq :: !(Range),tyExpr1_PrExpr_Eq :: !(TyExpr),tyExpr2_PrExpr_Eq :: !(TyExpr)} +-- PrExprs ----------------------------------------------------- +type PrExprs = [PrExpr] +-- RecExpr ----------------------------------------------------- +data RecExpr = RecExpr_Empty {hsrange_RecExpr_Empty :: !(Range)} + | RecExpr_Ext {hsrange_RecExpr_Ext :: !(Range),recExpr_RecExpr_Ext :: !(RecExpr),mbNm_RecExpr_Ext :: !((Maybe HsName)),expr_RecExpr_Ext :: !(Expr)} + | RecExpr_Upd {hsrange_RecExpr_Upd :: !(Range),recExpr_RecExpr_Upd :: !(RecExpr),nm_RecExpr_Upd :: !(HsName),expr_RecExpr_Upd :: !(Expr)} + | RecExpr_Expr {hsrange_RecExpr_Expr :: !(Range),expr_RecExpr_Expr :: !(Expr)} +-- RecPatExpr -------------------------------------------------- +data RecPatExpr = RecPatExpr_Empty {hsrange_RecPatExpr_Empty :: !(Range)} + | RecPatExpr_Ext {hsrange_RecPatExpr_Ext :: !(Range),recPatExpr_RecPatExpr_Ext :: !(RecPatExpr),mbNm_RecPatExpr_Ext :: !((Maybe HsName)),patExpr_RecPatExpr_Ext :: !(PatExpr)} + | RecPatExpr_Expr {hsrange_RecPatExpr_Expr :: !(Range),patExpr_RecPatExpr_Expr :: !(PatExpr)} +-- RowTyExpr --------------------------------------------------- +data RowTyExpr = RowTyExpr_Empty {hsrange_RowTyExpr_Empty :: !(Range)} + | RowTyExpr_Ext {hsrange_RowTyExpr_Ext :: !(Range),rowTyExpr_RowTyExpr_Ext :: !(RowTyExpr),mbNm_RowTyExpr_Ext :: !((Maybe HsName)),tyExpr_RowTyExpr_Ext :: !(TyExpr)} + | RowTyExpr_Var {hsrange_RowTyExpr_Var :: !(Range),nm_RowTyExpr_Var :: !(HsName)} +-- TyExpr ------------------------------------------------------ +data TyExpr = TyExpr_Con {hsrange_TyExpr_Con :: !(Range),nm_TyExpr_Con :: !(HsName)} + | TyExpr_App {hsrange_TyExpr_App :: !(Range),func_TyExpr_App :: !(TyExpr),arg_TyExpr_App :: !(TyExpr)} + | TyExpr_AppTop {hsrange_TyExpr_AppTop :: !(Range),tyExpr_TyExpr_AppTop :: !(TyExpr)} + | TyExpr_Parens {hsrange_TyExpr_Parens :: !(Range),tyExpr_TyExpr_Parens :: !(TyExpr)} + | TyExpr_Ann {hsrange_TyExpr_Ann :: !(Range),ann_TyExpr_Ann :: !(TyExprAnn),tyExpr_TyExpr_Ann :: !(TyExpr)} + | TyExpr_Wild {hsrange_TyExpr_Wild :: !(Range)} + | TyExpr_Mono {hsrange_TyExpr_Mono :: !(Range)} + | TyExpr_Var {hsrange_TyExpr_Var :: !(Range),nm_TyExpr_Var :: !(HsName)} + | TyExpr_VarWild {hsrange_TyExpr_VarWild :: !(Range),nm_TyExpr_VarWild :: !(HsName)} + | TyExpr_Quant {hsrange_TyExpr_Quant :: !(Range),qu_TyExpr_Quant :: !(TyQu),tyVar_TyExpr_Quant :: !(HsName),tyExpr_TyExpr_Quant :: !(TyExpr)} + | TyExpr_Row {hsrange_TyExpr_Row :: !(Range),rowTyExpr_TyExpr_Row :: !(RowTyExpr)} + | TyExpr_Pred {hsrange_TyExpr_Pred :: !(Range),prExpr_TyExpr_Pred :: !(PrExpr)} + | TyExpr_Impls {hsrange_TyExpr_Impls :: !(Range)} + | TyExpr_NoImpls {hsrange_TyExpr_NoImpls :: !(Range)} + | TyExpr_Lam {hsrange_TyExpr_Lam :: !(Range),tyVar_TyExpr_Lam :: !(HsName),tyExpr_TyExpr_Lam :: !(TyExpr)} +-- TyExprAnn --------------------------------------------------- +data TyExprAnn = TyExprAnn_Empty {} + | TyExprAnn_Strictness {strictness_TyExprAnn_Strictness :: !(Strictness)} +-- TyExprs ----------------------------------------------------- +type TyExprs = [TyExpr] +-- TyVar ------------------------------------------------------- +data TyVar = TyVar_Var {hsrange_TyVar_Var :: !(Range),nm_TyVar_Var :: !(HsName)} +-- TyVars ------------------------------------------------------ +type TyVars = [TyVar] diff --git a/src/UHC/Light/Compiler/EH/MainAG.hs b/src/UHC/Light/Compiler/EH/MainAG.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG.hs @@ -0,0 +1,500 @@ + + +module UHC.Light.Compiler.EH.MainAG where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common +import UHC.Light.Compiler.EH.MainAG_AGItf +import UHC.Light.Compiler.EH.MainAG_CaseAlt +import UHC.Light.Compiler.EH.MainAG_CaseAlts +import UHC.Light.Compiler.EH.MainAG_DataConstr +import UHC.Light.Compiler.EH.MainAG_DataConstrs +import UHC.Light.Compiler.EH.MainAG_DataField +import UHC.Light.Compiler.EH.MainAG_DataFieldExpr +import UHC.Light.Compiler.EH.MainAG_DataFieldPatExpr +import UHC.Light.Compiler.EH.MainAG_DataFields +import UHC.Light.Compiler.EH.MainAG_Decl +import UHC.Light.Compiler.EH.MainAG_Decls +import UHC.Light.Compiler.EH.MainAG_Expr +import UHC.Light.Compiler.EH.MainAG_ExprAnn +import UHC.Light.Compiler.EH.MainAG_FuncDep +import UHC.Light.Compiler.EH.MainAG_FuncDeps +import UHC.Light.Compiler.EH.MainAG_KiExpr +import UHC.Light.Compiler.EH.MainAG_KiExprAnn +import UHC.Light.Compiler.EH.MainAG_MbTyExpr +import UHC.Light.Compiler.EH.MainAG_PatExpr +import UHC.Light.Compiler.EH.MainAG_PatExprAnn +import UHC.Light.Compiler.EH.MainAG_PrExpr +import UHC.Light.Compiler.EH.MainAG_PrExprs +import UHC.Light.Compiler.EH.MainAG_RecExpr +import UHC.Light.Compiler.EH.MainAG_RecPatExpr +import UHC.Light.Compiler.EH.MainAG_RowTyExpr +import UHC.Light.Compiler.EH.MainAG_TyExpr +import UHC.Light.Compiler.EH.MainAG_TyExprAnn +import UHC.Light.Compiler.EH.MainAG_TyExprs +import UHC.Light.Compiler.EH.MainAG_TyVar +import UHC.Light.Compiler.EH.MainAG_TyVars +-- AGItf ------------------------------------------------------- +-- cata +sem_AGItf :: AGItf -> + T_AGItf +sem_AGItf (AGItf_AGItf _expr) | (AGItf_AGItf _expr) `seq` (True) = + (sem_AGItf_AGItf (sem_Expr _expr)) +data Inh_AGItf = Inh_AGItf {chrStore_Inh_AGItf :: !(ScopedPredStore),clDfGam_Inh_AGItf :: !(ClassDefaultGam),clGam_Inh_AGItf :: !(ClGam),dataGam_Inh_AGItf :: !(DataGam),gUniq_Inh_AGItf :: !(UID),idQualGam_Inh_AGItf :: !(IdQualGam),isMainMod_Inh_AGItf :: !(Bool),kiGam_Inh_AGItf :: !(KiGam),moduleNm_Inh_AGItf :: !(HsName),opts_Inh_AGItf :: !(EHCOpts),polGam_Inh_AGItf :: !(PolGam),tyGam_Inh_AGItf :: !(TyGam),tyKiGam_Inh_AGItf :: !(TyKiGam),valGam_Inh_AGItf :: !(ValGam)} +data Syn_AGItf = Syn_AGItf {allErrSq_Syn_AGItf :: !(ErrSq),cmodule_Syn_AGItf :: !(CModule),gUniq_Syn_AGItf :: !(UID),gathChrStore_Syn_AGItf :: !(ScopedPredStore),gathClDfGam_Syn_AGItf :: !(ClassDefaultGam),gathClGam_Syn_AGItf :: !(ClGam),gathDataGam_Syn_AGItf :: !(DataGam),gathHiddenExports_Syn_AGItf :: !((Seq.Seq (HsName,IdOccKind))),gathKiGam_Syn_AGItf :: !(KiGam),gathLamMp_Syn_AGItf :: !(LamMp),gathMentrelFilterMp_Syn_AGItf :: !(ModEntRelFilterMp),gathPolGam_Syn_AGItf :: !(PolGam),gathTyGam_Syn_AGItf :: !(TyGam),gathTyKiGam_Syn_AGItf :: !(TyKiGam),gathValGam_Syn_AGItf :: !(ValGam),mbOrphan_Syn_AGItf :: !((Maybe (Set.Set HsName))),pp_Syn_AGItf :: !(PP_Doc),topTyPP_Syn_AGItf :: !(PP_Doc)} +wrap_AGItf :: T_AGItf -> + Inh_AGItf -> + Syn_AGItf +wrap_AGItf sem (Inh_AGItf _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIisMainMod _lhsIkiGam _lhsImoduleNm _lhsIopts _lhsIpolGam _lhsItyGam _lhsItyKiGam _lhsIvalGam) | sem `seq` ((Inh_AGItf _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIisMainMod _lhsIkiGam _lhsImoduleNm _lhsIopts _lhsIpolGam _lhsItyGam _lhsItyKiGam _lhsIvalGam) `seq` (True)) = + (let ( _lhsOallErrSq,_lhsOcmodule,_lhsOgUniq,_lhsOgathChrStore,_lhsOgathClDfGam,_lhsOgathClGam,_lhsOgathDataGam,_lhsOgathHiddenExports,_lhsOgathKiGam,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathPolGam,_lhsOgathTyGam,_lhsOgathTyKiGam,_lhsOgathValGam,_lhsOmbOrphan,_lhsOpp,_lhsOtopTyPP) | True = sem _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIisMainMod _lhsIkiGam _lhsImoduleNm _lhsIopts _lhsIpolGam _lhsItyGam _lhsItyKiGam _lhsIvalGam + in (Syn_AGItf _lhsOallErrSq _lhsOcmodule _lhsOgUniq _lhsOgathChrStore _lhsOgathClDfGam _lhsOgathClGam _lhsOgathDataGam _lhsOgathHiddenExports _lhsOgathKiGam _lhsOgathLamMp _lhsOgathMentrelFilterMp _lhsOgathPolGam _lhsOgathTyGam _lhsOgathTyKiGam _lhsOgathValGam _lhsOmbOrphan _lhsOpp _lhsOtopTyPP)) +-- CaseAlt ----------------------------------------------------- +-- cata +sem_CaseAlt :: CaseAlt -> + T_CaseAlt +sem_CaseAlt (CaseAlt_Pat _hsrange _patExpr _expr) | (CaseAlt_Pat _hsrange _patExpr _expr) `seq` (True) = + (sem_CaseAlt_Pat _hsrange (sem_PatExpr _patExpr) (sem_Expr _expr)) + +-- CaseAlts ---------------------------------------------------- +-- cata +sem_CaseAlts :: CaseAlts -> + T_CaseAlts +sem_CaseAlts list | list `seq` (True) = + (Prelude.foldr sem_CaseAlts_Cons sem_CaseAlts_Nil (Prelude.map sem_CaseAlt list)) + +-- DataConstr -------------------------------------------------- +-- cata +sem_DataConstr :: DataConstr -> + T_DataConstr +sem_DataConstr (DataConstr_Constr _hsrange _conNm _mbFixityPrio _fields _mbGadtTyExpr) | (DataConstr_Constr _hsrange _conNm _mbFixityPrio _fields _mbGadtTyExpr) `seq` (True) = + (sem_DataConstr_Constr _hsrange _conNm _mbFixityPrio (sem_DataFields _fields) (sem_MbTyExpr _mbGadtTyExpr)) + +-- DataConstrs ------------------------------------------------- +-- cata +sem_DataConstrs :: DataConstrs -> + T_DataConstrs +sem_DataConstrs list | list `seq` (True) = + (Prelude.foldr sem_DataConstrs_Cons sem_DataConstrs_Nil (Prelude.map sem_DataConstr list)) + +-- DataField --------------------------------------------------- +-- cata +sem_DataField :: DataField -> + T_DataField +sem_DataField (DataField_Field _hsrange _mbLabels _tyExpr) | (DataField_Field _hsrange _mbLabels _tyExpr) `seq` (True) = + (sem_DataField_Field _hsrange _mbLabels (sem_TyExpr _tyExpr)) + +-- DataFieldExpr ----------------------------------------------- +-- cata +sem_DataFieldExpr :: DataFieldExpr -> + T_DataFieldExpr +sem_DataFieldExpr (DataFieldExpr_Upd _hsrange _dataFieldExpr _nm _expr) | (DataFieldExpr_Upd _hsrange _dataFieldExpr _nm _expr) `seq` (True) = + (sem_DataFieldExpr_Upd _hsrange (sem_DataFieldExpr _dataFieldExpr) _nm (sem_Expr _expr)) +sem_DataFieldExpr (DataFieldExpr_Con _hsrange _nm) | (DataFieldExpr_Con _hsrange _nm) `seq` (True) = + (sem_DataFieldExpr_Con _hsrange _nm) +sem_DataFieldExpr (DataFieldExpr_Expr _hsrange _expr) | (DataFieldExpr_Expr _hsrange _expr) `seq` (True) = + (sem_DataFieldExpr_Expr _hsrange (sem_Expr _expr)) + +-- DataFieldPatExpr -------------------------------------------- +-- cata +sem_DataFieldPatExpr :: DataFieldPatExpr -> + T_DataFieldPatExpr +sem_DataFieldPatExpr (DataFieldPatExpr_Ext _hsrange _dataFieldPatExpr _nm _patExpr) | (DataFieldPatExpr_Ext _hsrange _dataFieldPatExpr _nm _patExpr) `seq` (True) = + (sem_DataFieldPatExpr_Ext _hsrange (sem_DataFieldPatExpr _dataFieldPatExpr) _nm (sem_PatExpr _patExpr)) +sem_DataFieldPatExpr (DataFieldPatExpr_Con _hsrange _nm) | (DataFieldPatExpr_Con _hsrange _nm) `seq` (True) = + (sem_DataFieldPatExpr_Con _hsrange _nm) + +-- DataFields -------------------------------------------------- +-- cata +sem_DataFields :: DataFields -> + T_DataFields +sem_DataFields list | list `seq` (True) = + (Prelude.foldr sem_DataFields_Cons sem_DataFields_Nil (Prelude.map sem_DataField list)) + +-- Decl -------------------------------------------------------- +-- cata +sem_Decl :: Decl -> + T_Decl +sem_Decl (Decl_TySig _hsrange _nm _tyExpr) | (Decl_TySig _hsrange _nm _tyExpr) `seq` (True) = + (sem_Decl_TySig _hsrange _nm (sem_TyExpr _tyExpr)) +sem_Decl (Decl_Val _hsrange _patExpr _expr) | (Decl_Val _hsrange _patExpr _expr) `seq` (True) = + (sem_Decl_Val _hsrange (sem_PatExpr _patExpr) (sem_Expr _expr)) +sem_Decl (Decl_Data _hsrange _isNewtype _tyNm _tyVars _constrs _mbGenerInfo) | (Decl_Data _hsrange _isNewtype _tyNm _tyVars _constrs _mbGenerInfo) `seq` (True) = + (sem_Decl_Data _hsrange _isNewtype _tyNm (sem_TyVars _tyVars) (sem_DataConstrs _constrs) _mbGenerInfo) +sem_Decl (Decl_KiSig _hsrange _nm _kiExpr) | (Decl_KiSig _hsrange _nm _kiExpr) `seq` (True) = + (sem_Decl_KiSig _hsrange _nm (sem_KiExpr _kiExpr)) +sem_Decl (Decl_FFI _hsrange _callconv _safety _impEnt _nm _tyExpr) | (Decl_FFI _hsrange _callconv _safety _impEnt _nm _tyExpr) `seq` (True) = + (sem_Decl_FFI _hsrange _callconv _safety _impEnt _nm (sem_TyExpr _tyExpr)) +sem_Decl (Decl_Type _hsrange _tyNm _tyExpr) | (Decl_Type _hsrange _tyNm _tyExpr) `seq` (True) = + (sem_Decl_Type _hsrange _tyNm (sem_TyExpr _tyExpr)) +sem_Decl (Decl_FFE _hsrange _nm _callconv _expEnt _expr _tyExpr) | (Decl_FFE _hsrange _nm _callconv _expEnt _expr _tyExpr) `seq` (True) = + (sem_Decl_FFE _hsrange _nm _callconv _expEnt (sem_Expr _expr) (sem_TyExpr _tyExpr)) +sem_Decl (Decl_GenerRep _hsrange _maxArity _tyNm _conNmL _recFldNmL) | (Decl_GenerRep _hsrange _maxArity _tyNm _conNmL _recFldNmL) `seq` (True) = + (sem_Decl_GenerRep _hsrange _maxArity _tyNm _conNmL _recFldNmL) +sem_Decl (Decl_FusionDecl _hsrange _fuseNm) | (Decl_FusionDecl _hsrange _fuseNm) `seq` (True) = + (sem_Decl_FusionDecl _hsrange _fuseNm) +sem_Decl (Decl_FusionConv _hsrange _conNm _absNm) | (Decl_FusionConv _hsrange _conNm _absNm) `seq` (True) = + (sem_Decl_FusionConv _hsrange _conNm _absNm) +sem_Decl (Decl_Class _hsrange _tyPrExpr _funcDeps _mbDefaultInstNm _decls _generDerivs) | (Decl_Class _hsrange _tyPrExpr _funcDeps _mbDefaultInstNm _decls _generDerivs) `seq` (True) = + (sem_Decl_Class _hsrange (sem_TyExpr _tyPrExpr) (sem_FuncDeps _funcDeps) _mbDefaultInstNm (sem_Decls _decls) _generDerivs) +sem_Decl (Decl_Instance _hsrange _mbNmElim _instVariant _tyPrExpr _decls) | (Decl_Instance _hsrange _mbNmElim _instVariant _tyPrExpr _decls) `seq` (True) = + (sem_Decl_Instance _hsrange _mbNmElim _instVariant (sem_TyExpr _tyPrExpr) (sem_Decls _decls)) +sem_Decl (Decl_InstanceIntro _hsrange _mbNmElim _expr _prExpr) | (Decl_InstanceIntro _hsrange _mbNmElim _expr _prExpr) `seq` (True) = + (sem_Decl_InstanceIntro _hsrange _mbNmElim (sem_Expr _expr) (sem_PrExpr _prExpr)) +sem_Decl (Decl_Default _hsrange _nm _tyExprs) | (Decl_Default _hsrange _nm _tyExprs) `seq` (True) = + (sem_Decl_Default _hsrange _nm (sem_TyExprs _tyExprs)) + +-- Decls ------------------------------------------------------- +-- cata +sem_Decls :: Decls -> + T_Decls +sem_Decls list | list `seq` (True) = + (Prelude.foldr sem_Decls_Cons sem_Decls_Nil (Prelude.map sem_Decl list)) + +-- Expr -------------------------------------------------------- +-- cata +sem_Expr :: Expr -> + T_Expr +sem_Expr (Expr_IConst _hsrange _int) | (Expr_IConst _hsrange _int) `seq` (True) = + (sem_Expr_IConst _hsrange _int) +sem_Expr (Expr_CConst _hsrange _char) | (Expr_CConst _hsrange _char) `seq` (True) = + (sem_Expr_CConst _hsrange _char) +sem_Expr (Expr_Con _hsrange _nm) | (Expr_Con _hsrange _nm) `seq` (True) = + (sem_Expr_Con _hsrange _nm) +sem_Expr (Expr_Var _hsrange _nm) | (Expr_Var _hsrange _nm) `seq` (True) = + (sem_Expr_Var _hsrange _nm) +sem_Expr (Expr_App _hsrange _func _arg) | (Expr_App _hsrange _func _arg) `seq` (True) = + (sem_Expr_App _hsrange (sem_Expr _func) (sem_Expr _arg)) +sem_Expr (Expr_Let _hsrange _isStrict _decls _body) | (Expr_Let _hsrange _isStrict _decls _body) `seq` (True) = + (sem_Expr_Let _hsrange _isStrict (sem_Decls _decls) (sem_Expr _body)) +sem_Expr (Expr_Lam _hsrange _arg _body) | (Expr_Lam _hsrange _arg _body) `seq` (True) = + (sem_Expr_Lam _hsrange (sem_PatExpr _arg) (sem_Expr _body)) +sem_Expr (Expr_AppTop _hsrange _expr) | (Expr_AppTop _hsrange _expr) `seq` (True) = + (sem_Expr_AppTop _hsrange (sem_Expr _expr)) +sem_Expr (Expr_Parens _hsrange _expr) | (Expr_Parens _hsrange _expr) `seq` (True) = + (sem_Expr_Parens _hsrange (sem_Expr _expr)) +sem_Expr (Expr_TypeAs _hsrange _isScoped _tyExpr _expr) | (Expr_TypeAs _hsrange _isScoped _tyExpr _expr) `seq` (True) = + (sem_Expr_TypeAs _hsrange _isScoped (sem_TyExpr _tyExpr) (sem_Expr _expr)) +sem_Expr (Expr_Ann _hsrange _ann _expr) | (Expr_Ann _hsrange _ann _expr) `seq` (True) = + (sem_Expr_Ann _hsrange (sem_ExprAnn _ann) (sem_Expr _expr)) +sem_Expr (Expr_AppImpred _hsrange _func _arg) | (Expr_AppImpred _hsrange _func _arg) `seq` (True) = + (sem_Expr_AppImpred _hsrange (sem_Expr _func) (sem_Expr _arg)) +sem_Expr (Expr_SConst _hsrange _str) | (Expr_SConst _hsrange _str) `seq` (True) = + (sem_Expr_SConst _hsrange _str) +sem_Expr (Expr_Case _hsrange _expr _alts _mbCaseIds _caseFailS _isTupOfArg) | (Expr_Case _hsrange _expr _alts _mbCaseIds _caseFailS _isTupOfArg) `seq` (True) = + (sem_Expr_Case _hsrange (sem_Expr _expr) (sem_CaseAlts _alts) _mbCaseIds _caseFailS _isTupOfArg) +sem_Expr (Expr_DataFields _hsrange _dataFieldExpr) | (Expr_DataFields _hsrange _dataFieldExpr) `seq` (True) = + (sem_Expr_DataFields _hsrange (sem_DataFieldExpr _dataFieldExpr)) +sem_Expr (Expr_Rec _hsrange _recExpr) | (Expr_Rec _hsrange _recExpr) `seq` (True) = + (sem_Expr_Rec _hsrange (sem_RecExpr _recExpr)) +sem_Expr (Expr_Sel _hsrange _expr _lbl) | (Expr_Sel _hsrange _expr _lbl) `seq` (True) = + (sem_Expr_Sel _hsrange (sem_Expr _expr) _lbl) +sem_Expr (Expr_Undefined _hsrange) | (Expr_Undefined _hsrange) `seq` (True) = + (sem_Expr_Undefined _hsrange) +sem_Expr (Expr_CaseAltFail _hsrange _caseId) | (Expr_CaseAltFail _hsrange _caseId) `seq` (True) = + (sem_Expr_CaseAltFail _hsrange _caseId) +sem_Expr (Expr_AppImpl _hsrange _func _argPr _arg) | (Expr_AppImpl _hsrange _func _argPr _arg) `seq` (True) = + (sem_Expr_AppImpl _hsrange (sem_Expr _func) (sem_PrExpr _argPr) (sem_Expr _arg)) +sem_Expr (Expr_LamImpl _hsrange _argPr _arg _body) | (Expr_LamImpl _hsrange _argPr _arg _body) `seq` (True) = + (sem_Expr_LamImpl _hsrange (sem_PrExpr _argPr) (sem_PatExpr _arg) (sem_Expr _body)) +sem_Expr (Expr_DynVar _hsrange _nm) | (Expr_DynVar _hsrange _nm) `seq` (True) = + (sem_Expr_DynVar _hsrange _nm) +sem_Expr (Expr_IIConst _hsrange _integer) | (Expr_IIConst _hsrange _integer) `seq` (True) = + (sem_Expr_IIConst _hsrange _integer) + +-- ExprAnn ----------------------------------------------------- +-- cata +sem_ExprAnn :: ExprAnn -> + T_ExprAnn +sem_ExprAnn (ExprAnn_Empty) | (ExprAnn_Empty) `seq` (True) = + (sem_ExprAnn_Empty) + +-- FuncDep ----------------------------------------------------- +-- cata +sem_FuncDep :: FuncDep -> + T_FuncDep +sem_FuncDep (FuncDep_Dep _hsrange _fromTvs _toTvs) | (FuncDep_Dep _hsrange _fromTvs _toTvs) `seq` (True) = + (sem_FuncDep_Dep _hsrange (sem_TyVars _fromTvs) (sem_TyVars _toTvs)) + +-- FuncDeps ---------------------------------------------------- +-- cata +sem_FuncDeps :: FuncDeps -> + T_FuncDeps +sem_FuncDeps list | list `seq` (True) = + (Prelude.foldr sem_FuncDeps_Cons sem_FuncDeps_Nil (Prelude.map sem_FuncDep list)) + +-- KiExpr ------------------------------------------------------ +-- cata +sem_KiExpr :: KiExpr -> + T_KiExpr +sem_KiExpr (KiExpr_Con _hsrange _nm) | (KiExpr_Con _hsrange _nm) `seq` (True) = + (sem_KiExpr_Con _hsrange _nm) +sem_KiExpr (KiExpr_Var _hsrange _nm) | (KiExpr_Var _hsrange _nm) `seq` (True) = + (sem_KiExpr_Var _hsrange _nm) +sem_KiExpr (KiExpr_App _hsrange _func _arg) | (KiExpr_App _hsrange _func _arg) `seq` (True) = + (sem_KiExpr_App _hsrange (sem_KiExpr _func) (sem_KiExpr _arg)) +sem_KiExpr (KiExpr_AppTop _hsrange _kiExpr) | (KiExpr_AppTop _hsrange _kiExpr) `seq` (True) = + (sem_KiExpr_AppTop _hsrange (sem_KiExpr _kiExpr)) +sem_KiExpr (KiExpr_Parens _hsrange _kiExpr) | (KiExpr_Parens _hsrange _kiExpr) `seq` (True) = + (sem_KiExpr_Parens _hsrange (sem_KiExpr _kiExpr)) +sem_KiExpr (KiExpr_Ann _hsrange _ann _kiExpr) | (KiExpr_Ann _hsrange _ann _kiExpr) `seq` (True) = + (sem_KiExpr_Ann _hsrange (sem_KiExprAnn _ann) (sem_KiExpr _kiExpr)) + +-- KiExprAnn --------------------------------------------------- +-- cata +sem_KiExprAnn :: KiExprAnn -> + T_KiExprAnn +sem_KiExprAnn (KiExprAnn_Empty) | (KiExprAnn_Empty) `seq` (True) = + (sem_KiExprAnn_Empty) + +-- MbTyExpr ---------------------------------------------------- +-- cata +sem_MbTyExpr :: MbTyExpr -> + T_MbTyExpr +sem_MbTyExpr (Prelude.Just x) | (Prelude.Just x) `seq` (True) = + (sem_MbTyExpr_Just (sem_TyExpr x)) +sem_MbTyExpr Prelude.Nothing | Prelude.Nothing `seq` (True) = + sem_MbTyExpr_Nothing + +-- PatExpr ----------------------------------------------------- +-- cata +sem_PatExpr :: PatExpr -> + T_PatExpr +sem_PatExpr (PatExpr_IConst _hsrange _int) | (PatExpr_IConst _hsrange _int) `seq` (True) = + (sem_PatExpr_IConst _hsrange _int) +sem_PatExpr (PatExpr_CConst _hsrange _char) | (PatExpr_CConst _hsrange _char) `seq` (True) = + (sem_PatExpr_CConst _hsrange _char) +sem_PatExpr (PatExpr_Con _hsrange _nm) | (PatExpr_Con _hsrange _nm) `seq` (True) = + (sem_PatExpr_Con _hsrange _nm) +sem_PatExpr (PatExpr_Var _hsrange _nm) | (PatExpr_Var _hsrange _nm) `seq` (True) = + (sem_PatExpr_Var _hsrange _nm) +sem_PatExpr (PatExpr_VarAs _hsrange _nm _patExpr) | (PatExpr_VarAs _hsrange _nm _patExpr) `seq` (True) = + (sem_PatExpr_VarAs _hsrange _nm (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_App _hsrange _func _arg) | (PatExpr_App _hsrange _func _arg) `seq` (True) = + (sem_PatExpr_App _hsrange (sem_PatExpr _func) (sem_PatExpr _arg)) +sem_PatExpr (PatExpr_AppTop _hsrange _patExpr) | (PatExpr_AppTop _hsrange _patExpr) `seq` (True) = + (sem_PatExpr_AppTop _hsrange (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_Parens _hsrange _patExpr) | (PatExpr_Parens _hsrange _patExpr) `seq` (True) = + (sem_PatExpr_Parens _hsrange (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_Ann _hsrange _ann _patExpr) | (PatExpr_Ann _hsrange _ann _patExpr) `seq` (True) = + (sem_PatExpr_Ann _hsrange (sem_PatExprAnn _ann) (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_TypeAs _hsrange _tyExpr _patExpr) | (PatExpr_TypeAs _hsrange _tyExpr _patExpr) `seq` (True) = + (sem_PatExpr_TypeAs _hsrange (sem_TyExpr _tyExpr) (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_SConst _hsrange _str) | (PatExpr_SConst _hsrange _str) `seq` (True) = + (sem_PatExpr_SConst _hsrange _str) +sem_PatExpr (PatExpr_Rec _hsrange _recPatExpr) | (PatExpr_Rec _hsrange _recPatExpr) `seq` (True) = + (sem_PatExpr_Rec _hsrange (sem_RecPatExpr _recPatExpr)) +sem_PatExpr (PatExpr_DataFields _hsrange _dataFieldPatExpr) | (PatExpr_DataFields _hsrange _dataFieldPatExpr) `seq` (True) = + (sem_PatExpr_DataFields _hsrange (sem_DataFieldPatExpr _dataFieldPatExpr)) +sem_PatExpr (PatExpr_Irrefutable _hsrange _patExpr) | (PatExpr_Irrefutable _hsrange _patExpr) `seq` (True) = + (sem_PatExpr_Irrefutable _hsrange (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_Bang _hsrange _patExpr) | (PatExpr_Bang _hsrange _patExpr) `seq` (True) = + (sem_PatExpr_Bang _hsrange (sem_PatExpr _patExpr)) +sem_PatExpr (PatExpr_Expr _hsrange _expr _mbConst) | (PatExpr_Expr _hsrange _expr _mbConst) `seq` (True) = + (sem_PatExpr_Expr _hsrange (sem_Expr _expr) _mbConst) + +-- PatExprAnn -------------------------------------------------- +-- cata +sem_PatExprAnn :: PatExprAnn -> + T_PatExprAnn +sem_PatExprAnn (PatExprAnn_Empty) | (PatExprAnn_Empty) `seq` (True) = + (sem_PatExprAnn_Empty) + +-- PrExpr ------------------------------------------------------ +-- cata +sem_PrExpr :: PrExpr -> + T_PrExpr +sem_PrExpr (PrExpr_Class _hsrange _nm _tyExprs) | (PrExpr_Class _hsrange _nm _tyExprs) `seq` (True) = + (sem_PrExpr_Class _hsrange _nm (sem_TyExprs _tyExprs)) +sem_PrExpr (PrExpr_Arrow _hsrange _arg _res) | (PrExpr_Arrow _hsrange _arg _res) `seq` (True) = + (sem_PrExpr_Arrow _hsrange (sem_PrExpr _arg) (sem_PrExpr _res)) +sem_PrExpr (PrExpr_Forall _hsrange _tyVar _prExpr) | (PrExpr_Forall _hsrange _tyVar _prExpr) `seq` (True) = + (sem_PrExpr_Forall _hsrange _tyVar (sem_PrExpr _prExpr)) +sem_PrExpr (PrExpr_Lacks _hsrange _rowTyExpr _nm) | (PrExpr_Lacks _hsrange _rowTyExpr _nm) `seq` (True) = + (sem_PrExpr_Lacks _hsrange (sem_RowTyExpr _rowTyExpr) _nm) +sem_PrExpr (PrExpr_DynVar _hsrange _nm _tyExpr) | (PrExpr_DynVar _hsrange _nm _tyExpr) `seq` (True) = + (sem_PrExpr_DynVar _hsrange _nm (sem_TyExpr _tyExpr)) +sem_PrExpr (PrExpr_Eq _hsrange _tyExpr1 _tyExpr2) | (PrExpr_Eq _hsrange _tyExpr1 _tyExpr2) `seq` (True) = + (sem_PrExpr_Eq _hsrange (sem_TyExpr _tyExpr1) (sem_TyExpr _tyExpr2)) + +-- PrExprs ----------------------------------------------------- +-- cata +sem_PrExprs :: PrExprs -> + T_PrExprs +sem_PrExprs list | list `seq` (True) = + (Prelude.foldr sem_PrExprs_Cons sem_PrExprs_Nil (Prelude.map sem_PrExpr list)) + +-- RecExpr ----------------------------------------------------- +-- cata +sem_RecExpr :: RecExpr -> + T_RecExpr +sem_RecExpr (RecExpr_Empty _hsrange) | (RecExpr_Empty _hsrange) `seq` (True) = + (sem_RecExpr_Empty _hsrange) +sem_RecExpr (RecExpr_Ext _hsrange _recExpr _mbNm _expr) | (RecExpr_Ext _hsrange _recExpr _mbNm _expr) `seq` (True) = + (sem_RecExpr_Ext _hsrange (sem_RecExpr _recExpr) _mbNm (sem_Expr _expr)) +sem_RecExpr (RecExpr_Upd _hsrange _recExpr _nm _expr) | (RecExpr_Upd _hsrange _recExpr _nm _expr) `seq` (True) = + (sem_RecExpr_Upd _hsrange (sem_RecExpr _recExpr) _nm (sem_Expr _expr)) +sem_RecExpr (RecExpr_Expr _hsrange _expr) | (RecExpr_Expr _hsrange _expr) `seq` (True) = + (sem_RecExpr_Expr _hsrange (sem_Expr _expr)) + +-- RecPatExpr -------------------------------------------------- +-- cata +sem_RecPatExpr :: RecPatExpr -> + T_RecPatExpr +sem_RecPatExpr (RecPatExpr_Empty _hsrange) | (RecPatExpr_Empty _hsrange) `seq` (True) = + (sem_RecPatExpr_Empty _hsrange) +sem_RecPatExpr (RecPatExpr_Ext _hsrange _recPatExpr _mbNm _patExpr) | (RecPatExpr_Ext _hsrange _recPatExpr _mbNm _patExpr) `seq` (True) = + (sem_RecPatExpr_Ext _hsrange (sem_RecPatExpr _recPatExpr) _mbNm (sem_PatExpr _patExpr)) +sem_RecPatExpr (RecPatExpr_Expr _hsrange _patExpr) | (RecPatExpr_Expr _hsrange _patExpr) `seq` (True) = + (sem_RecPatExpr_Expr _hsrange (sem_PatExpr _patExpr)) + +-- RowTyExpr --------------------------------------------------- +-- cata +sem_RowTyExpr :: RowTyExpr -> + T_RowTyExpr +sem_RowTyExpr (RowTyExpr_Empty _hsrange) | (RowTyExpr_Empty _hsrange) `seq` (True) = + (sem_RowTyExpr_Empty _hsrange) +sem_RowTyExpr (RowTyExpr_Ext _hsrange _rowTyExpr _mbNm _tyExpr) | (RowTyExpr_Ext _hsrange _rowTyExpr _mbNm _tyExpr) `seq` (True) = + (sem_RowTyExpr_Ext _hsrange (sem_RowTyExpr _rowTyExpr) _mbNm (sem_TyExpr _tyExpr)) +sem_RowTyExpr (RowTyExpr_Var _hsrange _nm) | (RowTyExpr_Var _hsrange _nm) `seq` (True) = + (sem_RowTyExpr_Var _hsrange _nm) + +-- TyExpr ------------------------------------------------------ +-- cata +sem_TyExpr :: TyExpr -> + T_TyExpr +sem_TyExpr (TyExpr_Con _hsrange _nm) | (TyExpr_Con _hsrange _nm) `seq` (True) = + (sem_TyExpr_Con _hsrange _nm) +sem_TyExpr (TyExpr_App _hsrange _func _arg) | (TyExpr_App _hsrange _func _arg) `seq` (True) = + (sem_TyExpr_App _hsrange (sem_TyExpr _func) (sem_TyExpr _arg)) +sem_TyExpr (TyExpr_AppTop _hsrange _tyExpr) | (TyExpr_AppTop _hsrange _tyExpr) `seq` (True) = + (sem_TyExpr_AppTop _hsrange (sem_TyExpr _tyExpr)) +sem_TyExpr (TyExpr_Parens _hsrange _tyExpr) | (TyExpr_Parens _hsrange _tyExpr) `seq` (True) = + (sem_TyExpr_Parens _hsrange (sem_TyExpr _tyExpr)) +sem_TyExpr (TyExpr_Ann _hsrange _ann _tyExpr) | (TyExpr_Ann _hsrange _ann _tyExpr) `seq` (True) = + (sem_TyExpr_Ann _hsrange (sem_TyExprAnn _ann) (sem_TyExpr _tyExpr)) +sem_TyExpr (TyExpr_Wild _hsrange) | (TyExpr_Wild _hsrange) `seq` (True) = + (sem_TyExpr_Wild _hsrange) +sem_TyExpr (TyExpr_Mono _hsrange) | (TyExpr_Mono _hsrange) `seq` (True) = + (sem_TyExpr_Mono _hsrange) +sem_TyExpr (TyExpr_Var _hsrange _nm) | (TyExpr_Var _hsrange _nm) `seq` (True) = + (sem_TyExpr_Var _hsrange _nm) +sem_TyExpr (TyExpr_VarWild _hsrange _nm) | (TyExpr_VarWild _hsrange _nm) `seq` (True) = + (sem_TyExpr_VarWild _hsrange _nm) +sem_TyExpr (TyExpr_Quant _hsrange _qu _tyVar _tyExpr) | (TyExpr_Quant _hsrange _qu _tyVar _tyExpr) `seq` (True) = + (sem_TyExpr_Quant _hsrange _qu _tyVar (sem_TyExpr _tyExpr)) +sem_TyExpr (TyExpr_Row _hsrange _rowTyExpr) | (TyExpr_Row _hsrange _rowTyExpr) `seq` (True) = + (sem_TyExpr_Row _hsrange (sem_RowTyExpr _rowTyExpr)) +sem_TyExpr (TyExpr_Pred _hsrange _prExpr) | (TyExpr_Pred _hsrange _prExpr) `seq` (True) = + (sem_TyExpr_Pred _hsrange (sem_PrExpr _prExpr)) +sem_TyExpr (TyExpr_Impls _hsrange) | (TyExpr_Impls _hsrange) `seq` (True) = + (sem_TyExpr_Impls _hsrange) +sem_TyExpr (TyExpr_NoImpls _hsrange) | (TyExpr_NoImpls _hsrange) `seq` (True) = + (sem_TyExpr_NoImpls _hsrange) +sem_TyExpr (TyExpr_Lam _hsrange _tyVar _tyExpr) | (TyExpr_Lam _hsrange _tyVar _tyExpr) `seq` (True) = + (sem_TyExpr_Lam _hsrange _tyVar (sem_TyExpr _tyExpr)) + +-- TyExprAnn --------------------------------------------------- +-- cata +sem_TyExprAnn :: TyExprAnn -> + T_TyExprAnn +sem_TyExprAnn (TyExprAnn_Empty) | (TyExprAnn_Empty) `seq` (True) = + (sem_TyExprAnn_Empty) +sem_TyExprAnn (TyExprAnn_Strictness _strictness) | (TyExprAnn_Strictness _strictness) `seq` (True) = + (sem_TyExprAnn_Strictness _strictness) + +-- TyExprs ----------------------------------------------------- +-- cata +sem_TyExprs :: TyExprs -> + T_TyExprs +sem_TyExprs list | list `seq` (True) = + (Prelude.foldr sem_TyExprs_Cons sem_TyExprs_Nil (Prelude.map sem_TyExpr list)) + +-- TyVar ------------------------------------------------------- +-- cata +sem_TyVar :: TyVar -> + T_TyVar +sem_TyVar (TyVar_Var _hsrange _nm) | (TyVar_Var _hsrange _nm) `seq` (True) = + (sem_TyVar_Var _hsrange _nm) + +-- TyVars ------------------------------------------------------ +-- cata +sem_TyVars :: TyVars -> + T_TyVars +sem_TyVars list | list `seq` (True) = + (Prelude.foldr sem_TyVars_Cons sem_TyVars_Nil (Prelude.map sem_TyVar list)) + + diff --git a/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs b/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs @@ -0,0 +1,514 @@ + + + +module UHC.Light.Compiler.EH.MainAG_AGItf where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- AGItf ------------------------------------------------------- +{- + visit 0: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + clGam : ClGam + dataGam : DataGam + idQualGam : IdQualGam + isMainMod : Bool + kiGam : KiGam + moduleNm : HsName + opts : EHCOpts + polGam : PolGam + tyGam : TyGam + tyKiGam : TyKiGam + valGam : ValGam + chained attribute: + gUniq : UID + synthesized attributes: + allErrSq : ErrSq + cmodule : CModule + gathChrStore : ScopedPredStore + gathClDfGam : ClassDefaultGam + gathClGam : ClGam + gathDataGam : DataGam + gathHiddenExports : Seq.Seq (HsName,IdOccKind) + gathKiGam : KiGam + gathLamMp : LamMp + gathMentrelFilterMp : ModEntRelFilterMp + gathPolGam : PolGam + gathTyGam : TyGam + gathTyKiGam : TyKiGam + gathValGam : ValGam + mbOrphan : Maybe (Set.Set HsName) + pp : PP_Doc + topTyPP : PP_Doc + alternatives: + alternative AGItf: + child expr : Expr + visit 0: + local valGam : _ + local tyKiGam : _ + local tyGam : _ + local clGam : _ + local sysfEnv : _ + local predScope : {PredScope} + local predSameScopeCounter : {Int} + local polGam : _ + local lexLev : {Int} + local _tup8 : _ + local kiGam : _ + local kiVarMp : _ + local clDfGam : _ + local lUniq : {UID} + local chrFIIn : {FIIn} + local _tup4 : _ + local instsOuter : _ + local initChrStore : _ + local _tup5 : _ + local chrStoreOuterScope : _ + local instsInner : _ + local _tup6 : _ + local chrStore : _ + local rangeMp : _ + local finValGam : {ValGam} + local lUniq_9_simplify : {UID} + local toProveCnstrMp : _ + local toProveHereCnstrMp : _ + local chrProveFIIn : {FIIn} + local _tup1 : _ + local chrSolveSimpTyVarMp : _ + local finTyVarMp : _ + local lUniq_98_fitsIn_ty : {UID} + local lUniq_98_IO_tvar : {UID} + local chrSolveMainScopeBindMp : _ + local _tup3 : _ + local chrScopeBindMp : _ + local chrSolveMainEvidBindMp : _ + local chrEvidBindMp : _ + local cSubst : _ + local fe : {FIEnv} + local _tup7 : _ + local nmErrs : {ErrL} + local foMain : _ + local chrSolveMainRemCnstrMp : _ + local cannotProveCnstrMp : _ + local predNotPrfErrs : _ + local chrSolveMainErrs : _ + local lErrSq : _ + local chrScopeMainBindL : _ + local extraCBindL : _ + local mainDefExists : _ + local insertMainDef : _ + local mainUseExists : _ + local insertMainUse : _ + local gathChrStore : _ + local chrSimplifyResult : _ + local gathMentrelFilterMp : _ + local errTopPP : _ + local extraPP : _ +-} +sem_AGItf_AGItf :: T_Expr -> + T_AGItf + +sem_AGItf_AGItf expr_ | expr_ `seq` (True) = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIdataGam + _lhsIgUniq + _lhsIidQualGam + _lhsIisMainMod + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIpolGam + _lhsItyGam + _lhsItyKiGam + _lhsIvalGam -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIgUniq `seq` + (_lhsIidQualGam `seq` + (_lhsIisMainMod `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _valGam | _valGam `seq` (True) -> + (case (_valGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _tyKiGam | _tyKiGam `seq` (True) -> + (case (_tyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _tyGam | _tyGam `seq` (True) -> + (case (_tyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIclGam) of + { _clGam | _clGam `seq` (True) -> + (case (emptyToSysfEnv + { sysfenvTyKiGam = _tyKiGam + , sysfenvClGam = _clGam + }) of + { _sysfEnv | _sysfEnv `seq` (True) -> + (case (_sysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (initPredScope) of + { _predScope | _predScope `seq` (True) -> + (case (_predScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (0) of + { _predSameScopeCounter | _predSameScopeCounter `seq` (True) -> + (case (_predSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIpolGam) of + { _polGam | _polGam `seq` (True) -> + (case (_polGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (-1) of + { _lexLev | _lexLev `seq` (True) -> + (case (_lexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_98_IO_tvar) -> case nextUnique __cont of { (__cont, lUniq_98_fitsIn_ty) -> case nextUnique __cont of { (__cont, lUniq_9_simplify) -> (__cont,lUniq,lUniq_98_IO_tvar,lUniq_98_fitsIn_ty,lUniq_9_simplify)}}}} )) of + { __tup8 | __tup8 `seq` (True) -> + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (__tup8) of + { (_exprOgUniq,_,_,_,_) | _exprOgUniq `seq` (True) -> + (case (_lhsIkiGam) of + { _kiGam | _kiGam `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_kiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (emptyVarMp) of + { _kiVarMp | _kiVarMp `seq` (True) -> + (case (_kiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (_clGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (Set.empty) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (emptyVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (emptyGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_exprIkiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (Set.empty) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (emptyGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam `gamUnion` _lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_exprIgathClDfGam `gamUnion` _lhsIclDfGam) of + { _clDfGam | _clDfGam `seq` (True) -> + (case (_clDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (__tup8) of + { (_,_lUniq,_,_,_) | _lUniq `seq` (True) -> + (case (_exprIchrFIIn {fiUniq = _lUniq}) of + { _chrFIIn | _chrFIIn `seq` (True) -> + (case (partition (\(_,_,_,sc) -> sc == initPredScope) $ Seq.toList _exprIchrInstDeclSq) of + { __tup4 | __tup4 `seq` (True) -> + (case (__tup4) of + { (_instsOuter,_) | _instsOuter `seq` (True) -> + (case (_lhsIchrStore) of + { _initChrStore | _initChrStore `seq` (True) -> + (case (mkScopedCHR2 _chrFIIn (Seq.toList _exprIchrClassDeclSq) _instsOuter _initChrStore) of + { __tup5 | __tup5 `seq` (True) -> + (case (__tup5) of + { (_chrStoreOuterScope,_) | _chrStoreOuterScope `seq` (True) -> + (case (__tup4) of + { (_,_instsInner) | _instsInner `seq` (True) -> + (case (mkScopedCHR2 _chrFIIn [] _instsInner _chrStoreOuterScope) of + { __tup6 | __tup6 `seq` (True) -> + (case (__tup6) of + { (_chrStore,_) | _chrStore `seq` (True) -> + (case (_chrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (emptyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (Ty_Any) of + { _exprOknTy | _exprOknTy `seq` (True) -> + (case (strongFIOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (_exprIkiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (Set.empty) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (Set.empty) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (Map.unionsWith (++) + $ map (\(c,r) -> Map.singleton (_exprItyVarMp `varUpd` c) r) + $ Map.toList + $ _exprIgathRangeMp + `Map.union` cnstrMpToRangeMp _exprIgathCnstrMp) of + { _rangeMp | _rangeMp `seq` (True) -> + (case (_rangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_exprIgathValGam `gamUnion` _lhsIvalGam) of + { _finValGam | _finValGam `seq` (True) -> + (case (_finValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (__tup8) of + { (_,_,_,_,_lUniq_9_simplify) | _lUniq_9_simplify `seq` (True) -> + (case (_exprItyVarMp `varUpd` _exprIgathCnstrMp) of + { _toProveCnstrMp | _toProveCnstrMp `seq` (True) -> + (case (_toProveCnstrMp) of + { _toProveHereCnstrMp | _toProveHereCnstrMp `seq` (True) -> + (case (_chrFIIn {fiVarMp = _exprItyVarMp}) of + { _chrProveFIIn | _chrProveFIIn `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.simplify" $ + simplify [SimplifyHow_Canonicalize] (_chrProveFIIn {fiUniq = _lUniq_9_simplify}) _chrStore _clDfGam (heurScopedEHC _chrProveFIIn) (\x -> (x,[])) Map.empty _toProveHereCnstrMp emptySimplifyResult) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_,_,_,_chrSolveSimpTyVarMp,_,_,_,_,_,_) | _chrSolveSimpTyVarMp `seq` (True) -> + (case (_chrSolveSimpTyVarMp `varUpd` + _exprItyVarMp) of + { _finTyVarMp | _finTyVarMp `seq` (True) -> + (case (_finTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (__tup8) of + { (_,_,_,_lUniq_98_fitsIn_ty,_) | _lUniq_98_fitsIn_ty `seq` (True) -> + (case (__tup8) of + { (_,_,_lUniq_98_IO_tvar,_,_) | _lUniq_98_IO_tvar `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (__tup1) of + { (_,_,_,_,_,_,_,_,_chrSolveMainScopeBindMp,_) | _chrSolveMainScopeBindMp `seq` (True) -> + (case (mkScopeBindings True _predScope _chrSolveMainScopeBindMp) of + { __tup3 | __tup3 `seq` (True) -> + (case (__tup3) of + { (_,_chrScopeBindMp) | _chrScopeBindMp `seq` (True) -> + (case (_chrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (__tup1) of + { (_,_,_,_,_,_,_,_chrSolveMainEvidBindMp,_,_) | _chrSolveMainEvidBindMp `seq` (True) -> + (case (_chrSolveMainEvidBindMp) of + { _chrEvidBindMp | _chrEvidBindMp `seq` (True) -> + (case (_chrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (emptyCSubst) of + { _cSubst | _cSubst `seq` (True) -> + (case (_cSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _predScope + , feTyGam = _exprIgathTyGam + , fePolGam = _exprIgathPolGam + , feRange = emptyRange + }) of + { _fe | _fe `seq` (True) -> + (case (if _lhsIisMainMod + then let (t,e) = valGamLookupTy hsnMain _exprIgathValGam + in (fitsIn strongFIOpts _fe _lUniq_98_fitsIn_ty _exprItyVarMp t (tyTopLevelMain _lhsIopts _lUniq_98_IO_tvar), e) + else (emptyFO,[])) of + { __tup7 | __tup7 `seq` (True) -> + (case (__tup7) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (__tup7) of + { (_foMain,_) | _foMain `seq` (True) -> + (case (__tup1) of + { (_,_chrSolveMainRemCnstrMp,_,_,_,_,_,_,_,_) | _chrSolveMainRemCnstrMp `seq` (True) -> + (case (_chrSolveMainRemCnstrMp) of + { _cannotProveCnstrMp | _cannotProveCnstrMp `seq` (True) -> + (case (mkPrvErr _rangeMp emptyRange _cannotProveCnstrMp) of + { _predNotPrfErrs | _predNotPrfErrs `seq` (True) -> + (case (__tup1) of + { (_,_,_,_,_chrSolveMainErrs,_,_,_,_,_) | _chrSolveMainErrs `seq` (True) -> + (case (Seq.unions [ Seq.fromList _predNotPrfErrs + , Seq.fromList _chrSolveMainErrs + , Seq.fromList _nmErrs + , foErrSq _foMain + ]) of + { _lErrSq | _lErrSq `seq` (True) -> + (case (Seq.unions [_lErrSq, _exprIallErrSq]) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (__tup3) of + { (_chrScopeMainBindL,_) | _chrScopeMainBindL `seq` (True) -> + (case ([(CBindCateg_Rec,_chrScopeMainBindL)]) of + { _extraCBindL | _extraCBindL `seq` (True) -> + (case (let ds = [ b | (_,g) <- _exprIletValCBindL, b <- g, cbindNm b == hsnMain ] + in not (null ds)) of + { _mainDefExists | _mainDefExists `seq` (True) -> + (case (not _mainDefExists && _lhsIisMainMod) of + { _insertMainDef | _insertMainDef `seq` (True) -> + (case (case acoreExprMbVar _exprIletCBody of + Just n | n == hsnMain -> True + _ -> False) of + { _mainUseExists | _mainUseExists `seq` (True) -> + (case (not _mainUseExists && _lhsIisMainMod) of + { _insertMainUse | _insertMainUse `seq` (True) -> + (case (let b = if _insertMainUse then acoreVar hsnMain else _exprIletCBody + d = if _insertMainDef then acoreLet CBindCateg_Plain [acoreBind1Ty hsnMain (acoreTyErr $ "EH.ToCore.AGItf.main") _exprIletCBody] else id + in CModule_Mod _lhsImoduleNm + [] + [ CDeclMeta_Data tn + [ CDataCon_Con cn (ctagTag ctag) (ctagArity ctag) + | (cn,dti) <- Map.toList $ dgiConstrTagMp dgi + , let ctag = dtiCTag dti + ] + | (tn,dgi) <- gamToAssocL _exprIgathDataGam + , not (dgiIsNewtype dgi) + ] + ( + cSubstAppExpr True _exprIcSubst + (foldr (\(c,b) e -> acoreLet c b e) + (d b) + (_exprIletTyCBindL ++ _extraCBindL ++ _exprIfrontCBindL ++ _exprIletValCBindL + ++ _exprIbackCBindL + ) + ) + Nothing + )) of + { _lhsOcmodule | _lhsOcmodule `seq` (True) -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (__tup5) of + { (_,_gathChrStore) | _gathChrStore `seq` (True) -> + (case (_gathChrStore) of + { _lhsOgathChrStore | _lhsOgathChrStore `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathClDfGam" _exprIgathClDfGam) of + { _lhsOgathClDfGam | _lhsOgathClDfGam `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathClGam" _exprIgathClGam) of + { _lhsOgathClGam | _lhsOgathClGam `seq` (True) -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case (_exprIgathHiddenExports) of + { _lhsOgathHiddenExports | _lhsOgathHiddenExports `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathKiGam" _exprIgathKiGam) of + { _lhsOgathKiGam | _lhsOgathKiGam `seq` (True) -> + (case (_exprIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + (case (__tup1) of + { (_,_,_,_,_,_chrSimplifyResult,_,_,_,_) | _chrSimplifyResult `seq` (True) -> + (case (mentrelFilterMpUnions + [ _exprIgathMentrelFilterMp + , gathMentrelFilterMpFromSimplifyResult _lhsImoduleNm _chrSimplifyResult + ]) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathPolGam" _exprIgathPolGam) of + { _lhsOgathPolGam | _lhsOgathPolGam `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathTyGam" _exprIgathTyGam) of + { _lhsOgathTyGam | _lhsOgathTyGam `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathTyKiGam" _exprIgathTyKiGam) of + { _lhsOgathTyKiGam | _lhsOgathTyKiGam `seq` (True) -> + (case (ehcOptTrace _lhsIopts "AGItf.lhs.gathValGam" $ _finTyVarMp `varUpd` _exprIgathValGam) of + { _lhsOgathValGam | _lhsOgathValGam `seq` (True) -> + (case (if Set.null _exprIorphanS then Nothing else Just _exprIorphanS) of + { _lhsOmbOrphan | _lhsOmbOrphan `seq` (True) -> + (case (ppErrsSq _lErrSq) of + { _errTopPP | _errTopPP `seq` (True) -> + (case (empty) of + { _extraPP | _extraPP `seq` (True) -> + (case (_extraPP >-< _exprIpp + >-< _errTopPP) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (ppTy (tyQuantifyClosed _exprIty)) of + { _lhsOtopTyPP | _lhsOtopTyPP `seq` (True) -> + ( _lhsOallErrSq,_lhsOcmodule,_lhsOgUniq,_lhsOgathChrStore,_lhsOgathClDfGam,_lhsOgathClGam,_lhsOgathDataGam,_lhsOgathHiddenExports,_lhsOgathKiGam,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathPolGam,_lhsOgathTyGam,_lhsOgathTyKiGam,_lhsOgathValGam,_lhsOmbOrphan,_lhsOpp,_lhsOtopTyPP) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs b/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs @@ -0,0 +1,528 @@ + + + +module UHC.Light.Compiler.EH.MainAG_CaseAlt where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- CaseAlt ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyGam : TyGam + tyKiGam : TyKiGam + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + visit 4: + inherited attributes: + clGam : ClGam + dataGam : DataGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + synthesized attribute: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + visit 5: + inherited attributes: + knPatTy : Ty + valGam : ValGam + chained attribute: + patTyVarMp : VarMp + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + fiOpts : FIOpts + knTy : Ty + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + visit 7: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + patTy : Ty + pp : PP_Doc + ralt : RAlt + ralt' : RAlt + ty : Ty + alternatives: + alternative Pat: + child hsrange : {Range} + child patExpr : PatExpr + child expr : Expr + visit 0: + local range : {Range} + visit 2: + local lexLev : {Int} + visit 5: + local tySigGam : {ValGam} + visit 7: + local tySigVarMp : _ + local extraPP : _ + local pp : _ +-} +sem_CaseAlt_Pat :: Range -> + T_PatExpr -> + T_Expr -> + T_CaseAlt + +sem_CaseAlt_Pat hsrange_ patExpr_ expr_ | hsrange_ `seq` (patExpr_ `seq` (expr_ `seq` (True))) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_CaseAlt_Pat_1 :: T_CaseAlt_1 + sem_CaseAlt_Pat_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _patExprOgUniq | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _exprOgUniq | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_CaseAlt_Pat_2 :: T_CaseAlt_2 + sem_CaseAlt_Pat_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev + 1) of + { _lexLev | _lexLev `seq` (True) -> + (case (_lexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_CaseAlt_Pat_3 :: T_CaseAlt_3 + sem_CaseAlt_Pat_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (gamPushNew _lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_patExprItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_patExprIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_patExprIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (varFreeSet (_patExprIkiVarMp `varUpd` gamTop _patExprItyKiGam) `Set.union` _lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_CaseAlt_Pat_4 :: T_CaseAlt_4 + sem_CaseAlt_Pat_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (emptyGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq `Seq.union` _exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_CaseAlt_Pat_5 :: T_CaseAlt_5 + sem_CaseAlt_Pat_5 = + (\ _lhsIknPatTy + _lhsIpatTyVarMp + _lhsIvalGam -> + _lhsIknPatTy `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIvalGam `seq` + ((case (emptyGam) of + { _tySigGam | _tySigGam `seq` (True) -> + (case (_tySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (True) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case ([]) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (strongFIOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (gamPushNew _lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (_lhsIknPatTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case ((let sem_CaseAlt_Pat_6 :: T_CaseAlt_6 + sem_CaseAlt_Pat_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsIknTy + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_patExprIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _exprOknTy | _exprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (varFreeSet (gamTop _patExprItyGam) `Set.union` _lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (varFreeSet (gamTop _patExprIvalGam) `Set.union` _lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (_patExprIgathCnstrMp `cnstrMpUnion` _exprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp `Map.union` _exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_CaseAlt_Pat_7 :: T_CaseAlt_7 + sem_CaseAlt_Pat_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (emptyVarMp) of + { _tySigVarMp | _tySigVarMp `seq` (True) -> + (case (_tySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_patExprItopNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_patExprIallErrSq `Seq.union` _exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq `Seq.union` _exprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_patExprIgathMentrelFilterMp `mentrelFilterMpUnion` _exprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp `varmpUnion` _exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_patExprIty) of + { _lhsOpatTy | _lhsOpatTy `seq` (True) -> + (case (empty) of + { _extraPP | _extraPP `seq` (True) -> + (case (_patExprIpp >|< _extraPP >###< "->" >#< _exprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (RAlt_Alt [_patExprIrpat] _exprIcexpr _exprIcaseFailS) of + { _lhsOralt | _lhsOralt `seq` (True) -> + (case (RAlt_Alt (fsL2PatL $ reverse _patExprIfsRPatL) _exprIcexpr _exprIcaseFailS) of + { _lhsOralt' | _lhsOralt' `seq` (True) -> + (case (_exprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOralt,_lhsOralt',_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlt_Pat_7)) of + { ( sem_CaseAlt_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlt_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlt_Pat_6)) of + { ( sem_CaseAlt_6) | True -> + ( _lhsOpatTyVarMp,sem_CaseAlt_6) }) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_CaseAlt_Pat_5)) of + { ( sem_CaseAlt_5) | True -> + ( _lhsOchrInstDeclSq,sem_CaseAlt_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_CaseAlt_Pat_4)) of + { ( sem_CaseAlt_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_CaseAlt_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlt_Pat_3)) of + { ( sem_CaseAlt_3) | True -> + ( _lhsOpredSameScopeCounter,sem_CaseAlt_3) }) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_CaseAlt_Pat_2)) of + { ( sem_CaseAlt_2) | True -> + ( _lhsOgUniq,sem_CaseAlt_2) }) }) }) }) }) }))) + in sem_CaseAlt_Pat_1)) of + { ( sem_CaseAlt_1) | True -> + ( _lhsOrange,sem_CaseAlt_1) }) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs b/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs @@ -0,0 +1,655 @@ + + + +module UHC.Light.Compiler.EH.MainAG_CaseAlts where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- CaseAlts ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyGam : TyGam + tyKiGam : TyKiGam + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + visit 4: + inherited attributes: + clGam : ClGam + dataGam : DataGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + synthesized attribute: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + visit 5: + inherited attributes: + knPatTy : Ty + knTy : Ty + valGam : ValGam + chained attribute: + patTyVarMp : VarMp + synthesized attribute: + ty : Ty + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + fiOpts : FIOpts + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + visit 7: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + patTy : Ty + pp : PP_Doc + ppL : [PP_Doc] + raltL : [RAlt] + raltL' : [RAlt] + alternatives: + alternative Cons: + child hd : CaseAlt + child tl : CaseAlts + visit 7: + local extraPP : _ + alternative Nil: +-} +sem_CaseAlts_Cons :: T_CaseAlt -> + T_CaseAlts -> + T_CaseAlts + +sem_CaseAlts_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_CaseAlts_Cons_1 :: T_CaseAlts_1 + sem_CaseAlts_Cons_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_CaseAlts_Cons_2 :: T_CaseAlts_2 + sem_CaseAlts_Cons_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _hdOpredSameScopeCounter | _hdOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _hdOlexLev | _hdOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (hd_2 _hdOkiGam _hdOlexLev _hdOpredSameScopeCounter) of + { ( _hdIpredSameScopeCounter,hd_3) | True -> + (case (_hdIpredSameScopeCounter) of + { _tlOpredSameScopeCounter | _tlOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _tlOlexLev | _tlOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (tl_2 _tlOkiGam _tlOlexLev _tlOpredSameScopeCounter) of + { ( _tlIpredSameScopeCounter,tl_3) | True -> + (case (_tlIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_CaseAlts_Cons_3 :: T_CaseAlts_3 + sem_CaseAlts_Cons_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _tlOpredScope | _tlOpredScope `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _hdOpredScope | _hdOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (hd_3 _hdOkiVarMp _hdOopts _hdOpolGam _hdOpolVarMp _hdOpredScope _hdOtyGam _hdOtyKiGam _hdOtyKiGlobFreeTvarS) of + { ( _hdIkiVarMp,_hdIpolVarMp,hd_4) | True -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (tl_3 _tlOkiVarMp _tlOopts _tlOpolGam _tlOpolVarMp _tlOpredScope _tlOtyGam _tlOtyKiGam _tlOtyKiGlobFreeTvarS) of + { ( _tlIkiVarMp,_tlIpolVarMp,tl_4) | True -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_CaseAlts_Cons_4 :: T_CaseAlts_4 + sem_CaseAlts_Cons_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (tl_4 _tlOclGam _tlOdataGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOtyTyTySigFreeTvarS) of + { ( _tlIchrInstDeclSq,tl_5) | True -> + (case (hd_4 _hdOclGam _hdOdataGam _hdOfinKiVarMp _hdOfinTyKiGam _hdOtyTyTySigFreeTvarS) of + { ( _hdIchrInstDeclSq,hd_5) | True -> + (case (_hdIchrInstDeclSq `Seq.union` _tlIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_CaseAlts_Cons_5 :: T_CaseAlts_5 + sem_CaseAlts_Cons_5 = + (\ _lhsIknPatTy + _lhsIknTy + _lhsIpatTyVarMp + _lhsIvalGam -> + _lhsIknPatTy `seq` + (_lhsIknTy `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _tlOvalGam | _tlOvalGam `seq` (True) -> + (case (_lhsIvalGam) of + { _hdOvalGam | _hdOvalGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _hdOpatTyVarMp | _hdOpatTyVarMp `seq` (True) -> + (case (_lhsIknPatTy) of + { _hdOknPatTy | _hdOknPatTy `seq` (True) -> + (case (hd_5 _hdOknPatTy _hdOpatTyVarMp _hdOvalGam) of + { ( _hdIpatTyVarMp,hd_6) | True -> + (case (_hdIpatTyVarMp) of + { _tlOpatTyVarMp | _tlOpatTyVarMp `seq` (True) -> + (case (_lhsIknPatTy) of + { _tlOknPatTy | _tlOknPatTy `seq` (True) -> + (case (_lhsIknTy) of + { _tlOknTy | _tlOknTy `seq` (True) -> + (case (tl_5 _tlOknPatTy _tlOknTy _tlOpatTyVarMp _tlOvalGam) of + { ( _tlIpatTyVarMp,_tlIty,tl_6) | True -> + (case (_tlIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_tlIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case ((let sem_CaseAlts_Cons_6 :: T_CaseAlts_6 + sem_CaseAlts_Cons_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _hdOtyVarMp | _hdOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _hdOtvKiVarMp | _hdOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _hdOfiOpts | _hdOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _hdOclDfGam | _hdOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _hdOchrStore | _hdOchrStore `seq` (True) -> + (case (_lhsIknTy) of + { _hdOknTy | _hdOknTy `seq` (True) -> + (case (hd_6 _hdOchrStore _hdOclDfGam _hdOfiOpts _hdOknTy _hdOtvKiVarMp _hdOtyTyGlobFreeTvarS _hdOtyVarMp _hdOvalTyGlobFreeTvarS) of + { ( _hdIgathCnstrMp,_hdIgathRangeMp,_hdItyVarMp,hd_7) | True -> + (case (_hdItyVarMp) of + { _tlOtyVarMp | _tlOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _tlOtvKiVarMp | _tlOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _tlOfiOpts | _tlOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _tlOclDfGam | _tlOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _tlOchrStore | _tlOchrStore `seq` (True) -> + (case (tl_6 _tlOchrStore _tlOclDfGam _tlOfiOpts _tlOtvKiVarMp _tlOtyTyGlobFreeTvarS _tlOtyVarMp _tlOvalTyGlobFreeTvarS) of + { ( _tlIgathCnstrMp,_tlIgathRangeMp,_tlItyVarMp,tl_7) | True -> + (case (_hdIgathCnstrMp `cnstrMpUnion` _tlIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_hdIgathRangeMp `Map.union` _tlIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_tlItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_CaseAlts_Cons_7 :: T_CaseAlts_7 + sem_CaseAlts_Cons_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _tlOrangeMp | _tlOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _tlOfinValGam | _tlOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _hdOrangeMp | _hdOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _hdOfinValGam | _hdOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _tlOchrScopeBindMp | _tlOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _tlOchrEvidBindMp | _tlOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _hdOchrScopeBindMp | _hdOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _hdOchrEvidBindMp | _hdOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _hdOcSubst | _hdOcSubst `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (hd_7 _hdOcSubst _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOfinTyVarMp _hdOfinValGam _hdOmoduleNm _hdOrangeMp _hdOsysfEnv) of + { ( _hdIallErrSq,_hdIcSubst,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTy,_hdIpp,_hdIralt,_hdIralt',_hdIty) | True -> + (case (_hdIcSubst) of + { _tlOcSubst | _tlOcSubst `seq` (True) -> + (case (tl_7 _tlOcSubst _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOfinTyVarMp _tlOfinValGam _tlOmoduleNm _tlOrangeMp _tlOsysfEnv) of + { ( _tlIallErrSq,_tlIcSubst,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTy,_tlIpp,_tlIppL,_tlIraltL,_tlIraltL') | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_tlIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIgathTvKiVarMp `varmpUnion` _tlIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_tlIpatTy) of + { _lhsOpatTy | _lhsOpatTy `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (empty) of + { _extraPP | _extraPP `seq` (True) -> + (case ((_hdIpp >|< _extraPP) : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdIralt : _tlIraltL) of + { _lhsOraltL | _lhsOraltL `seq` (True) -> + (case (_hdIralt' : _tlIraltL') of + { _lhsOraltL' | _lhsOraltL' `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppL,_lhsOraltL,_lhsOraltL') }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlts_Cons_7)) of + { ( sem_CaseAlts_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlts_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))) + in sem_CaseAlts_Cons_6)) of + { ( sem_CaseAlts_6) | True -> + ( _lhsOpatTyVarMp,_lhsOty,sem_CaseAlts_6) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_CaseAlts_Cons_5)) of + { ( sem_CaseAlts_5) | True -> + ( _lhsOchrInstDeclSq,sem_CaseAlts_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_CaseAlts_Cons_4)) of + { ( sem_CaseAlts_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_CaseAlts_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlts_Cons_3)) of + { ( sem_CaseAlts_3) | True -> + ( _lhsOpredSameScopeCounter,sem_CaseAlts_3) }) }) }) }) }) }) }) }) }) }))))) + in sem_CaseAlts_Cons_2)) of + { ( sem_CaseAlts_2) | True -> + ( _lhsOgUniq,sem_CaseAlts_2) }) }) }) }) }) }))) + in sem_CaseAlts_Cons_1)) of + { ( sem_CaseAlts_1) | True -> + ( _lhsOrange,sem_CaseAlts_1) }) }) }) }) + +sem_CaseAlts_Nil :: T_CaseAlts + +sem_CaseAlts_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_CaseAlts_Nil_1 :: T_CaseAlts_1 + sem_CaseAlts_Nil_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_CaseAlts_Nil_2 :: T_CaseAlts_2 + sem_CaseAlts_Nil_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_CaseAlts_Nil_3 :: T_CaseAlts_3 + sem_CaseAlts_Nil_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_CaseAlts_Nil_4 :: T_CaseAlts_4 + sem_CaseAlts_Nil_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_CaseAlts_Nil_5 :: T_CaseAlts_5 + sem_CaseAlts_Nil_5 = + (\ _lhsIknPatTy + _lhsIknTy + _lhsIpatTyVarMp + _lhsIvalGam -> + _lhsIknPatTy `seq` + (_lhsIknTy `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIvalGam `seq` + ((case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _lhsOty | _lhsOty `seq` (True) -> + (case ((let sem_CaseAlts_Nil_6 :: T_CaseAlts_6 + sem_CaseAlts_Nil_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_CaseAlts_Nil_7 :: T_CaseAlts_7 + sem_CaseAlts_Nil_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_lhsIknPatTy) of + { _lhsOpatTy | _lhsOpatTy `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOraltL | _lhsOraltL `seq` (True) -> + (case ([]) of + { _lhsOraltL' | _lhsOraltL' `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppL,_lhsOraltL,_lhsOraltL') }) }) }) }) }) }) }) }) }) })))))))))) + in sem_CaseAlts_Nil_7)) of + { ( sem_CaseAlts_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlts_7) }) }) }) }))))))))) + in sem_CaseAlts_Nil_6)) of + { ( sem_CaseAlts_6) | True -> + ( _lhsOpatTyVarMp,_lhsOty,sem_CaseAlts_6) }) }) })))))) + in sem_CaseAlts_Nil_5)) of + { ( sem_CaseAlts_5) | True -> + ( _lhsOchrInstDeclSq,sem_CaseAlts_5) }) }))))))) + in sem_CaseAlts_Nil_4)) of + { ( sem_CaseAlts_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_CaseAlts_4) }) }) })))))))))) + in sem_CaseAlts_Nil_3)) of + { ( sem_CaseAlts_3) | True -> + ( _lhsOpredSameScopeCounter,sem_CaseAlts_3) }) }))))) + in sem_CaseAlts_Nil_2)) of + { ( sem_CaseAlts_2) | True -> + ( _lhsOgUniq,sem_CaseAlts_2) }) }))) + in sem_CaseAlts_Nil_1)) of + { ( sem_CaseAlts_1) | True -> + ( _lhsOrange,sem_CaseAlts_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs @@ -0,0 +1,625 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataConstr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataConstr -------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataTy : Ty + knPolCtx : Polarity + polGam : PolGam + tyGam : TyGam + chained attribute: + polVarMp : VarMp + synthesized attributes: + dataAltTyL : AssocL HsName Ty + gathMaxArity : Int + visit 3: + inherited attributes: + dataAltTy : Ty + maxArity : Int + tyKiGam : TyKiGam + tyNm : HsName + chained attribute: + kiVarMp : VarMp + synthesized attributes: + dataAltForNewType : Ty + dataConstrNmL : [HsName] + dataConstrTagMp : DataConstrTagMp + intlTyKiGam : TyKiGam + visit 4: + inherited attributes: + finTyKiGam : TyKiGam + tvKiVarMp : VarMp + chained attributes: + patTyVarMp : VarMp + patValGam : ValGam + synthesized attributes: + fldSelGam : ValGam + fldUpdGam : ValGam + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + visit 5: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + clGam : ClGam + finKiVarMp : VarMp + finTyVarMp : VarMp + isNewtype : Bool + kiGam : KiGam + lexLev : Int + moduleNm : HsName + opts : EHCOpts + predScope : PredScope + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valGam : ValGam + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + ffeCBindL : CBindL + ffiCBindL : CBindL + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + pp : PP_Doc + tyCBindL : CBindL + valCBindL : CBindL + alternatives: + alternative Constr: + child hsrange : {Range} + child conNm : {HsName} + child mbFixityPrio : {Maybe (Int,Fixity)} + child fields : DataFields + child mbGadtTyExpr : MbTyExpr + visit 0: + local range : {Range} + visit 1: + local _tup10 : _ + intra range : {Range} + visit 2: + local dataConFldTyL : _ + local mbGadtFO : _ + local gadtTyVarMp : _ + local dataConGadtTyL : _ + local dataConGadtFldTyL : _ + local dataConProdTy2 : _ + local dataConProdTy1 : _ + local dataConProdTy : {Ty} + local dataAltTyL : _ + local arity : {Int} + intra _tup10 : _ + intra range : {Range} + visit 3: + local dataAltForNewType : _ + local lUniq_con : {UID} + local tag : _ + local ctag : _ + local fldRefL : _ + local fldMp : _ + local dataConTyAsVar : {Ty} + local dataConGadtFldAnnL : _ + local dti : _ + local lUniq : {UID} + local fldsKiVarMp : _ + local _tup9 : _ + local fo_ : {FIOut} + intra dataConGadtFldTyL : _ + intra _tup10 : _ + intra arity : {Int} + intra dataConGadtTyL : _ + intra dataConFldTyL : _ + intra dataConProdTy : {Ty} + intra gadtTyVarMp : _ + intra range : {Range} + intra mbGadtFO : _ + visit 4: + local lUniq_uncon : {UID} + local dataConTyL : _ + local dataConTy2 : _ + local dataConTy1 : {Ty} + local dataConTy : {Ty} + local dataUnConTyVar : _ + local dataConTyVar : _ + local dataConProdTyFv : _ + local dataConTyFv : {[TyVarId]} + local dataQuUnConTy : _ + local dataConGadtTy : _ + local dataUnConTyAsVar : _ + intra _tup10 : _ + intra dataConFldTyL : _ + intra lUniq_con : {UID} + intra dataConProdTy : {Ty} + intra gadtTyVarMp : _ + intra dataConTyAsVar : {Ty} + intra range : {Range} + intra dataConGadtFldTyL : _ + intra mbGadtFO : _ + intra fo_ : {FIOut} + visit 5: + local dupErrs : _ + local pp : _ + intra range : {Range} + intra dataConGadtFldTyL : _ + intra mbGadtFO : _ + intra fo_ : {FIOut} +-} +sem_DataConstr_Constr :: Range -> + HsName -> + (Maybe (Int,Fixity)) -> + T_DataFields -> + T_MbTyExpr -> + T_DataConstr + +sem_DataConstr_Constr hsrange_ conNm_ mbFixityPrio_ fields_ mbGadtTyExpr_ | hsrange_ `seq` (conNm_ `seq` (mbFixityPrio_ `seq` (fields_ `seq` (mbGadtTyExpr_ `seq` (True))))) = + (case (mbGadtTyExpr_) of + { ( _mbGadtTyExprIrange,mbGadtTyExpr_1) | True -> + (case (fields_) of + { ( _fieldsIrange,fields_1) | True -> + (case (rangeUnions [hsrange_, _fieldsIrange , _mbGadtTyExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataConstr_Constr_1 :: T_DataConstr_1 + sem_DataConstr_Constr_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_con) -> case nextUnique __cont of { (__cont, lUniq_uncon) -> (__cont,lUniq,lUniq_con,lUniq_uncon)}}} )) of + { __tup10 | __tup10 `seq` (True) -> + (case (__tup10) of + { (_fieldsOgUniq,_,_,_) | _fieldsOgUniq `seq` (True) -> + (case (fields_1 _fieldsOgUniq) of + { ( _fieldsIgUniq,fields_2) | True -> + (case (_fieldsIgUniq) of + { _mbGadtTyExprOgUniq | _mbGadtTyExprOgUniq `seq` (True) -> + (case (mbGadtTyExpr_1 _mbGadtTyExprOgUniq) of + { ( _mbGadtTyExprIgUniq,mbGadtTyExpr_2) | True -> + (case (_mbGadtTyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataConstr_Constr_2 :: T_DataConstr_2 + sem_DataConstr_Constr_2 = + (\ _lhsIdataTy + _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIdataTy `seq` + (_lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (_lhsItyGam) of + { _fieldsOtyGam | _fieldsOtyGam `seq` (True) -> + (case (_lhsIpolVarMp) of + { _fieldsOpolVarMp | _fieldsOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _fieldsOpolGam | _fieldsOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _fieldsOknPolCtx | _fieldsOknPolCtx `seq` (True) -> + (case (fields_2 _fieldsOknPolCtx _fieldsOpolGam _fieldsOpolVarMp _fieldsOtyGam) of + { ( _fieldsIfldAnnL,_fieldsIfldTyL,_fieldsIpolVarMp,_fieldsItyGam,fields_3) | True -> + (case (_fieldsItyGam) of + { _mbGadtTyExprOtyGam | _mbGadtTyExprOtyGam `seq` (True) -> + (case (_fieldsIfldTyL) of + { _dataConFldTyL | _dataConFldTyL `seq` (True) -> + (case (_fieldsIpolVarMp) of + { _mbGadtTyExprOpolVarMp | _mbGadtTyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _mbGadtTyExprOpolGam | _mbGadtTyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _mbGadtTyExprOknPolCtx | _mbGadtTyExprOknPolCtx `seq` (True) -> + (case (mbGadtTyExpr_2 _mbGadtTyExprOknPolCtx _mbGadtTyExprOpolGam _mbGadtTyExprOpolVarMp _mbGadtTyExprOtyGam) of + { ( _mbGadtTyExprIpolVarMp,_mbGadtTyExprItyMb,mbGadtTyExpr_3) | True -> + (case (fmap (\ty -> fitsIn (unifyFIOpts {fioDontBind = varFreeSet ty}) defaultFIEnv uidStart (emptyVarMp::VarMp) _lhsIdataTy ty) _mbGadtTyExprItyMb) of + { _mbGadtFO | _mbGadtFO `seq` (True) -> + (case (maybe emptyVarMp foVarMp _mbGadtFO) of + { _gadtTyVarMp | _gadtTyVarMp `seq` (True) -> + (case ([ mkTyPr $ Pred_Eq (mkTyVar v) t | (v,t) <- varmpToAssocTyL _gadtTyVarMp ]) of + { _dataConGadtTyL | _dataConGadtTyL `seq` (True) -> + (case (zip (repeat Nothing) _dataConGadtTyL ++ _dataConFldTyL) of + { _dataConGadtFldTyL | _dataConGadtFldTyL `seq` (True) -> + (case (let lbls = zipWith (\p (ml,_) -> maybe p id ml) positionalFldNames _dataConGadtFldTyL + in recRec (zipWith (\l (_,t) -> (l,t)) lbls _dataConGadtFldTyL)) of + { _dataConProdTy2 | _dataConProdTy2 `seq` (True) -> + (case (_dataConProdTy2) of + { _dataConProdTy1 | _dataConProdTy1 `seq` (True) -> + (case (_dataConProdTy1) of + { _dataConProdTy | _dataConProdTy `seq` (True) -> + (case ([(conNm_,_dataConProdTy)]) of + { _dataAltTyL | _dataAltTyL `seq` (True) -> + (case (_dataAltTyL) of + { _lhsOdataAltTyL | _lhsOdataAltTyL `seq` (True) -> + (case (length _dataConGadtFldTyL) of + { _arity | _arity `seq` (True) -> + (case (_arity) of + { _lhsOgathMaxArity | _lhsOgathMaxArity `seq` (True) -> + (case (_mbGadtTyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataConstr_Constr_3 :: T_DataConstr_3 + sem_DataConstr_Constr_3 = + (\ _lhsIdataAltTy + _lhsIkiVarMp + _lhsImaxArity + _lhsItyKiGam + _lhsItyNm -> + _lhsIdataAltTy `seq` + (_lhsIkiVarMp `seq` + (_lhsImaxArity `seq` + (_lhsItyKiGam `seq` + (_lhsItyNm `seq` + ((case (maybeHd Ty_Any snd _dataConGadtFldTyL) of + { _dataAltForNewType | _dataAltForNewType `seq` (True) -> + (case (_dataAltForNewType) of + { _lhsOdataAltForNewType | _lhsOdataAltForNewType `seq` (True) -> + (case ([conNm_]) of + { _lhsOdataConstrNmL | _lhsOdataConstrNmL `seq` (True) -> + (case (__tup10) of + { (_,_,_lUniq_con,_) | _lUniq_con `seq` (True) -> + (case (tyRecOffset conNm_ _lhsIdataAltTy) of + { _tag | _tag `seq` (True) -> + (case (patchTyInfoCTag _lhsItyNm _lhsImaxArity $ mkOnlyConInfoCTag conNm_ _tag _arity) of + { _ctag | _ctag `seq` (True) -> + (case (refGen 0 1 $ zipWith (\pn (ml,_) -> maybe pn id ml) positionalFldNames _dataConGadtFldTyL) of + { _fldRefL | _fldRefL `seq` (True) -> + (case (Map.fromList $ catMaybes $ zipWith (\(_,r) (ml,_) -> fmap (\l -> (l,emptyDataFldInfo {dfiOffset = r})) ml) _fldRefL _dataConGadtFldTyL) of + { _fldMp | _fldMp `seq` (True) -> + (case (mkNewTyVar _lUniq_con) of + { _dataConTyAsVar | _dataConTyAsVar `seq` (True) -> + (case (replicate (length _dataConGadtTyL) + (DataConFldAnnInfo + Strictness_NonStrict + ) + ++ _fieldsIfldAnnL) of + { _dataConGadtFldAnnL | _dataConGadtFldAnnL `seq` (True) -> + (case (emptyDataTagInfo + { dtiFldMp = _fldMp + , dtiFldTyL = _dataConGadtFldTyL + , dtiConFldAnnL = _dataConGadtFldAnnL + , dtiConNm = conNm_ + , dtiConTy = _dataConTyAsVar + , dtiCTag = _ctag + , dtiFldRefL = assocLElts _fldRefL + , dtiMbFixityPrio = mbFixityPrio_ + }) of + { _dti | _dti `seq` (True) -> + (case (conNm_ `Map.singleton` _dti) of + { _lhsOdataConstrTagMp | _lhsOdataConstrTagMp `seq` (True) -> + (case (_lhsItyKiGam) of + { _fieldsOtyKiGam | _fieldsOtyKiGam `seq` (True) -> + (case (fields_3 _fieldsOtyKiGam) of + { ( _fieldsIintlTyKiGam,_fieldsItyKiGam,fields_4) | True -> + (case (_fieldsItyKiGam) of + { _mbGadtTyExprOtyKiGam | _mbGadtTyExprOtyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _fieldsOkiVarMp | _fieldsOkiVarMp `seq` (True) -> + (case (__tup10) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (_lhsIdataTy) of + { _fieldsOdataTy | _fieldsOdataTy `seq` (True) -> + (case (fields_4 _fieldsOdataTy _fieldsOkiVarMp) of + { ( _fieldsIfldSelGam,_fieldsIfldUpdGam,_fieldsIgathCnstrMp,_fieldsIgathRangeMp,_fieldsIkiL,_fieldsIkiVarMp,fields_5) | True -> + (case (_fieldsIkiVarMp) of + { _fldsKiVarMp | _fldsKiVarMp `seq` (True) -> + (case (fitsInL weakFIOpts defaultFIEnv _lUniq _fldsKiVarMp + _fieldsIkiL (repeat kiStar)) of + { __tup9 | __tup9 `seq` (True) -> + (case (__tup9) of + { (_,_fo_) | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _fldsKiVarMp) of + { _mbGadtTyExprOkiVarMp | _mbGadtTyExprOkiVarMp `seq` (True) -> + (case (mbGadtTyExpr_3 _mbGadtTyExprOkiVarMp _mbGadtTyExprOtyKiGam) of + { ( _mbGadtTyExprIintlTyKiGam,_mbGadtTyExprIkiVarMp,mbGadtTyExpr_4) | True -> + (case (_fieldsIintlTyKiGam `gamUnion` _mbGadtTyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_mbGadtTyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataConstr_Constr_4 :: T_DataConstr_4 + sem_DataConstr_Constr_4 = + (\ _lhsIfinTyKiGam + _lhsIpatTyVarMp + _lhsIpatValGam + _lhsItvKiVarMp -> + _lhsIfinTyKiGam `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpatValGam `seq` + (_lhsItvKiVarMp `seq` + ((case (_fieldsIfldSelGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (_fieldsIfldUpdGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (_fieldsIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_fieldsIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (__tup10) of + { (_,_,_,_lUniq_uncon) | _lUniq_uncon `seq` (True) -> + (case (assocLElts _dataConFldTyL) of + { _dataConTyL | _dataConTyL `seq` (True) -> + (case (_dataConTyL `appArr` _lhsIdataTy) of + { _dataConTy2 | _dataConTy2 `seq` (True) -> + (case (_dataConTy2) of + { _dataConTy1 | _dataConTy1 `seq` (True) -> + (case (_dataConTy1) of + { _dataConTy | _dataConTy `seq` (True) -> + (case (_lUniq_uncon) of + { _dataUnConTyVar | _dataUnConTyVar `seq` (True) -> + (case (_lUniq_con) of + { _dataConTyVar | _dataConTyVar `seq` (True) -> + (case (varFree _dataConProdTy) of + { _dataConProdTyFv | _dataConProdTyFv `seq` (True) -> + (case (varFree _lhsIdataTy) of + { _dataConTyFv | _dataConTyFv `seq` (True) -> + (case (let fvD = _dataConTyFv + fvU = _dataConProdTyFv + tkg = gamUnion _lhsIfinTyKiGam _fieldsIintlTyKiGam + mkk tvs = [ (v,tvarKi tkg _lhsItvKiVarMp emptyVarMp v) | v <- tvs ] + in ( ([_lhsIdataTy] `appArr` mkTyQu tyQu_Exists (mkk (fvU \\ fvD)) _dataConProdTy))) of + { _dataQuUnConTy | _dataQuUnConTy `seq` (True) -> + (case (_gadtTyVarMp `varUpd` _dataConTy) of + { _dataConGadtTy | _dataConGadtTy `seq` (True) -> + (case (assocTyLToVarMp [(_dataConTyVar,_dataConGadtTy),(_dataUnConTyVar,_dataQuUnConTy)] `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (mkNewTyVar _lUniq_uncon) of + { _dataUnConTyAsVar | _dataUnConTyAsVar `seq` (True) -> + (case (gamUnions + [ assocLToGam + [ (conNm_, ValGamInfo _dataConTyAsVar) + , (hsnUn conNm_, ValGamInfo _dataUnConTyAsVar) + ] + , _lhsIpatValGam + ]) of + { _lhsOpatValGam | _lhsOpatValGam `seq` (True) -> + (case ((let sem_DataConstr_Constr_5 :: T_DataConstr_5 + sem_DataConstr_Constr_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyVarMp + _lhsIisNewtype + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIisNewtype `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _mbGadtTyExprOvalTyGlobFreeTvarS | _mbGadtTyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _mbGadtTyExprOtyTyTySigFreeTvarS | _mbGadtTyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _mbGadtTyExprOtyTyGlobFreeTvarS | _mbGadtTyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _mbGadtTyExprOtyKiGlobFreeTvarS | _mbGadtTyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _mbGadtTyExprOsysfEnv | _mbGadtTyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _mbGadtTyExprOopts | _mbGadtTyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _mbGadtTyExprOmoduleNm | _mbGadtTyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _mbGadtTyExprOkiGam | _mbGadtTyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _mbGadtTyExprOfinTyVarMp | _mbGadtTyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _mbGadtTyExprOfinTyKiGam | _mbGadtTyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _mbGadtTyExprOfinKiVarMp | _mbGadtTyExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _mbGadtTyExprOclGam | _mbGadtTyExprOclGam `seq` (True) -> + (case (mbGadtTyExpr_4 _mbGadtTyExprOclGam _mbGadtTyExprOfinKiVarMp _mbGadtTyExprOfinTyKiGam _mbGadtTyExprOfinTyVarMp _mbGadtTyExprOkiGam _mbGadtTyExprOmoduleNm _mbGadtTyExprOopts _mbGadtTyExprOsysfEnv _mbGadtTyExprOtyKiGlobFreeTvarS _mbGadtTyExprOtyTyGlobFreeTvarS _mbGadtTyExprOtyTyTySigFreeTvarS _mbGadtTyExprOvalTyGlobFreeTvarS) of + { ( _mbGadtTyExprIallErrSq,_mbGadtTyExprIclMissNmS,_mbGadtTyExprIclNmS,_mbGadtTyExprIerrSq,_mbGadtTyExprIgathMentrelFilterMp,_mbGadtTyExprIpp,_mbGadtTyExprIppMb,_mbGadtTyExprItyGam,_mbGadtTyExprItyKiGam,_mbGadtTyExprItyVarWildMp) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _fieldsOvalTyGlobFreeTvarS | _fieldsOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _fieldsOtyTyTySigFreeTvarS | _fieldsOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _fieldsOtyTyGlobFreeTvarS | _fieldsOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _fieldsOtyKiGlobFreeTvarS | _fieldsOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _fieldsOtvKiVarMp | _fieldsOtvKiVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _fieldsOsysfEnv | _fieldsOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _fieldsOrangeMp | _fieldsOrangeMp `seq` (True) -> + (case (_lhsIpredScope) of + { _fieldsOpredScope | _fieldsOpredScope `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _fieldsOpatTyVarMp | _fieldsOpatTyVarMp `seq` (True) -> + (case (_lhsIopts) of + { _fieldsOopts | _fieldsOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _fieldsOmoduleNm | _fieldsOmoduleNm `seq` (True) -> + (case (_lhsIlexLev) of + { _fieldsOlexLev | _fieldsOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _fieldsOkiGam | _fieldsOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _fieldsOfinTyVarMp | _fieldsOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _fieldsOfinTyKiGam | _fieldsOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _fieldsOfinKiVarMp | _fieldsOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _fieldsOclGam | _fieldsOclGam `seq` (True) -> + (case (_lhsIclDfGam) of + { _fieldsOclDfGam | _fieldsOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _fieldsOchrStore | _fieldsOchrStore `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _fieldsOchrScopeBindMp | _fieldsOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _fieldsOchrEvidBindMp | _fieldsOchrEvidBindMp `seq` (True) -> + (case (fields_5 _fieldsOchrEvidBindMp _fieldsOchrScopeBindMp _fieldsOchrStore _fieldsOclDfGam _fieldsOclGam _fieldsOfinKiVarMp _fieldsOfinTyKiGam _fieldsOfinTyVarMp _fieldsOkiGam _fieldsOlexLev _fieldsOmoduleNm _fieldsOopts _fieldsOpatTyVarMp _fieldsOpredScope _fieldsOrangeMp _fieldsOsysfEnv _fieldsOtvKiVarMp _fieldsOtyKiGlobFreeTvarS _fieldsOtyTyGlobFreeTvarS _fieldsOtyTyTySigFreeTvarS _fieldsOvalTyGlobFreeTvarS) of + { ( _fieldsIallErrSq,_fieldsIerrSq,_fieldsIgathMentrelFilterMp,_fieldsIgathTvKiVarMp,_fieldsIpatTyVarMp,_fieldsIpp,_fieldsIppL) | True -> + (case (_fieldsIallErrSq `Seq.union` _mbGadtTyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (let nms = assocLKeys $ gamToOnlyDups _fieldsIfldSelGam + in if null nms then [] else [rngLift _range Err_NamesDupIntrod "data field" (zip nms (repeat Nothing))]) of + { _dupErrs | _dupErrs `seq` (True) -> + (case (pp conNm_ + >#< (if null $ catMaybes $ assocLKeys $ _dataConGadtFldTyL + then ppSpaced _fieldsIppL + else ppCurlysCommas' _fieldsIppL + ) + >|< maybe empty (\t -> " ->" >#< t) _mbGadtTyExprIppMb) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [ _fieldsIerrSq + , _mbGadtTyExprIerrSq + , Seq.fromList _dupErrs + , foErrSq _fo_ + , maybe Seq.empty foErrSq _mbGadtFO + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOffeCBindL | _lhsOffeCBindL `seq` (True) -> + (case ([]) of + { _lhsOffiCBindL | _lhsOffiCBindL `seq` (True) -> + (case (_fieldsIgathMentrelFilterMp `mentrelFilterMpUnion` _mbGadtTyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_fieldsIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) + in sem_DataConstr_Constr_5)) of + { ( sem_DataConstr_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_DataConstr_Constr_4)) of + { ( sem_DataConstr_4) | True -> + ( _lhsOdataAltForNewType,_lhsOdataConstrNmL,_lhsOdataConstrTagMp,_lhsOintlTyKiGam,_lhsOkiVarMp,sem_DataConstr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataConstr_Constr_3)) of + { ( sem_DataConstr_3) | True -> + ( _lhsOdataAltTyL,_lhsOgathMaxArity,_lhsOpolVarMp,sem_DataConstr_3) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataConstr_Constr_2)) of + { ( sem_DataConstr_2) | True -> + ( _lhsOgUniq,sem_DataConstr_2) }) }) }) }) }) }) }))) + in sem_DataConstr_Constr_1)) of + { ( sem_DataConstr_1) | True -> + ( _lhsOrange,sem_DataConstr_1) }) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs b/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs @@ -0,0 +1,635 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataConstrs where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataConstrs ------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + dataTy : Ty + knPolCtx : Polarity + polGam : PolGam + tyGam : TyGam + chained attribute: + polVarMp : VarMp + synthesized attributes: + dataAltTyL : AssocL HsName Ty + gathMaxArity : Int + visit 3: + inherited attributes: + dataAltTy : Ty + maxArity : Int + tyKiGam : TyKiGam + tyNm : HsName + chained attribute: + kiVarMp : VarMp + synthesized attributes: + dataAltForNewType : Ty + dataConstrNmL : [HsName] + dataConstrTagMp : DataConstrTagMp + intlTyKiGam : TyKiGam + visit 4: + inherited attributes: + finTyKiGam : TyKiGam + tvKiVarMp : VarMp + chained attributes: + patTyVarMp : VarMp + patValGam : ValGam + synthesized attributes: + fldSelGam : ValGam + fldUpdGam : ValGam + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + visit 5: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + clGam : ClGam + finKiVarMp : VarMp + finTyVarMp : VarMp + isNewtype : Bool + kiGam : KiGam + lexLev : Int + moduleNm : HsName + opts : EHCOpts + predScope : PredScope + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valGam : ValGam + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + ffeCBindL : CBindL + ffiCBindL : CBindL + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + pp : PP_Doc + ppL : [PP_Doc] + tyCBindL : CBindL + valCBindL : CBindL + alternatives: + alternative Cons: + child hd : DataConstr + child tl : DataConstrs + alternative Nil: +-} +sem_DataConstrs_Cons :: T_DataConstr -> + T_DataConstrs -> + T_DataConstrs + +sem_DataConstrs_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataConstrs_Cons_1 :: T_DataConstrs_1 + sem_DataConstrs_Cons_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataConstrs_Cons_2 :: T_DataConstrs_2 + sem_DataConstrs_Cons_2 = + (\ _lhsIdataTy + _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIdataTy `seq` + (_lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (_lhsIdataTy) of + { _tlOdataTy | _tlOdataTy `seq` (True) -> + (case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (_lhsIdataTy) of + { _hdOdataTy | _hdOdataTy `seq` (True) -> + (case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _hdOknPolCtx | _hdOknPolCtx `seq` (True) -> + (case (hd_2 _hdOdataTy _hdOknPolCtx _hdOpolGam _hdOpolVarMp _hdOtyGam) of + { ( _hdIdataAltTyL,_hdIgathMaxArity,_hdIpolVarMp,hd_3) | True -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tlOknPolCtx | _tlOknPolCtx `seq` (True) -> + (case (tl_2 _tlOdataTy _tlOknPolCtx _tlOpolGam _tlOpolVarMp _tlOtyGam) of + { ( _tlIdataAltTyL,_tlIgathMaxArity,_tlIpolVarMp,tl_3) | True -> + (case (_hdIdataAltTyL ++ _tlIdataAltTyL) of + { _lhsOdataAltTyL | _lhsOdataAltTyL `seq` (True) -> + (case (_hdIgathMaxArity `max` _tlIgathMaxArity) of + { _lhsOgathMaxArity | _lhsOgathMaxArity `seq` (True) -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataConstrs_Cons_3 :: T_DataConstrs_3 + sem_DataConstrs_Cons_3 = + (\ _lhsIdataAltTy + _lhsIkiVarMp + _lhsImaxArity + _lhsItyKiGam + _lhsItyNm -> + _lhsIdataAltTy `seq` + (_lhsIkiVarMp `seq` + (_lhsImaxArity `seq` + (_lhsItyKiGam `seq` + (_lhsItyNm `seq` + ((case (_lhsItyNm) of + { _tlOtyNm | _tlOtyNm `seq` (True) -> + (case (_lhsItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (_lhsImaxArity) of + { _tlOmaxArity | _tlOmaxArity `seq` (True) -> + (case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (_lhsItyNm) of + { _hdOtyNm | _hdOtyNm `seq` (True) -> + (case (_lhsImaxArity) of + { _hdOmaxArity | _hdOmaxArity `seq` (True) -> + (case (_lhsIdataAltTy) of + { _hdOdataAltTy | _hdOdataAltTy `seq` (True) -> + (case (hd_3 _hdOdataAltTy _hdOkiVarMp _hdOmaxArity _hdOtyKiGam _hdOtyNm) of + { ( _hdIdataAltForNewType,_hdIdataConstrNmL,_hdIdataConstrTagMp,_hdIintlTyKiGam,_hdIkiVarMp,hd_4) | True -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (_lhsIdataAltTy) of + { _tlOdataAltTy | _tlOdataAltTy `seq` (True) -> + (case (tl_3 _tlOdataAltTy _tlOkiVarMp _tlOmaxArity _tlOtyKiGam _tlOtyNm) of + { ( _tlIdataAltForNewType,_tlIdataConstrNmL,_tlIdataConstrTagMp,_tlIintlTyKiGam,_tlIkiVarMp,tl_4) | True -> + (case (_hdIdataAltForNewType `const` _tlIdataAltForNewType) of + { _lhsOdataAltForNewType | _lhsOdataAltForNewType `seq` (True) -> + (case (_hdIdataConstrNmL ++ _tlIdataConstrNmL) of + { _lhsOdataConstrNmL | _lhsOdataConstrNmL `seq` (True) -> + (case (_hdIdataConstrTagMp `Map.union` _tlIdataConstrTagMp) of + { _lhsOdataConstrTagMp | _lhsOdataConstrTagMp `seq` (True) -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataConstrs_Cons_4 :: T_DataConstrs_4 + sem_DataConstrs_Cons_4 = + (\ _lhsIfinTyKiGam + _lhsIpatTyVarMp + _lhsIpatValGam + _lhsItvKiVarMp -> + _lhsIfinTyKiGam `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpatValGam `seq` + (_lhsItvKiVarMp `seq` + ((case (_lhsItvKiVarMp) of + { _tlOtvKiVarMp | _tlOtvKiVarMp `seq` (True) -> + (case (_lhsIpatValGam) of + { _hdOpatValGam | _hdOpatValGam `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _hdOtvKiVarMp | _hdOtvKiVarMp `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _hdOpatTyVarMp | _hdOpatTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (hd_4 _hdOfinTyKiGam _hdOpatTyVarMp _hdOpatValGam _hdOtvKiVarMp) of + { ( _hdIfldSelGam,_hdIfldUpdGam,_hdIgathCnstrMp,_hdIgathRangeMp,_hdIpatTyVarMp,_hdIpatValGam,hd_5) | True -> + (case (_hdIpatValGam) of + { _tlOpatValGam | _tlOpatValGam `seq` (True) -> + (case (_hdIpatTyVarMp) of + { _tlOpatTyVarMp | _tlOpatTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (tl_4 _tlOfinTyKiGam _tlOpatTyVarMp _tlOpatValGam _tlOtvKiVarMp) of + { ( _tlIfldSelGam,_tlIfldUpdGam,_tlIgathCnstrMp,_tlIgathRangeMp,_tlIpatTyVarMp,_tlIpatValGam,tl_5) | True -> + (case (_hdIfldSelGam `gamUnion` _tlIfldSelGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (_hdIfldUpdGam `gamUnion` _tlIfldUpdGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (_hdIgathCnstrMp `cnstrMpUnion` _tlIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_hdIgathRangeMp `Map.union` _tlIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_tlIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_tlIpatValGam) of + { _lhsOpatValGam | _lhsOpatValGam `seq` (True) -> + (case ((let sem_DataConstrs_Cons_5 :: T_DataConstrs_5 + sem_DataConstrs_Cons_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyVarMp + _lhsIisNewtype + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIisNewtype `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _tlOvalGam | _tlOvalGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _tlOrangeMp | _tlOrangeMp `seq` (True) -> + (case (_lhsIpredScope) of + { _tlOpredScope | _tlOpredScope `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlexLev) of + { _tlOlexLev | _tlOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (_lhsIisNewtype) of + { _tlOisNewtype | _tlOisNewtype `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (_lhsIclDfGam) of + { _tlOclDfGam | _tlOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _tlOchrStore | _tlOchrStore `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _tlOchrScopeBindMp | _tlOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _tlOchrEvidBindMp | _tlOchrEvidBindMp `seq` (True) -> + (case (tl_5 _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOchrStore _tlOclDfGam _tlOclGam _tlOfinKiVarMp _tlOfinTyVarMp _tlOisNewtype _tlOkiGam _tlOlexLev _tlOmoduleNm _tlOopts _tlOpredScope _tlOrangeMp _tlOsysfEnv _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalGam _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpp,_tlIppL,_tlItyCBindL,_tlIvalCBindL) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _hdOvalGam | _hdOvalGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _hdOrangeMp | _hdOrangeMp `seq` (True) -> + (case (_lhsIpredScope) of + { _hdOpredScope | _hdOpredScope `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlexLev) of + { _hdOlexLev | _hdOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (_lhsIisNewtype) of + { _hdOisNewtype | _hdOisNewtype `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (_lhsIclDfGam) of + { _hdOclDfGam | _hdOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _hdOchrStore | _hdOchrStore `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _hdOchrScopeBindMp | _hdOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _hdOchrEvidBindMp | _hdOchrEvidBindMp `seq` (True) -> + (case (hd_5 _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOchrStore _hdOclDfGam _hdOclGam _hdOfinKiVarMp _hdOfinTyVarMp _hdOisNewtype _hdOkiGam _hdOlexLev _hdOmoduleNm _hdOopts _hdOpredScope _hdOrangeMp _hdOsysfEnv _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalGam _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpp,_hdItyCBindL,_hdIvalCBindL) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIffeCBindL ++ _tlIffeCBindL) of + { _lhsOffeCBindL | _lhsOffeCBindL `seq` (True) -> + (case (_hdIffiCBindL ++ _tlIffiCBindL) of + { _lhsOffiCBindL | _lhsOffiCBindL `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIgathTvKiVarMp `varmpUnion` _tlIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdItyCBindL ++ _tlItyCBindL) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case (_hdIvalCBindL ++ _tlIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOppL,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) + in sem_DataConstrs_Cons_5)) of + { ( sem_DataConstrs_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstrs_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_DataConstrs_Cons_4)) of + { ( sem_DataConstrs_4) | True -> + ( _lhsOdataAltForNewType,_lhsOdataConstrNmL,_lhsOdataConstrTagMp,_lhsOintlTyKiGam,_lhsOkiVarMp,sem_DataConstrs_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataConstrs_Cons_3)) of + { ( sem_DataConstrs_3) | True -> + ( _lhsOdataAltTyL,_lhsOgathMaxArity,_lhsOpolVarMp,sem_DataConstrs_3) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataConstrs_Cons_2)) of + { ( sem_DataConstrs_2) | True -> + ( _lhsOgUniq,sem_DataConstrs_2) }) }) }) }) }) }))) + in sem_DataConstrs_Cons_1)) of + { ( sem_DataConstrs_1) | True -> + ( _lhsOrange,sem_DataConstrs_1) }) }) }) }) + +sem_DataConstrs_Nil :: T_DataConstrs + +sem_DataConstrs_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataConstrs_Nil_1 :: T_DataConstrs_1 + sem_DataConstrs_Nil_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataConstrs_Nil_2 :: T_DataConstrs_2 + sem_DataConstrs_Nil_2 = + (\ _lhsIdataTy + _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIdataTy `seq` + (_lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case ([]) of + { _lhsOdataAltTyL | _lhsOdataAltTyL `seq` (True) -> + (case (0) of + { _lhsOgathMaxArity | _lhsOgathMaxArity `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataConstrs_Nil_3 :: T_DataConstrs_3 + sem_DataConstrs_Nil_3 = + (\ _lhsIdataAltTy + _lhsIkiVarMp + _lhsImaxArity + _lhsItyKiGam + _lhsItyNm -> + _lhsIdataAltTy `seq` + (_lhsIkiVarMp `seq` + (_lhsImaxArity `seq` + (_lhsItyKiGam `seq` + (_lhsItyNm `seq` + ((case (Ty_Any) of + { _lhsOdataAltForNewType | _lhsOdataAltForNewType `seq` (True) -> + (case ([]) of + { _lhsOdataConstrNmL | _lhsOdataConstrNmL `seq` (True) -> + (case (Map.empty) of + { _lhsOdataConstrTagMp | _lhsOdataConstrTagMp `seq` (True) -> + (case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataConstrs_Nil_4 :: T_DataConstrs_4 + sem_DataConstrs_Nil_4 = + (\ _lhsIfinTyKiGam + _lhsIpatTyVarMp + _lhsIpatValGam + _lhsItvKiVarMp -> + _lhsIfinTyKiGam `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpatValGam `seq` + (_lhsItvKiVarMp `seq` + ((case (emptyGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (emptyGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIpatValGam) of + { _lhsOpatValGam | _lhsOpatValGam `seq` (True) -> + (case ((let sem_DataConstrs_Nil_5 :: T_DataConstrs_5 + sem_DataConstrs_Nil_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyVarMp + _lhsIisNewtype + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIisNewtype `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOffeCBindL | _lhsOffeCBindL `seq` (True) -> + (case ([]) of + { _lhsOffiCBindL | _lhsOffiCBindL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOppL,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) + in sem_DataConstrs_Nil_5)) of + { ( sem_DataConstrs_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstrs_5) }) }) }) }) }) }) })))))) + in sem_DataConstrs_Nil_4)) of + { ( sem_DataConstrs_4) | True -> + ( _lhsOdataAltForNewType,_lhsOdataConstrNmL,_lhsOdataConstrTagMp,_lhsOintlTyKiGam,_lhsOkiVarMp,sem_DataConstrs_4) }) }) }) }) }) }))))))) + in sem_DataConstrs_Nil_3)) of + { ( sem_DataConstrs_3) | True -> + ( _lhsOdataAltTyL,_lhsOgathMaxArity,_lhsOpolVarMp,sem_DataConstrs_3) }) }) }) }))))))) + in sem_DataConstrs_Nil_2)) of + { ( sem_DataConstrs_2) | True -> + ( _lhsOgUniq,sem_DataConstrs_2) }) }))) + in sem_DataConstrs_Nil_1)) of + { ( sem_DataConstrs_1) | True -> + ( _lhsOrange,sem_DataConstrs_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataField.hs b/src/UHC/Light/Compiler/EH/MainAG_DataField.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataField.hs @@ -0,0 +1,372 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataField where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataField --------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + knPolCtx : Polarity + polGam : PolGam + chained attributes: + polVarMp : VarMp + tyGam : TyGam + synthesized attributes: + fldAnnL : [DataConFldAnnInfo] + fldTyL : FldTyL + visit 3: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 4: + inherited attribute: + dataTy : Ty + chained attribute: + kiVarMp : VarMp + synthesized attributes: + fldSelGam : ValGam + fldUpdGam : ValGam + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + kiL : TyL + visit 5: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + lexLev : Int + moduleNm : HsName + opts : EHCOpts + predScope : PredScope + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tvKiVarMp : VarMp + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + patTyVarMp : VarMp + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + pp : PP_Doc + alternatives: + alternative Field: + child hsrange : {Range} + child mbLabels : {Maybe [HsName]} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 2: + local nrFieldsForLabel : {Int} + local fldTyL : {FldTyL} + visit 3: + intra fldTyL : {FldTyL} + intra nrFieldsForLabel : {Int} + visit 4: + local fldSelGam : _ + local fldUpdGam : _ + intra fldTyL : {FldTyL} + intra nrFieldsForLabel : {Int} +-} +sem_DataField_Field :: Range -> + (Maybe [HsName]) -> + T_TyExpr -> + T_DataField + +sem_DataField_Field hsrange_ mbLabels_ tyExpr_ | hsrange_ `seq` (mbLabels_ `seq` (tyExpr_ `seq` (True))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataField_Field_1 :: T_DataField_1 + sem_DataField_Field_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataField_Field_2 :: T_DataField_2 + sem_DataField_Field_2 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (maybe 1 length mbLabels_) of + { _nrFieldsForLabel | _nrFieldsForLabel `seq` (True) -> + (case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (replicate _nrFieldsForLabel + ( DataConFldAnnInfo + (maybe Strictness_NonStrict id _tyExprImbStrictness) + )) of + { _lhsOfldAnnL | _lhsOfldAnnL `seq` (True) -> + (case (case mbLabels_ of + Just ls -> zipWith (\l t -> (Just l,t)) ls (repeat _tyExprIty) + _ -> [(Nothing,_tyExprIty)]) of + { _fldTyL | _fldTyL `seq` (True) -> + (case (_fldTyL) of + { _lhsOfldTyL | _lhsOfldTyL `seq` (True) -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_DataField_Field_3 :: T_DataField_3 + sem_DataField_Field_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_DataField_Field_4 :: T_DataField_4 + sem_DataField_Field_4 = + (\ _lhsIdataTy + _lhsIkiVarMp -> + _lhsIdataTy `seq` + (_lhsIkiVarMp `seq` + ((case (assocLToGam [ (l,ValGamInfo $ [_lhsIdataTy] `appArr` t) | (Just l,t) <- _fldTyL ]) of + { _fldSelGam | _fldSelGam `seq` (True) -> + (case (_fldSelGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (let mk t = [t,fr _lhsIdataTy] `appArr` _lhsIdataTy + where fv = tyFtvMp t + fr dt = dt + in assocLToGam [ (hsnFldUpd l,ValGamInfo $ mk t) | (Just l,t) <- _fldTyL ]) of + { _fldUpdGam | _fldUpdGam `seq` (True) -> + (case (_fldUpdGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (replicate _nrFieldsForLabel _tyExprIki) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataField_Field_5 :: T_DataField_5 + sem_DataField_Field_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpatTyVarMp + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItvKiVarMp + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (case mbLabels_ of + Just l -> ppCommas' l >#< "::" >#< _tyExprIpp + Nothing -> _tyExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) + in sem_DataField_Field_5)) of + { ( sem_DataField_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataField_5) }) }) }) }) }) }) }) }) }) }) })))) + in sem_DataField_Field_4)) of + { ( sem_DataField_4) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_DataField_4) }) }) }) }) }))) + in sem_DataField_Field_3)) of + { ( sem_DataField_3) | True -> + ( _lhsOfldAnnL,_lhsOfldTyL,_lhsOpolVarMp,_lhsOtyGam,sem_DataField_3) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_DataField_Field_2)) of + { ( sem_DataField_2) | True -> + ( _lhsOgUniq,sem_DataField_2) }) }) }) }))) + in sem_DataField_Field_1)) of + { ( sem_DataField_1) | True -> + ( _lhsOrange,sem_DataField_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs @@ -0,0 +1,1191 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataFieldExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataFieldExpr ----------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyGam : TyGam + tyKiGam : TyKiGam + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + visit 4: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + chained attribute: + gathDataGam : DataGam + visit 5: + inherited attribute: + dataGam : DataGam + synthesized attribute: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + fiOpts : FIOpts + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valGam : ValGam + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + updExprTyVarMp : VarMp + synthesized attributes: + fldL : [HsName] + mbConNm : Maybe HsName + updExprTy : Ty + visit 7: + inherited attributes: + fldFIOpts : FIOpts + knTy : Ty + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + noLetQuantTyVarIdS : TyVarIdS + ty : Ty + visit 8: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + dgi : DataGamInfo + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + dfeCBindL : CBindL + dfeCExpr : CExpr + errSq : ErrSq + fuCExprL : FieldUpdateL (DataTagInfo -> Int -> CExpr) + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + mbDti : Maybe DataTagInfo + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Upd: + child hsrange : {Range} + child dataFieldExpr : DataFieldExpr + child nm : {HsName} + child expr : Expr + visit 0: + local range : {Range} + visit 1: + local _tup12 : _ + intra range : {Range} + visit 2: + intra _tup12 : _ + intra range : {Range} + visit 3: + intra _tup12 : _ + intra range : {Range} + visit 4: + intra _tup12 : _ + intra range : {Range} + visit 5: + intra _tup12 : _ + intra range : {Range} + visit 6: + intra _tup12 : _ + intra range : {Range} + visit 7: + local lUniq : {UID} + local fe : {FIEnv} + local _tup11 : _ + local fo_ : {FIOut} + local knDataTy : {Ty} + local ty : {Ty} + intra _tup12 : _ + intra range : {Range} + visit 8: + local finalTyExpr : _ + local finalTyExprExpanded : _ + local fldExprNm : _ + local sysfty : _ + local acorety : _ + local nmErrs : {ErrL} + local pp : _ + local gTy : {Ty} + local gathMentrelFilterMp : _ + intra fe : {FIEnv} + intra lUniq : {UID} + intra _tup11 : _ + intra fo_ : {FIOut} + intra range : {Range} + alternative Con: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup14 : _ + intra range : {Range} + visit 2: + intra _tup14 : _ + intra range : {Range} + visit 3: + intra _tup14 : _ + intra range : {Range} + visit 4: + intra _tup14 : _ + intra range : {Range} + visit 5: + intra _tup14 : _ + intra range : {Range} + visit 6: + intra _tup14 : _ + intra range : {Range} + visit 7: + local ty : {Ty} + local lUniq2 : {UID} + local lUniq : {UID} + local _tup13 : _ + local gTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup14 : _ + intra range : {Range} + visit 8: + local dti : _ + local nmErrs : {ErrL} + local pp : _ + local gathMentrelFilterMp : _ + intra _tup13 : _ + intra fo_ : {FIOut} + intra range : {Range} + intra gTy : {Ty} + alternative Expr: + child hsrange : {Range} + child expr : Expr + visit 0: + local range : {Range} + visit 1: + local _tup15 : _ + visit 2: + intra _tup15 : _ + visit 3: + intra _tup15 : _ + visit 4: + intra _tup15 : _ + visit 5: + intra _tup15 : _ + visit 6: + local lUniq : {UID} + intra _tup15 : _ + visit 7: + local ty : {Ty} + visit 8: + local dfeCBindL : _ + local dfeCExpr : _ + local fuCExprL : _ + local pp : _ +-} +sem_DataFieldExpr_Upd :: Range -> + T_DataFieldExpr -> + HsName -> + T_Expr -> + T_DataFieldExpr + +sem_DataFieldExpr_Upd hsrange_ dataFieldExpr_ nm_ expr_ | hsrange_ `seq` (dataFieldExpr_ `seq` (nm_ `seq` (expr_ `seq` (True)))) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (dataFieldExpr_) of + { ( _dataFieldExprIrange,dataFieldExpr_1) | True -> + (case (rangeUnions [hsrange_, _dataFieldExprIrange + , _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_1 :: T_DataFieldExpr_1 + sem_DataFieldExpr_Upd_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup12 | __tup12 `seq` (True) -> + (case (__tup12) of + { (_dataFieldExprOgUniq,_) | _dataFieldExprOgUniq `seq` (True) -> + (case (dataFieldExpr_1 _dataFieldExprOgUniq) of + { ( _dataFieldExprIgUniq,dataFieldExpr_2) | True -> + (case (_dataFieldExprIgUniq) of + { _exprOgUniq | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_2 :: T_DataFieldExpr_2 + sem_DataFieldExpr_Upd_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _dataFieldExprOpredSameScopeCounter | _dataFieldExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _dataFieldExprOlexLev | _dataFieldExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _dataFieldExprOkiGam | _dataFieldExprOkiGam `seq` (True) -> + (case (dataFieldExpr_2 _dataFieldExprOkiGam _dataFieldExprOlexLev _dataFieldExprOpredSameScopeCounter) of + { ( _dataFieldExprIpredSameScopeCounter,dataFieldExpr_3) | True -> + (case (_dataFieldExprIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_3 :: T_DataFieldExpr_3 + sem_DataFieldExpr_Upd_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _dataFieldExprOtyKiGlobFreeTvarS | _dataFieldExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _dataFieldExprOtyKiGam | _dataFieldExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _dataFieldExprOtyGam | _dataFieldExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _dataFieldExprOpredScope | _dataFieldExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _dataFieldExprOpolVarMp | _dataFieldExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _dataFieldExprOpolGam | _dataFieldExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _dataFieldExprOopts | _dataFieldExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _dataFieldExprOkiVarMp | _dataFieldExprOkiVarMp `seq` (True) -> + (case (dataFieldExpr_3 _dataFieldExprOkiVarMp _dataFieldExprOopts _dataFieldExprOpolGam _dataFieldExprOpolVarMp _dataFieldExprOpredScope _dataFieldExprOtyGam _dataFieldExprOtyKiGam _dataFieldExprOtyKiGlobFreeTvarS) of + { ( _dataFieldExprIkiVarMp,_dataFieldExprIpolVarMp,dataFieldExpr_4) | True -> + (case (_dataFieldExprIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_dataFieldExprIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_4 :: T_DataFieldExpr_4 + sem_DataFieldExpr_Upd_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _dataFieldExprOtyTyTySigFreeTvarS | _dataFieldExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIgathDataGam) of + { _dataFieldExprOgathDataGam | _dataFieldExprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _dataFieldExprOfinTyKiGam | _dataFieldExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _dataFieldExprOfinKiVarMp | _dataFieldExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _dataFieldExprOclGam | _dataFieldExprOclGam `seq` (True) -> + (case (dataFieldExpr_4 _dataFieldExprOclGam _dataFieldExprOfinKiVarMp _dataFieldExprOfinTyKiGam _dataFieldExprOgathDataGam _dataFieldExprOtyTyTySigFreeTvarS) of + { ( _dataFieldExprIgathDataGam,dataFieldExpr_5) | True -> + (case (_dataFieldExprIgathDataGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_5 :: T_DataFieldExpr_5 + sem_DataFieldExpr_Upd_5 = + (\ _lhsIdataGam -> + _lhsIdataGam `seq` + ((case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _dataFieldExprOdataGam | _dataFieldExprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (dataFieldExpr_5 _dataFieldExprOdataGam) of + { ( _dataFieldExprIchrInstDeclSq,dataFieldExpr_6) | True -> + (case (_dataFieldExprIchrInstDeclSq `Seq.union` _exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_6 :: T_DataFieldExpr_6 + sem_DataFieldExpr_Upd_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsIupdExprTyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsIupdExprTyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _dataFieldExprOvalTyGlobFreeTvarS | _dataFieldExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _dataFieldExprOvalGam | _dataFieldExprOvalGam `seq` (True) -> + (case (_lhsIupdExprTyVarMp) of + { _dataFieldExprOupdExprTyVarMp | _dataFieldExprOupdExprTyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _dataFieldExprOtyTyGlobFreeTvarS | _dataFieldExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _dataFieldExprOtvKiVarMp | _dataFieldExprOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _dataFieldExprOfiOpts | _dataFieldExprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _dataFieldExprOclDfGam | _dataFieldExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _dataFieldExprOchrStore | _dataFieldExprOchrStore `seq` (True) -> + (case (dataFieldExpr_6 _dataFieldExprOchrStore _dataFieldExprOclDfGam _dataFieldExprOfiOpts _dataFieldExprOtvKiVarMp _dataFieldExprOtyTyGlobFreeTvarS _dataFieldExprOupdExprTyVarMp _dataFieldExprOvalGam _dataFieldExprOvalTyGlobFreeTvarS) of + { ( _dataFieldExprIfldL,_dataFieldExprImbConNm,_dataFieldExprIupdExprTy,_dataFieldExprIupdExprTyVarMp,dataFieldExpr_7) | True -> + (case (nm_ : _dataFieldExprIfldL) of + { _lhsOfldL | _lhsOfldL `seq` (True) -> + (case (_dataFieldExprImbConNm) of + { _lhsOmbConNm | _lhsOmbConNm `seq` (True) -> + (case (_dataFieldExprIupdExprTy) of + { _lhsOupdExprTy | _lhsOupdExprTy `seq` (True) -> + (case (_dataFieldExprIupdExprTyVarMp) of + { _lhsOupdExprTyVarMp | _lhsOupdExprTyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_7 :: T_DataFieldExpr_7 + sem_DataFieldExpr_Upd_7 = + (\ _lhsIfldFIOpts + _lhsIknTy + _lhsItyVarMp -> + _lhsIfldFIOpts `seq` + (_lhsIknTy `seq` + (_lhsItyVarMp `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsIfldFIOpts) of + { _dataFieldExprOfldFIOpts | _dataFieldExprOfldFIOpts `seq` (True) -> + (case (__tup12) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (dfCheck _lUniq _lhsIfiOpts _fe nm_ _lhsIvalGam _lhsItyVarMp _lhsIknTy) of + { __tup11 | __tup11 `seq` (True) -> + (case (__tup11) of + { (_,_,_,_fo_,_) | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsItyVarMp) of + { _dataFieldExprOtyVarMp | _dataFieldExprOtyVarMp `seq` (True) -> + (case (__tup11) of + { (_,_knDataTy,_,_,_) | _knDataTy `seq` (True) -> + (case (_knDataTy) of + { _dataFieldExprOknTy | _dataFieldExprOknTy `seq` (True) -> + (case (dataFieldExpr_7 _dataFieldExprOfldFIOpts _dataFieldExprOknTy _dataFieldExprOtyVarMp) of + { ( _dataFieldExprIgathCnstrMp,_dataFieldExprIgathRangeMp,_dataFieldExprInoLetQuantTyVarIdS,_dataFieldExprIty,_dataFieldExprItyVarMp,dataFieldExpr_8) | True -> + (case (_dataFieldExprItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (__tup11) of + { (_,_,_exprOknTy,_,_) | _exprOknTy `seq` (True) -> + (case (_lhsIfldFIOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (_dataFieldExprIgathCnstrMp `cnstrMpUnion` _exprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_dataFieldExprIgathRangeMp `Map.union` _exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_dataFieldExprInoLetQuantTyVarIdS `Set.union` _exprInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_knDataTy) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Upd_8 :: T_DataFieldExpr_8 + sem_DataFieldExpr_Upd_8 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIdgi + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIdgi `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _dataFieldExprOsysfEnv | _dataFieldExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _dataFieldExprOrangeMp | _dataFieldExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _dataFieldExprOfinValGam | _dataFieldExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _dataFieldExprOfinTyVarMp | _dataFieldExprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _dataFieldExprOchrScopeBindMp | _dataFieldExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _dataFieldExprOchrEvidBindMp | _dataFieldExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _dataFieldExprOcSubst | _dataFieldExprOcSubst `seq` (True) -> + (case (_lhsImoduleNm) of + { _dataFieldExprOmoduleNm | _dataFieldExprOmoduleNm `seq` (True) -> + (case (_lhsIdgi) of + { _dataFieldExprOdgi | _dataFieldExprOdgi `seq` (True) -> + (case (dataFieldExpr_8 _dataFieldExprOcSubst _dataFieldExprOchrEvidBindMp _dataFieldExprOchrScopeBindMp _dataFieldExprOdgi _dataFieldExprOfinTyVarMp _dataFieldExprOfinValGam _dataFieldExprOmoduleNm _dataFieldExprOrangeMp _dataFieldExprOsysfEnv) of + { ( _dataFieldExprIallErrSq,_dataFieldExprIcSubst,_dataFieldExprIdfeCBindL,_dataFieldExprIdfeCExpr,_dataFieldExprIerrSq,_dataFieldExprIfuCExprL,_dataFieldExprIgathMentrelFilterMp,_dataFieldExprIgathTvKiVarMp,_dataFieldExprImbDti,_dataFieldExprIpp,_dataFieldExprIppL) | True -> + (case (_dataFieldExprIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_dataFieldExprIallErrSq `Seq.union` _exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _exprIty) of + { _finalTyExpr | _finalTyExpr `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTyExpr) of + { _finalTyExprExpanded | _finalTyExprExpanded `seq` (True) -> + (case (mkHNm _lUniq) of + { _fldExprNm | _fldExprNm `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExprExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (acoreBind1Ty _fldExprNm _acorety _exprIcexpr : _dataFieldExprIdfeCBindL) of + { _lhsOdfeCBindL | _lhsOdfeCBindL `seq` (True) -> + (case (_dataFieldExprIdfeCExpr) of + { _lhsOdfeCExpr | _lhsOdfeCExpr `seq` (True) -> + (case (__tup11) of + { (_,_,_,_,_nmErrs) | _nmErrs `seq` (True) -> + (case (ppFld "=" Nothing nm_ (pp nm_) _exprIpp) of + { _pp | _pp `seq` (True) -> + (case (Seq.unions [ _dataFieldExprIerrSq + , rngLift _range mkNestErr' _pp [_exprIerrSq, Seq.fromList _nmErrs, foErrSq _fo_] + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (let mke dti o = CExpr_TupIns _dataFieldExprIdfeCExpr (dtiCTag dti) nm_ (acoreInt _lhsIopts o) (acoreVar _fldExprNm) + in (nm_,(mke,Nothing)) : _dataFieldExprIfuCExprL) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (__tup11) of + { (_gTy,_,_,_,_) | _gTy `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val (hsnFldUpd nm_) + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _gTy) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_dataFieldExprIgathTvKiVarMp `varmpUnion` _exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_dataFieldExprImbDti) of + { _lhsOmbDti | _lhsOmbDti `seq` (True) -> + (case (_dataFieldExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pp : _dataFieldExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_DataFieldExpr_Upd_8)) of + { ( sem_DataFieldExpr_8) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_DataFieldExpr_Upd_7)) of + { ( sem_DataFieldExpr_7) | True -> + ( _lhsOfldL,_lhsOmbConNm,_lhsOupdExprTy,_lhsOupdExprTyVarMp,sem_DataFieldExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_DataFieldExpr_Upd_6)) of + { ( sem_DataFieldExpr_6) | True -> + ( _lhsOchrInstDeclSq,sem_DataFieldExpr_6) }) }) }) }) }) }))) + in sem_DataFieldExpr_Upd_5)) of + { ( sem_DataFieldExpr_5) | True -> + ( _lhsOgathDataGam,sem_DataFieldExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataFieldExpr_Upd_4)) of + { ( sem_DataFieldExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_DataFieldExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_DataFieldExpr_Upd_3)) of + { ( sem_DataFieldExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_DataFieldExpr_3) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_DataFieldExpr_Upd_2)) of + { ( sem_DataFieldExpr_2) | True -> + ( _lhsOgUniq,sem_DataFieldExpr_2) }) }) }) }) }) }) }))) + in sem_DataFieldExpr_Upd_1)) of + { ( sem_DataFieldExpr_1) | True -> + ( _lhsOrange,sem_DataFieldExpr_1) }) }) }) }) }) + +sem_DataFieldExpr_Con :: Range -> + HsName -> + T_DataFieldExpr + +sem_DataFieldExpr_Con hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_1 :: T_DataFieldExpr_1 + sem_DataFieldExpr_Con_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} )) of + { __tup14 | __tup14 `seq` (True) -> + (case (__tup14) of + { (_lhsOgUniq,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_2 :: T_DataFieldExpr_2 + sem_DataFieldExpr_Con_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_3 :: T_DataFieldExpr_3 + sem_DataFieldExpr_Con_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_4 :: T_DataFieldExpr_4 + sem_DataFieldExpr_Con_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_5 :: T_DataFieldExpr_5 + sem_DataFieldExpr_Con_5 = + (\ _lhsIdataGam -> + _lhsIdataGam `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_6 :: T_DataFieldExpr_6 + sem_DataFieldExpr_Con_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsIupdExprTyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsIupdExprTyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case ([]) of + { _lhsOfldL | _lhsOfldL `seq` (True) -> + (case (Just nm_) of + { _lhsOmbConNm | _lhsOmbConNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOupdExprTy | _lhsOupdExprTy `seq` (True) -> + (case (_lhsIupdExprTyVarMp) of + { _lhsOupdExprTyVarMp | _lhsOupdExprTyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_7 :: T_DataFieldExpr_7 + sem_DataFieldExpr_Con_7 = + (\ _lhsIfldFIOpts + _lhsIknTy + _lhsItyVarMp -> + _lhsIfldFIOpts `seq` + (_lhsIknTy `seq` + (_lhsItyVarMp `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (Set.empty) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_lhsIknTy) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (__tup14) of + { (_,_,_lUniq2) | _lUniq2 `seq` (True) -> + (case (__tup14) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (valGamLookupTy (hsnUn nm_) _lhsIvalGam) of + { __tup13 | __tup13 `seq` (True) -> + (case (__tup13) of + { (_gTy,_) | _gTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (let [u] = mkNewTyVarL 1 _lUniq + in fitsIn _lhsIfiOpts _fe _lUniq2 _lhsItyVarMp (_gTy) ([_lhsIknTy] `appArr` u)) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Con_8 :: T_DataFieldExpr_8 + sem_DataFieldExpr_Con_8 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIdgi + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIdgi `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case ([]) of + { _lhsOdfeCBindL | _lhsOdfeCBindL `seq` (True) -> + (case (dgiDtiOfCon nm_ _lhsIdgi) of + { _dti | _dti `seq` (True) -> + (case (CExpr_Tup (dtiCTag _dti)) of + { _lhsOdfeCExpr | _lhsOdfeCExpr `seq` (True) -> + (case (__tup13) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [Seq.fromList _nmErrs, foErrSq _fo_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val (hsnUn nm_) + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _gTy) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (Just _dti) of + { _lhsOmbDti | _lhsOmbDti `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_DataFieldExpr_Con_8)) of + { ( sem_DataFieldExpr_8) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_DataFieldExpr_Con_7)) of + { ( sem_DataFieldExpr_7) | True -> + ( _lhsOfldL,_lhsOmbConNm,_lhsOupdExprTy,_lhsOupdExprTyVarMp,sem_DataFieldExpr_7) }) }) }) }) })))))))))) + in sem_DataFieldExpr_Con_6)) of + { ( sem_DataFieldExpr_6) | True -> + ( _lhsOchrInstDeclSq,sem_DataFieldExpr_6) }) }))) + in sem_DataFieldExpr_Con_5)) of + { ( sem_DataFieldExpr_5) | True -> + ( _lhsOgathDataGam,sem_DataFieldExpr_5) }) }))))))) + in sem_DataFieldExpr_Con_4)) of + { ( sem_DataFieldExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_DataFieldExpr_4) }) }) })))))))))) + in sem_DataFieldExpr_Con_3)) of + { ( sem_DataFieldExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_DataFieldExpr_3) }) }))))) + in sem_DataFieldExpr_Con_2)) of + { ( sem_DataFieldExpr_2) | True -> + ( _lhsOgUniq,sem_DataFieldExpr_2) }) }) }))) + in sem_DataFieldExpr_Con_1)) of + { ( sem_DataFieldExpr_1) | True -> + ( _lhsOrange,sem_DataFieldExpr_1) }) }) }) + +sem_DataFieldExpr_Expr :: Range -> + T_Expr -> + T_DataFieldExpr + +sem_DataFieldExpr_Expr hsrange_ expr_ | hsrange_ `seq` (expr_ `seq` (True)) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (rangeUnions [hsrange_, _exprIrange , _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_1 :: T_DataFieldExpr_1 + sem_DataFieldExpr_Expr_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup15 | __tup15 `seq` (True) -> + (case (__tup15) of + { (_exprOgUniq,_) | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_2 :: T_DataFieldExpr_2 + sem_DataFieldExpr_Expr_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_3 :: T_DataFieldExpr_3 + sem_DataFieldExpr_Expr_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_4 :: T_DataFieldExpr_4 + sem_DataFieldExpr_Expr_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIgathDataGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_5 :: T_DataFieldExpr_5 + sem_DataFieldExpr_Expr_5 = + (\ _lhsIdataGam -> + _lhsIdataGam `seq` + ((case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_6 :: T_DataFieldExpr_6 + sem_DataFieldExpr_Expr_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsIupdExprTyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsIupdExprTyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case ([]) of + { _lhsOfldL | _lhsOfldL `seq` (True) -> + (case (Nothing) of + { _lhsOmbConNm | _lhsOmbConNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (__tup15) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (mkNewTyVar _lUniq) of + { _exprOknTy | _exprOknTy `seq` (True) -> + (case (_lhsIupdExprTyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (_exprIty) of + { _lhsOupdExprTy | _lhsOupdExprTy `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOupdExprTyVarMp | _lhsOupdExprTyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_7 :: T_DataFieldExpr_7 + sem_DataFieldExpr_Expr_7 = + (\ _lhsIfldFIOpts + _lhsIknTy + _lhsItyVarMp -> + _lhsIfldFIOpts `seq` + (_lhsIknTy `seq` + (_lhsItyVarMp `seq` + ((case (_exprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_exprInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_lhsIknTy) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_DataFieldExpr_Expr_8 :: T_DataFieldExpr_8 + sem_DataFieldExpr_Expr_8 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIdgi + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIdgi `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case ([]) of + { _dfeCBindL | _dfeCBindL `seq` (True) -> + (case (_dfeCBindL) of + { _lhsOdfeCBindL | _lhsOdfeCBindL `seq` (True) -> + (case (_exprIcexpr) of + { _dfeCExpr | _dfeCExpr `seq` (True) -> + (case (_dfeCExpr) of + { _lhsOdfeCExpr | _lhsOdfeCExpr `seq` (True) -> + (case (_exprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _fuCExprL | _fuCExprL `seq` (True) -> + (case (_fuCExprL) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (_exprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (Nothing) of + { _lhsOmbDti | _lhsOmbDti `seq` (True) -> + (case (_exprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_DataFieldExpr_Expr_8)) of + { ( sem_DataFieldExpr_8) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }))))) + in sem_DataFieldExpr_Expr_7)) of + { ( sem_DataFieldExpr_7) | True -> + ( _lhsOfldL,_lhsOmbConNm,_lhsOupdExprTy,_lhsOupdExprTyVarMp,sem_DataFieldExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_DataFieldExpr_Expr_6)) of + { ( sem_DataFieldExpr_6) | True -> + ( _lhsOchrInstDeclSq,sem_DataFieldExpr_6) }) }) }) }))) + in sem_DataFieldExpr_Expr_5)) of + { ( sem_DataFieldExpr_5) | True -> + ( _lhsOgathDataGam,sem_DataFieldExpr_5) }) }) }) }) }) }) }) }))))))) + in sem_DataFieldExpr_Expr_4)) of + { ( sem_DataFieldExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_DataFieldExpr_4) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_DataFieldExpr_Expr_3)) of + { ( sem_DataFieldExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_DataFieldExpr_3) }) }) }) }) }) }) }))))) + in sem_DataFieldExpr_Expr_2)) of + { ( sem_DataFieldExpr_2) | True -> + ( _lhsOgUniq,sem_DataFieldExpr_2) }) }) }) }) }))) + in sem_DataFieldExpr_Expr_1)) of + { ( sem_DataFieldExpr_1) | True -> + ( _lhsOrange,sem_DataFieldExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs @@ -0,0 +1,870 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataFieldPatExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataFieldPatExpr -------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + tyGam : TyGam + tyKiGam : TyKiGam + visit 4: + inherited attributes: + clGam : ClGam + dataGam : DataGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + synthesized attribute: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + visit 5: + inherited attributes: + fiOpts : FIOpts + knTy : Ty + tySigGam : ValGam + chained attributes: + patTyVarMp : VarMp + valGam : ValGam + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + scopeGam : ScopeGam + ty : Ty + visit 7: + inherited attributes: + ceParentNm : HsName + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tySigVarMp : VarMp + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + dti : DataTagInfo + errSq : ErrSq + fldL : [HsName] + fsRPatL : FieldSplitL + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + patCRest : CPatRest + pp : PP_Doc + ppL : [PP_Doc] + valCBindL : CBindL + alternatives: + alternative Ext: + child hsrange : {Range} + child dataFieldPatExpr : DataFieldPatExpr + child nm : {HsName} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup17 : _ + intra range : {Range} + visit 2: + intra _tup17 : _ + intra range : {Range} + visit 3: + intra _tup17 : _ + intra range : {Range} + visit 4: + intra _tup17 : _ + intra range : {Range} + visit 5: + local lUniq2 : {UID} + local lUniq : {UID} + local knFldTy : _ + local _tup16 : _ + local gTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup17 : _ + intra range : {Range} + visit 6: + local ty : {Ty} + intra _tup16 : _ + intra fo_ : {FIOut} + intra range : {Range} + intra gTy : {Ty} + visit 7: + local nmErrs : {ErrL} + local pp : _ + local ioffset : _ + local gathMentrelFilterMp : _ + intra _tup16 : _ + intra fo_ : {FIOut} + intra range : {Range} + intra gTy : {Ty} + alternative Con: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup19 : _ + intra range : {Range} + visit 2: + intra _tup19 : _ + intra range : {Range} + visit 3: + intra _tup19 : _ + intra range : {Range} + visit 4: + intra _tup19 : _ + intra range : {Range} + visit 5: + local lUniq2 : {UID} + local lUniq : {UID} + local tyvar : _ + local knTyShape : _ + local _tup18 : _ + local gTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup19 : _ + intra range : {Range} + visit 6: + local ty : {Ty} + intra _tup18 : _ + intra fo_ : {FIOut} + intra range : {Range} + intra gTy : {Ty} + visit 7: + local dgi : {DataGamInfo} + local dti : _ + local nmErrs : {ErrL} + local pp : _ + local gathMentrelFilterMp : _ + intra _tup18 : _ + intra fo_ : {FIOut} + intra range : {Range} + intra gTy : {Ty} +-} +sem_DataFieldPatExpr_Ext :: Range -> + T_DataFieldPatExpr -> + HsName -> + T_PatExpr -> + T_DataFieldPatExpr + +sem_DataFieldPatExpr_Ext hsrange_ dataFieldPatExpr_ nm_ patExpr_ | hsrange_ `seq` (dataFieldPatExpr_ `seq` (nm_ `seq` (patExpr_ `seq` (True)))) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (dataFieldPatExpr_) of + { ( _dataFieldPatExprIrange,dataFieldPatExpr_1) | True -> + (case (rangeUnions [hsrange_, _dataFieldPatExprIrange + , _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_1 :: T_DataFieldPatExpr_1 + sem_DataFieldPatExpr_Ext_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} )) of + { __tup17 | __tup17 `seq` (True) -> + (case (__tup17) of + { (_dataFieldPatExprOgUniq,_,_) | _dataFieldPatExprOgUniq `seq` (True) -> + (case (dataFieldPatExpr_1 _dataFieldPatExprOgUniq) of + { ( _dataFieldPatExprIgUniq,dataFieldPatExpr_2) | True -> + (case (_dataFieldPatExprIgUniq) of + { _patExprOgUniq | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_2 :: T_DataFieldPatExpr_2 + sem_DataFieldPatExpr_Ext_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _dataFieldPatExprOpredSameScopeCounter | _dataFieldPatExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _dataFieldPatExprOlexLev | _dataFieldPatExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _dataFieldPatExprOkiGam | _dataFieldPatExprOkiGam `seq` (True) -> + (case (dataFieldPatExpr_2 _dataFieldPatExprOkiGam _dataFieldPatExprOlexLev _dataFieldPatExprOpredSameScopeCounter) of + { ( _dataFieldPatExprIpredSameScopeCounter,dataFieldPatExpr_3) | True -> + (case (_dataFieldPatExprIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_3 :: T_DataFieldPatExpr_3 + sem_DataFieldPatExpr_Ext_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _dataFieldPatExprOtyKiGlobFreeTvarS | _dataFieldPatExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _dataFieldPatExprOtyKiGam | _dataFieldPatExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _dataFieldPatExprOtyGam | _dataFieldPatExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _dataFieldPatExprOpredScope | _dataFieldPatExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _dataFieldPatExprOpolVarMp | _dataFieldPatExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _dataFieldPatExprOpolGam | _dataFieldPatExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _dataFieldPatExprOopts | _dataFieldPatExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _dataFieldPatExprOkiVarMp | _dataFieldPatExprOkiVarMp `seq` (True) -> + (case (dataFieldPatExpr_3 _dataFieldPatExprOkiVarMp _dataFieldPatExprOopts _dataFieldPatExprOpolGam _dataFieldPatExprOpolVarMp _dataFieldPatExprOpredScope _dataFieldPatExprOtyGam _dataFieldPatExprOtyKiGam _dataFieldPatExprOtyKiGlobFreeTvarS) of + { ( _dataFieldPatExprIkiVarMp,_dataFieldPatExprIpolVarMp,_dataFieldPatExprItyGam,_dataFieldPatExprItyKiGam,dataFieldPatExpr_4) | True -> + (case (_dataFieldPatExprItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_dataFieldPatExprItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_dataFieldPatExprIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_dataFieldPatExprIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_4 :: T_DataFieldPatExpr_4 + sem_DataFieldPatExpr_Ext_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _dataFieldPatExprOtyTyTySigFreeTvarS | _dataFieldPatExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _dataFieldPatExprOfinTyKiGam | _dataFieldPatExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _dataFieldPatExprOfinKiVarMp | _dataFieldPatExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _dataFieldPatExprOdataGam | _dataFieldPatExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _dataFieldPatExprOclGam | _dataFieldPatExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (dataFieldPatExpr_4 _dataFieldPatExprOclGam _dataFieldPatExprOdataGam _dataFieldPatExprOfinKiVarMp _dataFieldPatExprOfinTyKiGam _dataFieldPatExprOtyTyTySigFreeTvarS) of + { ( _dataFieldPatExprIchrInstDeclSq,dataFieldPatExpr_5) | True -> + (case (_dataFieldPatExprIchrInstDeclSq `Seq.union` _patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_5 :: T_DataFieldPatExpr_5 + sem_DataFieldPatExpr_Ext_5 = + (\ _lhsIfiOpts + _lhsIknTy + _lhsIpatTyVarMp + _lhsItySigGam + _lhsIvalGam -> + _lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + (_lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _dataFieldPatExprOvalGam | _dataFieldPatExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _dataFieldPatExprOtySigGam | _dataFieldPatExprOtySigGam `seq` (True) -> + (case (_lhsIknTy) of + { _dataFieldPatExprOknTy | _dataFieldPatExprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _dataFieldPatExprOfiOpts | _dataFieldPatExprOfiOpts `seq` (True) -> + (case (__tup17) of + { (_,_,_lUniq2) | _lUniq2 `seq` (True) -> + (case (__tup17) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (mkNewTyVar _lUniq) of + { _knFldTy | _knFldTy `seq` (True) -> + (case (valGamLookupTy nm_ _lhsIvalGam) of + { __tup16 | __tup16 `seq` (True) -> + (case (__tup16) of + { (_gTy,_) | _gTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq2 _lhsIpatTyVarMp _gTy ([_lhsIknTy] `appArr` _knFldTy)) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _dataFieldPatExprOpatTyVarMp | _dataFieldPatExprOpatTyVarMp `seq` (True) -> + (case (dataFieldPatExpr_5 _dataFieldPatExprOfiOpts _dataFieldPatExprOknTy _dataFieldPatExprOpatTyVarMp _dataFieldPatExprOtySigGam _dataFieldPatExprOvalGam) of + { ( _dataFieldPatExprIpatTyVarMp,_dataFieldPatExprIvalGam,dataFieldPatExpr_6) | True -> + (case (_dataFieldPatExprIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_dataFieldPatExprIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (True) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_knFldTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case ([]) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_6 :: T_DataFieldPatExpr_6 + sem_DataFieldPatExpr_Ext_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _dataFieldPatExprOvalTyGlobFreeTvarS | _dataFieldPatExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _dataFieldPatExprOtyVarMp | _dataFieldPatExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _dataFieldPatExprOtyTyGlobFreeTvarS | _dataFieldPatExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _dataFieldPatExprOtvKiVarMp | _dataFieldPatExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _dataFieldPatExprOclDfGam | _dataFieldPatExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _dataFieldPatExprOchrStore | _dataFieldPatExprOchrStore `seq` (True) -> + (case (dataFieldPatExpr_6 _dataFieldPatExprOchrStore _dataFieldPatExprOclDfGam _dataFieldPatExprOtvKiVarMp _dataFieldPatExprOtyTyGlobFreeTvarS _dataFieldPatExprOtyVarMp _dataFieldPatExprOvalTyGlobFreeTvarS) of + { ( _dataFieldPatExprIgathCnstrMp,_dataFieldPatExprIgathRangeMp,_dataFieldPatExprIscopeGam,_dataFieldPatExprIty,_dataFieldPatExprItyVarMp,dataFieldPatExpr_7) | True -> + (case (_dataFieldPatExprItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_dataFieldPatExprIgathCnstrMp `cnstrMpUnion` _patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_dataFieldPatExprIgathRangeMp `Map.union` _patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_dataFieldPatExprIscopeGam `gamUnion` _patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_dataFieldPatExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Ext_7 :: T_DataFieldPatExpr_7 + sem_DataFieldPatExpr_Ext_7 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _dataFieldPatExprOsysfEnv | _dataFieldPatExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _dataFieldPatExprOrangeMp | _dataFieldPatExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _dataFieldPatExprOfinValGam | _dataFieldPatExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _dataFieldPatExprOfinTyVarMp | _dataFieldPatExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _dataFieldPatExprOchrScopeBindMp | _dataFieldPatExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _dataFieldPatExprOchrEvidBindMp | _dataFieldPatExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _dataFieldPatExprOcSubst | _dataFieldPatExprOcSubst `seq` (True) -> + (case (_lhsItySigVarMp) of + { _dataFieldPatExprOtySigVarMp | _dataFieldPatExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _dataFieldPatExprOmoduleNm | _dataFieldPatExprOmoduleNm `seq` (True) -> + (case (_lhsIceParentNm) of + { _dataFieldPatExprOceParentNm | _dataFieldPatExprOceParentNm `seq` (True) -> + (case (dataFieldPatExpr_7 _dataFieldPatExprOcSubst _dataFieldPatExprOceParentNm _dataFieldPatExprOchrEvidBindMp _dataFieldPatExprOchrScopeBindMp _dataFieldPatExprOfinTyVarMp _dataFieldPatExprOfinValGam _dataFieldPatExprOmoduleNm _dataFieldPatExprOrangeMp _dataFieldPatExprOsysfEnv _dataFieldPatExprOtySigVarMp) of + { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppL,_dataFieldPatExprIvalCBindL) | True -> + (case (_dataFieldPatExprIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_dataFieldPatExprIallErrSq `Seq.union` _patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_dataFieldPatExprIdti) of + { _lhsOdti | _lhsOdti `seq` (True) -> + (case (__tup16) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (ppFld "=" Nothing nm_ (pp nm_) _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (Seq.unions [ _dataFieldPatExprIerrSq + , rngLift _range mkNestErr' _pp [_patExprIerrSq, Seq.fromList _nmErrs, foErrSq _fo_] + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (nm_ : _dataFieldPatExprIfldL) of + { _lhsOfldL | _lhsOfldL `seq` (True) -> + (case (fldInt $ dfiOffset $ panicJust "DataFieldPatExpr.Ext.ioffset" $ Map.lookup nm_ $ dtiFldMp _dataFieldPatExprIdti) of + { _ioffset | _ioffset `seq` (True) -> + (case ((FldKnownOffset nm_ _ioffset,_patExprIrpat) : _dataFieldPatExprIfsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val nm_ + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _gTy) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_dataFieldPatExprIgathTvKiVarMp `varmpUnion` _patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_dataFieldPatExprIpatCRest) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_dataFieldPatExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pp : _dataFieldPatExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_dataFieldPatExprIvalCBindL ++ _patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_DataFieldPatExpr_Ext_7)) of + { ( sem_DataFieldPatExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_DataFieldPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_DataFieldPatExpr_Ext_6)) of + { ( sem_DataFieldPatExpr_6) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_DataFieldPatExpr_6) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataFieldPatExpr_Ext_5)) of + { ( sem_DataFieldPatExpr_5) | True -> + ( _lhsOchrInstDeclSq,sem_DataFieldPatExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataFieldPatExpr_Ext_4)) of + { ( sem_DataFieldPatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_DataFieldPatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_DataFieldPatExpr_Ext_3)) of + { ( sem_DataFieldPatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_DataFieldPatExpr_3) }) }) }) }) }) }) }) }) }) }))))) + in sem_DataFieldPatExpr_Ext_2)) of + { ( sem_DataFieldPatExpr_2) | True -> + ( _lhsOgUniq,sem_DataFieldPatExpr_2) }) }) }) }) }) }) }))) + in sem_DataFieldPatExpr_Ext_1)) of + { ( sem_DataFieldPatExpr_1) | True -> + ( _lhsOrange,sem_DataFieldPatExpr_1) }) }) }) }) }) + +sem_DataFieldPatExpr_Con :: Range -> + HsName -> + T_DataFieldPatExpr + +sem_DataFieldPatExpr_Con hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_1 :: T_DataFieldPatExpr_1 + sem_DataFieldPatExpr_Con_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> (__cont,lUniq,lUniq2)}} )) of + { __tup19 | __tup19 `seq` (True) -> + (case (__tup19) of + { (_lhsOgUniq,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_2 :: T_DataFieldPatExpr_2 + sem_DataFieldPatExpr_Con_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_3 :: T_DataFieldPatExpr_3 + sem_DataFieldPatExpr_Con_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_4 :: T_DataFieldPatExpr_4 + sem_DataFieldPatExpr_Con_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_5 :: T_DataFieldPatExpr_5 + sem_DataFieldPatExpr_Con_5 = + (\ _lhsIfiOpts + _lhsIknTy + _lhsIpatTyVarMp + _lhsItySigGam + _lhsIvalGam -> + _lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + (_lhsIvalGam `seq` + ((case (__tup19) of + { (_,_,_lUniq2) | _lUniq2 `seq` (True) -> + (case (__tup19) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (mkTyVar _lUniq) of + { _tyvar | _tyvar `seq` (True) -> + (case ([_lhsIknTy] `appArr` _tyvar) of + { _knTyShape | _knTyShape `seq` (True) -> + (case (valGamLookupTy (hsnUn nm_) _lhsIvalGam) of + { __tup18 | __tup18 `seq` (True) -> + (case (__tup18) of + { (_gTy,_) | _gTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq2 _lhsIpatTyVarMp _gTy _knTyShape) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_6 :: T_DataFieldPatExpr_6 + sem_DataFieldPatExpr_Con_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_lhsIknTy) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_DataFieldPatExpr_Con_7 :: T_DataFieldPatExpr_7 + sem_DataFieldPatExpr_Con_7 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (let (_,t,_) = valGamTyOfDataCon nm_ _lhsIvalGam + in panicJust "DataFieldPatExpr.dgi" $ dataGamDgiOfTy t _lhsIdataGam) of + { _dgi | _dgi `seq` (True) -> + (case (dgiDtiOfCon nm_ _dgi) of + { _dti | _dti `seq` (True) -> + (case (_dti) of + { _lhsOdti | _lhsOdti `seq` (True) -> + (case (__tup18) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [Seq.fromList _nmErrs, foErrSq _fo_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfldL | _lhsOfldL `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val (hsnUn nm_) + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _gTy) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_DataFieldPatExpr_Con_7)) of + { ( sem_DataFieldPatExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_DataFieldPatExpr_7) }) }) }) }) }) }) })))))))) + in sem_DataFieldPatExpr_Con_6)) of + { ( sem_DataFieldPatExpr_6) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_DataFieldPatExpr_6) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_DataFieldPatExpr_Con_5)) of + { ( sem_DataFieldPatExpr_5) | True -> + ( _lhsOchrInstDeclSq,sem_DataFieldPatExpr_5) }) }))))))) + in sem_DataFieldPatExpr_Con_4)) of + { ( sem_DataFieldPatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_DataFieldPatExpr_4) }) }) }) }) })))))))))) + in sem_DataFieldPatExpr_Con_3)) of + { ( sem_DataFieldPatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_DataFieldPatExpr_3) }) }))))) + in sem_DataFieldPatExpr_Con_2)) of + { ( sem_DataFieldPatExpr_2) | True -> + ( _lhsOgUniq,sem_DataFieldPatExpr_2) }) }) }))) + in sem_DataFieldPatExpr_Con_1)) of + { ( sem_DataFieldPatExpr_1) | True -> + ( _lhsOrange,sem_DataFieldPatExpr_1) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs @@ -0,0 +1,555 @@ + + + +module UHC.Light.Compiler.EH.MainAG_DataFields where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- DataFields -------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + knPolCtx : Polarity + polGam : PolGam + chained attributes: + polVarMp : VarMp + tyGam : TyGam + synthesized attributes: + fldAnnL : [DataConFldAnnInfo] + fldTyL : FldTyL + visit 3: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 4: + inherited attribute: + dataTy : Ty + chained attribute: + kiVarMp : VarMp + synthesized attributes: + fldSelGam : ValGam + fldUpdGam : ValGam + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + kiL : TyL + visit 5: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + lexLev : Int + moduleNm : HsName + opts : EHCOpts + predScope : PredScope + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tvKiVarMp : VarMp + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + patTyVarMp : VarMp + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : DataField + child tl : DataFields + alternative Nil: +-} +sem_DataFields_Cons :: T_DataField -> + T_DataFields -> + T_DataFields + +sem_DataFields_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFields_Cons_1 :: T_DataFields_1 + sem_DataFields_Cons_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFields_Cons_2 :: T_DataFields_2 + sem_DataFields_Cons_2 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _hdOknPolCtx | _hdOknPolCtx `seq` (True) -> + (case (hd_2 _hdOknPolCtx _hdOpolGam _hdOpolVarMp _hdOtyGam) of + { ( _hdIfldAnnL,_hdIfldTyL,_hdIpolVarMp,_hdItyGam,hd_3) | True -> + (case (_hdItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tlOknPolCtx | _tlOknPolCtx `seq` (True) -> + (case (tl_2 _tlOknPolCtx _tlOpolGam _tlOpolVarMp _tlOtyGam) of + { ( _tlIfldAnnL,_tlIfldTyL,_tlIpolVarMp,_tlItyGam,tl_3) | True -> + (case (_hdIfldAnnL ++ _tlIfldAnnL) of + { _lhsOfldAnnL | _lhsOfldAnnL `seq` (True) -> + (case (_hdIfldTyL ++ _tlIfldTyL) of + { _lhsOfldTyL | _lhsOfldTyL `seq` (True) -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_tlItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_DataFields_Cons_3 :: T_DataFields_3 + sem_DataFields_Cons_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (hd_3 _hdOtyKiGam) of + { ( _hdIintlTyKiGam,_hdItyKiGam,hd_4) | True -> + (case (_hdItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (tl_3 _tlOtyKiGam) of + { ( _tlIintlTyKiGam,_tlItyKiGam,tl_4) | True -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tlItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_DataFields_Cons_4 :: T_DataFields_4 + sem_DataFields_Cons_4 = + (\ _lhsIdataTy + _lhsIkiVarMp -> + _lhsIdataTy `seq` + (_lhsIkiVarMp `seq` + ((case (_lhsIdataTy) of + { _tlOdataTy | _tlOdataTy `seq` (True) -> + (case (_lhsIdataTy) of + { _hdOdataTy | _hdOdataTy `seq` (True) -> + (case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (hd_4 _hdOdataTy _hdOkiVarMp) of + { ( _hdIfldSelGam,_hdIfldUpdGam,_hdIgathCnstrMp,_hdIgathRangeMp,_hdIkiL,_hdIkiVarMp,hd_5) | True -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (tl_4 _tlOdataTy _tlOkiVarMp) of + { ( _tlIfldSelGam,_tlIfldUpdGam,_tlIgathCnstrMp,_tlIgathRangeMp,_tlIkiL,_tlIkiVarMp,tl_5) | True -> + (case (_hdIfldSelGam `gamUnion` _tlIfldSelGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (_hdIfldUpdGam `gamUnion` _tlIfldUpdGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (_hdIgathCnstrMp `cnstrMpUnion` _tlIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_hdIgathRangeMp `Map.union` _tlIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_hdIkiL ++ _tlIkiL) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataFields_Cons_5 :: T_DataFields_5 + sem_DataFields_Cons_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpatTyVarMp + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItvKiVarMp + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _tlOtvKiVarMp | _tlOtvKiVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _tlOrangeMp | _tlOrangeMp `seq` (True) -> + (case (_lhsIpredScope) of + { _tlOpredScope | _tlOpredScope `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _hdOpatTyVarMp | _hdOpatTyVarMp `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _hdOtvKiVarMp | _hdOtvKiVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _hdOrangeMp | _hdOrangeMp `seq` (True) -> + (case (_lhsIpredScope) of + { _hdOpredScope | _hdOpredScope `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIlexLev) of + { _hdOlexLev | _hdOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (_lhsIclDfGam) of + { _hdOclDfGam | _hdOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _hdOchrStore | _hdOchrStore `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _hdOchrScopeBindMp | _hdOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _hdOchrEvidBindMp | _hdOchrEvidBindMp `seq` (True) -> + (case (hd_5 _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOchrStore _hdOclDfGam _hdOclGam _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOkiGam _hdOlexLev _hdOmoduleNm _hdOopts _hdOpatTyVarMp _hdOpredScope _hdOrangeMp _hdOsysfEnv _hdOtvKiVarMp _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTyVarMp,_hdIpp) | True -> + (case (_hdIpatTyVarMp) of + { _tlOpatTyVarMp | _tlOpatTyVarMp `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIlexLev) of + { _tlOlexLev | _tlOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (_lhsIclDfGam) of + { _tlOclDfGam | _tlOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _tlOchrStore | _tlOchrStore `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _tlOchrScopeBindMp | _tlOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _tlOchrEvidBindMp | _tlOchrEvidBindMp `seq` (True) -> + (case (tl_5 _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOchrStore _tlOclDfGam _tlOclGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOkiGam _tlOlexLev _tlOmoduleNm _tlOopts _tlOpatTyVarMp _tlOpredScope _tlOrangeMp _tlOsysfEnv _tlOtvKiVarMp _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTyVarMp,_tlIpp,_tlIppL) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIgathTvKiVarMp `varmpUnion` _tlIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_tlIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) + in sem_DataFields_Cons_5)) of + { ( sem_DataFields_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataFields_5) }) }) }) }) }) }) }) }) }) }) }) }) })))) + in sem_DataFields_Cons_4)) of + { ( sem_DataFields_4) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_DataFields_4) }) }) }) }) }) }) }))) + in sem_DataFields_Cons_3)) of + { ( sem_DataFields_3) | True -> + ( _lhsOfldAnnL,_lhsOfldTyL,_lhsOpolVarMp,_lhsOtyGam,sem_DataFields_3) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_DataFields_Cons_2)) of + { ( sem_DataFields_2) | True -> + ( _lhsOgUniq,sem_DataFields_2) }) }) }) }) }) }))) + in sem_DataFields_Cons_1)) of + { ( sem_DataFields_1) | True -> + ( _lhsOrange,sem_DataFields_1) }) }) }) }) + +sem_DataFields_Nil :: T_DataFields + +sem_DataFields_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_DataFields_Nil_1 :: T_DataFields_1 + sem_DataFields_Nil_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_DataFields_Nil_2 :: T_DataFields_2 + sem_DataFields_Nil_2 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case ([]) of + { _lhsOfldAnnL | _lhsOfldAnnL `seq` (True) -> + (case ([]) of + { _lhsOfldTyL | _lhsOfldTyL `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_DataFields_Nil_3 :: T_DataFields_3 + sem_DataFields_Nil_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_DataFields_Nil_4 :: T_DataFields_4 + sem_DataFields_Nil_4 = + (\ _lhsIdataTy + _lhsIkiVarMp -> + _lhsIdataTy `seq` + (_lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOfldSelGam | _lhsOfldSelGam `seq` (True) -> + (case (emptyGam) of + { _lhsOfldUpdGam | _lhsOfldUpdGam `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case ([]) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_DataFields_Nil_5 :: T_DataFields_5 + sem_DataFields_Nil_5 = + (\ _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIchrStore + _lhsIclDfGam + _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsIlexLev + _lhsImoduleNm + _lhsIopts + _lhsIpatTyVarMp + _lhsIpredScope + _lhsIrangeMp + _lhsIsysfEnv + _lhsItvKiVarMp + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpatTyVarMp `seq` + (_lhsIpredScope `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }))))))))))))))))))))))) + in sem_DataFields_Nil_5)) of + { ( sem_DataFields_5) | True -> + ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataFields_5) }) }) }) }) }) }) })))) + in sem_DataFields_Nil_4)) of + { ( sem_DataFields_4) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_DataFields_4) }) }) }))) + in sem_DataFields_Nil_3)) of + { ( sem_DataFields_3) | True -> + ( _lhsOfldAnnL,_lhsOfldTyL,_lhsOpolVarMp,_lhsOtyGam,sem_DataFields_3) }) }) }) }) })))))) + in sem_DataFields_Nil_2)) of + { ( sem_DataFields_2) | True -> + ( _lhsOgUniq,sem_DataFields_2) }) }))) + in sem_DataFields_Nil_1)) of + { ( sem_DataFields_1) | True -> + ( _lhsOrange,sem_DataFields_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_Decl.hs b/src/UHC/Light/Compiler/EH/MainAG_Decl.hs new file mode 100644 # file too large to diff: src/UHC/Light/Compiler/EH/MainAG_Decl.hs diff --git a/src/UHC/Light/Compiler/EH/MainAG_Decls.hs b/src/UHC/Light/Compiler/EH/MainAG_Decls.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_Decls.hs @@ -0,0 +1,1004 @@ + + + +module UHC.Light.Compiler.EH.MainAG_Decls where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- Decls ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attributes: + gUniq : UID + gathKiSigGam : TyGam + synthesized attribute: + hasInstDecl : Bool + visit 2: + inherited attribute: + kiGam : KiGam + synthesized attribute: + gathTyKiSigGam : TyKiGam + visit 3: + inherited attribute: + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 4: + inherited attribute: + tyKiSigGam : TyKiGam + chained attribute: + patTyGam : TyGam + visit 5: + inherited attribute: + tyGam : TyGam + chained attributes: + patTyKiGam : TyKiGam + tyTyVarMp : VarMp + visit 6: + inherited attribute: + tyKiGam : TyKiGam + chained attributes: + patKiVarMp : VarMp + patPolGam : PolGam + visit 7: + inherited attributes: + mbKnPolCtx : Maybe Polarity + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + synthesized attribute: + generDataInfoL : [GenerDataInfo] + visit 8: + chained attribute: + patClGam1 : ClGam + visit 9: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + chained attribute: + patClGam2 : ClGam + visit 10: + inherited attribute: + clGam : ClGam + chained attribute: + gathDataGam : DataGam + synthesized attributes: + gathDeclDataGam : DataGam + gathTySigGam : ValGam + gathTySigVarMp : VarMp + visit 11: + inherited attribute: + dataGam : DataGam + synthesized attributes: + chrClassDeclSq : Seq.FastSeq (CHRClassDecl Pred RedHowAnnotation) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + gathClDfGam : ClassDefaultGam + visit 12: + inherited attributes: + tvKiVarMp : VarMp + tySigGam : ValGam + tySigVarMp : VarMp + chained attributes: + patTyVarMp : VarMp + patValGam : ValGam + visit 13: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + tyTyGlobFreeTvarS : TyVarIdS + valGam : ValGam + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + intlTyKiGam : TyKiGam + noLetQuantTyVarIdS : TyVarIdS + scopeGam : ScopeGam + visit 14: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + isStrict : Bool + kiSigGam : TyGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + bangEvalL : [CExpr -> CExpr] + errSq : ErrSq + ffeCBindL : CBindL + ffiCBindL : CBindL + gathHiddenExports : Seq.Seq (HsName,IdOccKind) + gathLamMp : LamMp + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + orphanS : Set.Set HsName + pp : PP_Doc + tyCBindL : CBindL + valCBindL : CBindL + alternatives: + alternative Cons: + child hd : Decl + child tl : Decls + visit 14: + local errPP : _ + alternative Nil: +-} +sem_Decls_Cons :: T_Decl -> + T_Decls -> + T_Decls + +sem_Decls_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_Decls_Cons_1 :: T_Decls_1 + sem_Decls_Cons_1 = + (\ _lhsIgUniq + _lhsIgathKiSigGam -> + _lhsIgUniq `seq` + (_lhsIgathKiSigGam `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (_lhsIgathKiSigGam) of + { _hdOgathKiSigGam | _hdOgathKiSigGam `seq` (True) -> + (case (hd_1 _hdOgUniq _hdOgathKiSigGam) of + { ( _hdIgUniq,_hdIgathKiSigGam,_hdIhasInstDecl,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (_hdIgathKiSigGam) of + { _tlOgathKiSigGam | _tlOgathKiSigGam `seq` (True) -> + (case (tl_1 _tlOgUniq _tlOgathKiSigGam) of + { ( _tlIgUniq,_tlIgathKiSigGam,_tlIhasInstDecl,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (_tlIgathKiSigGam) of + { _lhsOgathKiSigGam | _lhsOgathKiSigGam `seq` (True) -> + (case (_hdIhasInstDecl || _tlIhasInstDecl) of + { _lhsOhasInstDecl | _lhsOhasInstDecl `seq` (True) -> + (case ((let sem_Decls_Cons_2 :: T_Decls_2 + sem_Decls_Cons_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (tl_2 _tlOkiGam) of + { ( _tlIgathTyKiSigGam,tl_3) | True -> + (case (hd_2 _hdOkiGam) of + { ( _hdIgathTyKiSigGam,hd_3) | True -> + (case (_hdIgathTyKiSigGam `gamUnion` _tlIgathTyKiSigGam) of + { _lhsOgathTyKiSigGam | _lhsOgathTyKiSigGam `seq` (True) -> + (case ((let sem_Decls_Cons_3 :: T_Decls_3 + sem_Decls_Cons_3 = + (\ _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _hdOpredSameScopeCounter | _hdOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _hdOlexLev | _hdOlexLev `seq` (True) -> + (case (hd_3 _hdOlexLev _hdOpredSameScopeCounter) of + { ( _hdIpredSameScopeCounter,hd_4) | True -> + (case (_hdIpredSameScopeCounter) of + { _tlOpredSameScopeCounter | _tlOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _tlOlexLev | _tlOlexLev `seq` (True) -> + (case (tl_3 _tlOlexLev _tlOpredSameScopeCounter) of + { ( _tlIpredSameScopeCounter,tl_4) | True -> + (case (_tlIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_Decls_Cons_4 :: T_Decls_4 + sem_Decls_Cons_4 = + (\ _lhsIpatTyGam + _lhsItyKiSigGam -> + _lhsIpatTyGam `seq` + (_lhsItyKiSigGam `seq` + ((case (_lhsItyKiSigGam) of + { _tlOtyKiSigGam | _tlOtyKiSigGam `seq` (True) -> + (case (_lhsItyKiSigGam) of + { _hdOtyKiSigGam | _hdOtyKiSigGam `seq` (True) -> + (case (_lhsIpatTyGam) of + { _hdOpatTyGam | _hdOpatTyGam `seq` (True) -> + (case (hd_4 _hdOpatTyGam _hdOtyKiSigGam) of + { ( _hdIpatTyGam,hd_5) | True -> + (case (_hdIpatTyGam) of + { _tlOpatTyGam | _tlOpatTyGam `seq` (True) -> + (case (tl_4 _tlOpatTyGam _tlOtyKiSigGam) of + { ( _tlIpatTyGam,tl_5) | True -> + (case (_tlIpatTyGam) of + { _lhsOpatTyGam | _lhsOpatTyGam `seq` (True) -> + (case ((let sem_Decls_Cons_5 :: T_Decls_5 + sem_Decls_Cons_5 = + (\ _lhsIpatTyKiGam + _lhsItyGam + _lhsItyTyVarMp -> + _lhsIpatTyKiGam `seq` + (_lhsItyGam `seq` + (_lhsItyTyVarMp `seq` + ((case (_lhsItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (_lhsIpatTyKiGam) of + { _hdOpatTyKiGam | _hdOpatTyKiGam `seq` (True) -> + (case (_lhsItyTyVarMp) of + { _hdOtyTyVarMp | _hdOtyTyVarMp `seq` (True) -> + (case (hd_5 _hdOpatTyKiGam _hdOtyGam _hdOtyTyVarMp) of + { ( _hdIpatTyKiGam,_hdItyTyVarMp,hd_6) | True -> + (case (_hdIpatTyKiGam) of + { _tlOpatTyKiGam | _tlOpatTyKiGam `seq` (True) -> + (case (_hdItyTyVarMp) of + { _tlOtyTyVarMp | _tlOtyTyVarMp `seq` (True) -> + (case (tl_5 _tlOpatTyKiGam _tlOtyGam _tlOtyTyVarMp) of + { ( _tlIpatTyKiGam,_tlItyTyVarMp,tl_6) | True -> + (case (_tlIpatTyKiGam) of + { _lhsOpatTyKiGam | _lhsOpatTyKiGam `seq` (True) -> + (case (_tlItyTyVarMp) of + { _lhsOtyTyVarMp | _lhsOtyTyVarMp `seq` (True) -> + (case ((let sem_Decls_Cons_6 :: T_Decls_6 + sem_Decls_Cons_6 = + (\ _lhsIpatKiVarMp + _lhsIpatPolGam + _lhsItyKiGam -> + _lhsIpatKiVarMp `seq` + (_lhsIpatPolGam `seq` + (_lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (_lhsIpatKiVarMp) of + { _hdOpatKiVarMp | _hdOpatKiVarMp `seq` (True) -> + (case (_lhsIpatPolGam) of + { _hdOpatPolGam | _hdOpatPolGam `seq` (True) -> + (case (hd_6 _hdOpatKiVarMp _hdOpatPolGam _hdOtyKiGam) of + { ( _hdIpatKiVarMp,_hdIpatPolGam,hd_7) | True -> + (case (_hdIpatKiVarMp) of + { _tlOpatKiVarMp | _tlOpatKiVarMp `seq` (True) -> + (case (_hdIpatPolGam) of + { _tlOpatPolGam | _tlOpatPolGam `seq` (True) -> + (case (tl_6 _tlOpatKiVarMp _tlOpatPolGam _tlOtyKiGam) of + { ( _tlIpatKiVarMp,_tlIpatPolGam,tl_7) | True -> + (case (_tlIpatKiVarMp) of + { _lhsOpatKiVarMp | _lhsOpatKiVarMp `seq` (True) -> + (case (_tlIpatPolGam) of + { _lhsOpatPolGam | _lhsOpatPolGam `seq` (True) -> + (case ((let sem_Decls_Cons_7 :: T_Decls_7 + sem_Decls_Cons_7 = + (\ _lhsIkiVarMp + _lhsImbKnPolCtx + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsImbKnPolCtx `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIpredScope) of + { _tlOpredScope | _tlOpredScope `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIpredScope) of + { _hdOpredScope | _hdOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImbKnPolCtx) of + { _hdOmbKnPolCtx | _hdOmbKnPolCtx `seq` (True) -> + (case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (hd_7 _hdOkiVarMp _hdOmbKnPolCtx _hdOopts _hdOpolGam _hdOpolVarMp _hdOpredScope _hdOtyKiGlobFreeTvarS) of + { ( _hdIgenerDataInfoL,_hdIkiVarMp,_hdIpolVarMp,hd_8) | True -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImbKnPolCtx) of + { _tlOmbKnPolCtx | _tlOmbKnPolCtx `seq` (True) -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (tl_7 _tlOkiVarMp _tlOmbKnPolCtx _tlOopts _tlOpolGam _tlOpolVarMp _tlOpredScope _tlOtyKiGlobFreeTvarS) of + { ( _tlIgenerDataInfoL,_tlIkiVarMp,_tlIpolVarMp,tl_8) | True -> + (case (_hdIgenerDataInfoL ++ _tlIgenerDataInfoL) of + { _lhsOgenerDataInfoL | _lhsOgenerDataInfoL `seq` (True) -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_Decls_Cons_8 :: T_Decls_8 + sem_Decls_Cons_8 = + (\ _lhsIpatClGam1 -> + _lhsIpatClGam1 `seq` + ((case (_lhsIpatClGam1) of + { _hdOpatClGam1 | _hdOpatClGam1 `seq` (True) -> + (case (hd_8 _hdOpatClGam1) of + { ( _hdIpatClGam1,hd_9) | True -> + (case (_hdIpatClGam1) of + { _tlOpatClGam1 | _tlOpatClGam1 `seq` (True) -> + (case (tl_8 _tlOpatClGam1) of + { ( _tlIpatClGam1,tl_9) | True -> + (case (_tlIpatClGam1) of + { _lhsOpatClGam1 | _lhsOpatClGam1 `seq` (True) -> + (case ((let sem_Decls_Cons_9 :: T_Decls_9 + sem_Decls_Cons_9 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIpatClGam2 + _lhsItyTyTySigFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIpatClGam2 `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIpatClGam2) of + { _hdOpatClGam2 | _hdOpatClGam2 `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (hd_9 _hdOfinKiVarMp _hdOfinTyKiGam _hdOpatClGam2 _hdOtyTyTySigFreeTvarS) of + { ( _hdIpatClGam2,hd_10) | True -> + (case (_hdIpatClGam2) of + { _tlOpatClGam2 | _tlOpatClGam2 `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (tl_9 _tlOfinKiVarMp _tlOfinTyKiGam _tlOpatClGam2 _tlOtyTyTySigFreeTvarS) of + { ( _tlIpatClGam2,tl_10) | True -> + (case (_tlIpatClGam2) of + { _lhsOpatClGam2 | _lhsOpatClGam2 `seq` (True) -> + (case ((let sem_Decls_Cons_10 :: T_Decls_10 + sem_Decls_Cons_10 = + (\ _lhsIclGam + _lhsIgathDataGam -> + _lhsIclGam `seq` + (_lhsIgathDataGam `seq` + ((case (_lhsIgathDataGam) of + { _hdOgathDataGam | _hdOgathDataGam `seq` (True) -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (hd_10 _hdOclGam _hdOgathDataGam) of + { ( _hdIgathDataGam,_hdIgathDeclDataGam,_hdIgathTySigGam,_hdIgathTySigVarMp,hd_11) | True -> + (case (_hdIgathDataGam) of + { _tlOgathDataGam | _tlOgathDataGam `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (tl_10 _tlOclGam _tlOgathDataGam) of + { ( _tlIgathDataGam,_tlIgathDeclDataGam,_tlIgathTySigGam,_tlIgathTySigVarMp,tl_11) | True -> + (case (_tlIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case (_hdIgathDeclDataGam `gamUnion` _tlIgathDeclDataGam) of + { _lhsOgathDeclDataGam | _lhsOgathDeclDataGam `seq` (True) -> + (case (_hdIgathTySigGam `gamAddGam` _tlIgathTySigGam) of + { _lhsOgathTySigGam | _lhsOgathTySigGam `seq` (True) -> + (case (_hdIgathTySigVarMp `varUpd` _tlIgathTySigVarMp) of + { _lhsOgathTySigVarMp | _lhsOgathTySigVarMp `seq` (True) -> + (case ((let sem_Decls_Cons_11 :: T_Decls_11 + sem_Decls_Cons_11 = + (\ _lhsIdataGam -> + _lhsIdataGam `seq` + ((case (_lhsIdataGam) of + { _tlOdataGam | _tlOdataGam `seq` (True) -> + (case (tl_11 _tlOdataGam) of + { ( _tlIchrClassDeclSq,_tlIchrInstDeclSq,_tlIgathClDfGam,tl_12) | True -> + (case (_lhsIdataGam) of + { _hdOdataGam | _hdOdataGam `seq` (True) -> + (case (hd_11 _hdOdataGam) of + { ( _hdIchrClassDeclSq,_hdIchrInstDeclSq,_hdIgathClDfGam,hd_12) | True -> + (case (_hdIchrClassDeclSq `Seq.union` _tlIchrClassDeclSq) of + { _lhsOchrClassDeclSq | _lhsOchrClassDeclSq `seq` (True) -> + (case (_hdIchrInstDeclSq `Seq.union` _tlIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_hdIgathClDfGam `gamUnion` _tlIgathClDfGam) of + { _lhsOgathClDfGam | _lhsOgathClDfGam `seq` (True) -> + (case ((let sem_Decls_Cons_12 :: T_Decls_12 + sem_Decls_Cons_12 = + (\ _lhsIpatTyVarMp + _lhsIpatValGam + _lhsItvKiVarMp + _lhsItySigGam + _lhsItySigVarMp -> + _lhsIpatTyVarMp `seq` + (_lhsIpatValGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItySigGam `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsItySigVarMp) of + { _tlOtySigVarMp | _tlOtySigVarMp `seq` (True) -> + (case (_lhsItySigGam) of + { _tlOtySigGam | _tlOtySigGam `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _tlOtvKiVarMp | _tlOtvKiVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _hdOtySigVarMp | _hdOtySigVarMp `seq` (True) -> + (case (_lhsItySigGam) of + { _hdOtySigGam | _hdOtySigGam `seq` (True) -> + (case (_lhsIpatValGam) of + { _hdOpatValGam | _hdOpatValGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _hdOpatTyVarMp | _hdOpatTyVarMp `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _hdOtvKiVarMp | _hdOtvKiVarMp `seq` (True) -> + (case (hd_12 _hdOpatTyVarMp _hdOpatValGam _hdOtvKiVarMp _hdOtySigGam _hdOtySigVarMp) of + { ( _hdIpatTyVarMp,_hdIpatValGam,hd_13) | True -> + (case (_hdIpatValGam) of + { _tlOpatValGam | _tlOpatValGam `seq` (True) -> + (case (_hdIpatTyVarMp) of + { _tlOpatTyVarMp | _tlOpatTyVarMp `seq` (True) -> + (case (tl_12 _tlOpatTyVarMp _tlOpatValGam _tlOtvKiVarMp _tlOtySigGam _tlOtySigVarMp) of + { ( _tlIpatTyVarMp,_tlIpatValGam,tl_13) | True -> + (case (_tlIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_tlIpatValGam) of + { _lhsOpatValGam | _lhsOpatValGam `seq` (True) -> + (case ((let sem_Decls_Cons_13 :: T_Decls_13 + sem_Decls_Cons_13 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _tlOvalGam | _tlOvalGam `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _hdOvalGam | _hdOvalGam `seq` (True) -> + (case (_lhsItyVarMp) of + { _hdOtyVarMp | _hdOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIclDfGam) of + { _hdOclDfGam | _hdOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _hdOchrStore | _hdOchrStore `seq` (True) -> + (case (hd_13 _hdOchrStore _hdOclDfGam _hdOtyTyGlobFreeTvarS _hdOtyVarMp _hdOvalGam _hdOvalTyGlobFreeTvarS) of + { ( _hdIgathCnstrMp,_hdIgathRangeMp,_hdIintlTyKiGam,_hdInoLetQuantTyVarIdS,_hdIscopeGam,_hdItyVarMp,hd_14) | True -> + (case (_hdItyVarMp) of + { _tlOtyVarMp | _tlOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIclDfGam) of + { _tlOclDfGam | _tlOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _tlOchrStore | _tlOchrStore `seq` (True) -> + (case (tl_13 _tlOchrStore _tlOclDfGam _tlOtyTyGlobFreeTvarS _tlOtyVarMp _tlOvalGam _tlOvalTyGlobFreeTvarS) of + { ( _tlIgathCnstrMp,_tlIgathRangeMp,_tlIintlTyKiGam,_tlInoLetQuantTyVarIdS,_tlIscopeGam,_tlItyVarMp,tl_14) | True -> + (case (_hdIgathCnstrMp `cnstrMpUnion` _tlIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_hdIgathRangeMp `Map.union` _tlIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_hdInoLetQuantTyVarIdS `Set.union` _tlInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_hdIscopeGam `gamUnion` _tlIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_tlItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_Decls_Cons_14 :: T_Decls_14 + sem_Decls_Cons_14 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsIisStrict + _lhsIkiSigGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsIisStrict `seq` + (_lhsIkiSigGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _tlOrangeMp | _tlOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _tlOfinValGam | _tlOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _hdOrangeMp | _hdOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _hdOfinValGam | _hdOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIkiSigGam) of + { _tlOkiSigGam | _tlOkiSigGam `seq` (True) -> + (case (_lhsIisStrict) of + { _tlOisStrict | _tlOisStrict `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _tlOchrScopeBindMp | _tlOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _tlOchrEvidBindMp | _tlOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _hdOchrScopeBindMp | _hdOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _hdOchrEvidBindMp | _hdOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _hdOcSubst | _hdOcSubst `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIkiSigGam) of + { _hdOkiSigGam | _hdOkiSigGam `seq` (True) -> + (case (_lhsIisStrict) of + { _hdOisStrict | _hdOisStrict `seq` (True) -> + (case (hd_14 _hdOcSubst _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOfinTyVarMp _hdOfinValGam _hdOisStrict _hdOkiSigGam _hdOmoduleNm _hdOrangeMp _hdOsysfEnv) of + { ( _hdIallErrSq,_hdIbangEvalL,_hdIcSubst,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathHiddenExports,_hdIgathLamMp,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIorphanS,_hdIpp,_hdItyCBindL,_hdIvalCBindL) | True -> + (case (_hdIcSubst) of + { _tlOcSubst | _tlOcSubst `seq` (True) -> + (case (tl_14 _tlOcSubst _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOfinTyVarMp _tlOfinValGam _tlOisStrict _tlOkiSigGam _tlOmoduleNm _tlOrangeMp _tlOsysfEnv) of + { ( _tlIallErrSq,_tlIbangEvalL,_tlIcSubst,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathHiddenExports,_tlIgathLamMp,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIorphanS,_tlIpp,_tlItyCBindL,_tlIvalCBindL) | True -> + (case (Seq.unions [_hdIerrSq, _hdIallErrSq, _tlIallErrSq]) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIbangEvalL ++ _tlIbangEvalL) of + { _lhsObangEvalL | _lhsObangEvalL `seq` (True) -> + (case (_tlIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIffeCBindL ++ _tlIffeCBindL) of + { _lhsOffeCBindL | _lhsOffeCBindL `seq` (True) -> + (case (_hdIffiCBindL ++ _tlIffiCBindL) of + { _lhsOffiCBindL | _lhsOffiCBindL `seq` (True) -> + (case (_hdIgathHiddenExports `Seq.union` _tlIgathHiddenExports) of + { _lhsOgathHiddenExports | _lhsOgathHiddenExports `seq` (True) -> + (case (_hdIgathLamMp `lamMpUnionBindAspMp` _tlIgathLamMp) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIgathTvKiVarMp `varmpUnion` _tlIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_hdIorphanS `Set.union` _tlIorphanS) of + { _lhsOorphanS | _lhsOorphanS `seq` (True) -> + (case (ppErrsSq _hdIerrSq) of + { _errPP | _errPP `seq` (True) -> + (case (_hdIpp + >-< _errPP + >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdItyCBindL ++ _tlItyCBindL) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case (_hdIvalCBindL ++ _tlIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsObangEvalL,_lhsOcSubst,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathHiddenExports,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOorphanS,_lhsOpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_Decls_Cons_14)) of + { ( sem_Decls_14) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOintlTyKiGam,_lhsOnoLetQuantTyVarIdS,_lhsOscopeGam,_lhsOtyVarMp,sem_Decls_14) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_Decls_Cons_13)) of + { ( sem_Decls_13) | True -> + ( _lhsOpatTyVarMp,_lhsOpatValGam,sem_Decls_13) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_Decls_Cons_12)) of + { ( sem_Decls_12) | True -> + ( _lhsOchrClassDeclSq,_lhsOchrInstDeclSq,_lhsOgathClDfGam,sem_Decls_12) }) }) }) }) }) }) }) }))) + in sem_Decls_Cons_11)) of + { ( sem_Decls_11) | True -> + ( _lhsOgathDataGam,_lhsOgathDeclDataGam,_lhsOgathTySigGam,_lhsOgathTySigVarMp,sem_Decls_11) }) }) }) }) }) }) }) }) }) }) })))) + in sem_Decls_Cons_10)) of + { ( sem_Decls_10) | True -> + ( _lhsOpatClGam2,sem_Decls_10) }) }) }) }) }) }) }) }) }) }) }) })))))) + in sem_Decls_Cons_9)) of + { ( sem_Decls_9) | True -> + ( _lhsOpatClGam1,sem_Decls_9) }) }) }) }) }) }))) + in sem_Decls_Cons_8)) of + { ( sem_Decls_8) | True -> + ( _lhsOgenerDataInfoL,_lhsOkiVarMp,_lhsOpolVarMp,sem_Decls_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))) + in sem_Decls_Cons_7)) of + { ( sem_Decls_7) | True -> + ( _lhsOpatKiVarMp,_lhsOpatPolGam,sem_Decls_7) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_Decls_Cons_6)) of + { ( sem_Decls_6) | True -> + ( _lhsOpatTyKiGam,_lhsOtyTyVarMp,sem_Decls_6) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_Decls_Cons_5)) of + { ( sem_Decls_5) | True -> + ( _lhsOpatTyGam,sem_Decls_5) }) }) }) }) }) }) }) })))) + in sem_Decls_Cons_4)) of + { ( sem_Decls_4) | True -> + ( _lhsOpredSameScopeCounter,sem_Decls_4) }) }) }) }) }) }) }) })))) + in sem_Decls_Cons_3)) of + { ( sem_Decls_3) | True -> + ( _lhsOgathTyKiSigGam,sem_Decls_3) }) }) }) }) }) }))) + in sem_Decls_Cons_2)) of + { ( sem_Decls_2) | True -> + ( _lhsOgUniq,_lhsOgathKiSigGam,_lhsOhasInstDecl,sem_Decls_2) }) }) }) }) }) }) }) }) }) })))) + in sem_Decls_Cons_1)) of + { ( sem_Decls_1) | True -> + ( _lhsOrange,sem_Decls_1) }) }) }) }) + +sem_Decls_Nil :: T_Decls + +sem_Decls_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_Decls_Nil_1 :: T_Decls_1 + sem_Decls_Nil_1 = + (\ _lhsIgUniq + _lhsIgathKiSigGam -> + _lhsIgUniq `seq` + (_lhsIgathKiSigGam `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (_lhsIgathKiSigGam) of + { _lhsOgathKiSigGam | _lhsOgathKiSigGam `seq` (True) -> + (case (False) of + { _lhsOhasInstDecl | _lhsOhasInstDecl `seq` (True) -> + (case ((let sem_Decls_Nil_2 :: T_Decls_2 + sem_Decls_Nil_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (emptyGam) of + { _lhsOgathTyKiSigGam | _lhsOgathTyKiSigGam `seq` (True) -> + (case ((let sem_Decls_Nil_3 :: T_Decls_3 + sem_Decls_Nil_3 = + (\ _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_Decls_Nil_4 :: T_Decls_4 + sem_Decls_Nil_4 = + (\ _lhsIpatTyGam + _lhsItyKiSigGam -> + _lhsIpatTyGam `seq` + (_lhsItyKiSigGam `seq` + ((case (_lhsIpatTyGam) of + { _lhsOpatTyGam | _lhsOpatTyGam `seq` (True) -> + (case ((let sem_Decls_Nil_5 :: T_Decls_5 + sem_Decls_Nil_5 = + (\ _lhsIpatTyKiGam + _lhsItyGam + _lhsItyTyVarMp -> + _lhsIpatTyKiGam `seq` + (_lhsItyGam `seq` + (_lhsItyTyVarMp `seq` + ((case (_lhsIpatTyKiGam) of + { _lhsOpatTyKiGam | _lhsOpatTyKiGam `seq` (True) -> + (case (_lhsItyTyVarMp) of + { _lhsOtyTyVarMp | _lhsOtyTyVarMp `seq` (True) -> + (case ((let sem_Decls_Nil_6 :: T_Decls_6 + sem_Decls_Nil_6 = + (\ _lhsIpatKiVarMp + _lhsIpatPolGam + _lhsItyKiGam -> + _lhsIpatKiVarMp `seq` + (_lhsIpatPolGam `seq` + (_lhsItyKiGam `seq` + ((case (_lhsIpatKiVarMp) of + { _lhsOpatKiVarMp | _lhsOpatKiVarMp `seq` (True) -> + (case (_lhsIpatPolGam) of + { _lhsOpatPolGam | _lhsOpatPolGam `seq` (True) -> + (case ((let sem_Decls_Nil_7 :: T_Decls_7 + sem_Decls_Nil_7 = + (\ _lhsIkiVarMp + _lhsImbKnPolCtx + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsImbKnPolCtx `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case ([]) of + { _lhsOgenerDataInfoL | _lhsOgenerDataInfoL `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_Decls_Nil_8 :: T_Decls_8 + sem_Decls_Nil_8 = + (\ _lhsIpatClGam1 -> + _lhsIpatClGam1 `seq` + ((case (_lhsIpatClGam1) of + { _lhsOpatClGam1 | _lhsOpatClGam1 `seq` (True) -> + (case ((let sem_Decls_Nil_9 :: T_Decls_9 + sem_Decls_Nil_9 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIpatClGam2 + _lhsItyTyTySigFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIpatClGam2 `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsIpatClGam2) of + { _lhsOpatClGam2 | _lhsOpatClGam2 `seq` (True) -> + (case ((let sem_Decls_Nil_10 :: T_Decls_10 + sem_Decls_Nil_10 = + (\ _lhsIclGam + _lhsIgathDataGam -> + _lhsIclGam `seq` + (_lhsIgathDataGam `seq` + ((case (_lhsIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case (emptyGam) of + { _lhsOgathDeclDataGam | _lhsOgathDeclDataGam `seq` (True) -> + (case (emptyGam) of + { _lhsOgathTySigGam | _lhsOgathTySigGam `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTySigVarMp | _lhsOgathTySigVarMp `seq` (True) -> + (case ((let sem_Decls_Nil_11 :: T_Decls_11 + sem_Decls_Nil_11 = + (\ _lhsIdataGam -> + _lhsIdataGam `seq` + ((case (Seq.empty) of + { _lhsOchrClassDeclSq | _lhsOchrClassDeclSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (emptyGam) of + { _lhsOgathClDfGam | _lhsOgathClDfGam `seq` (True) -> + (case ((let sem_Decls_Nil_12 :: T_Decls_12 + sem_Decls_Nil_12 = + (\ _lhsIpatTyVarMp + _lhsIpatValGam + _lhsItvKiVarMp + _lhsItySigGam + _lhsItySigVarMp -> + _lhsIpatTyVarMp `seq` + (_lhsIpatValGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItySigGam `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIpatValGam) of + { _lhsOpatValGam | _lhsOpatValGam `seq` (True) -> + (case ((let sem_Decls_Nil_13 :: T_Decls_13 + sem_Decls_Nil_13 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (Set.empty) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_Decls_Nil_14 :: T_Decls_14 + sem_Decls_Nil_14 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsIisStrict + _lhsIkiSigGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsIisStrict `seq` + (_lhsIkiSigGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsObangEvalL | _lhsObangEvalL `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOffeCBindL | _lhsOffeCBindL `seq` (True) -> + (case ([]) of + { _lhsOffiCBindL | _lhsOffiCBindL `seq` (True) -> + (case (Seq.empty) of + { _lhsOgathHiddenExports | _lhsOgathHiddenExports `seq` (True) -> + (case (Map.empty) of + { _lhsOgathLamMp | _lhsOgathLamMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (Set.empty) of + { _lhsOorphanS | _lhsOorphanS `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsObangEvalL,_lhsOcSubst,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathHiddenExports,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOorphanS,_lhsOpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_Decls_Nil_14)) of + { ( sem_Decls_14) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOintlTyKiGam,_lhsOnoLetQuantTyVarIdS,_lhsOscopeGam,_lhsOtyVarMp,sem_Decls_14) }) }) }) }) }) }) })))))))) + in sem_Decls_Nil_13)) of + { ( sem_Decls_13) | True -> + ( _lhsOpatTyVarMp,_lhsOpatValGam,sem_Decls_13) }) }) }))))))) + in sem_Decls_Nil_12)) of + { ( sem_Decls_12) | True -> + ( _lhsOchrClassDeclSq,_lhsOchrInstDeclSq,_lhsOgathClDfGam,sem_Decls_12) }) }) }) }))) + in sem_Decls_Nil_11)) of + { ( sem_Decls_11) | True -> + ( _lhsOgathDataGam,_lhsOgathDeclDataGam,_lhsOgathTySigGam,_lhsOgathTySigVarMp,sem_Decls_11) }) }) }) }) })))) + in sem_Decls_Nil_10)) of + { ( sem_Decls_10) | True -> + ( _lhsOpatClGam2,sem_Decls_10) }) })))))) + in sem_Decls_Nil_9)) of + { ( sem_Decls_9) | True -> + ( _lhsOpatClGam1,sem_Decls_9) }) }))) + in sem_Decls_Nil_8)) of + { ( sem_Decls_8) | True -> + ( _lhsOgenerDataInfoL,_lhsOkiVarMp,_lhsOpolVarMp,sem_Decls_8) }) }) }) }))))))))) + in sem_Decls_Nil_7)) of + { ( sem_Decls_7) | True -> + ( _lhsOpatKiVarMp,_lhsOpatPolGam,sem_Decls_7) }) }) }))))) + in sem_Decls_Nil_6)) of + { ( sem_Decls_6) | True -> + ( _lhsOpatTyKiGam,_lhsOtyTyVarMp,sem_Decls_6) }) }) }))))) + in sem_Decls_Nil_5)) of + { ( sem_Decls_5) | True -> + ( _lhsOpatTyGam,sem_Decls_5) }) })))) + in sem_Decls_Nil_4)) of + { ( sem_Decls_4) | True -> + ( _lhsOpredSameScopeCounter,sem_Decls_4) }) })))) + in sem_Decls_Nil_3)) of + { ( sem_Decls_3) | True -> + ( _lhsOgathTyKiSigGam,sem_Decls_3) }) }))) + in sem_Decls_Nil_2)) of + { ( sem_Decls_2) | True -> + ( _lhsOgUniq,_lhsOgathKiSigGam,_lhsOhasInstDecl,sem_Decls_2) }) }) }) })))) + in sem_Decls_Nil_1)) of + { ( sem_Decls_1) | True -> + ( _lhsOrange,sem_Decls_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_Expr.hs b/src/UHC/Light/Compiler/EH/MainAG_Expr.hs new file mode 100644 # file too large to diff: src/UHC/Light/Compiler/EH/MainAG_Expr.hs diff --git a/src/UHC/Light/Compiler/EH/MainAG_ExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_ExprAnn.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_ExprAnn.hs @@ -0,0 +1,101 @@ + + + +module UHC.Light.Compiler.EH.MainAG_ExprAnn where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- ExprAnn ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Empty: + visit 0: + local pp : _ +-} +sem_ExprAnn_Empty :: T_ExprAnn + +sem_ExprAnn_Empty = + (case (empty) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOpp) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs b/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs @@ -0,0 +1,265 @@ + + + +module UHC.Light.Compiler.EH.MainAG_FuncDep where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- FuncDep ----------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + chained attribute: + tyGam : TyGam + visit 2: + chained attribute: + tyKiGam : TyKiGam + visit 3: + inherited attributes: + clsTyArgs : TyL + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + funcDeps : [ClsFuncDep] + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + range : Range + alternatives: + alternative Dep: + child hsrange : {Range} + child fromTvs : TyVars + child toTvs : TyVars + visit 3: + local range : {Range} +-} +sem_FuncDep_Dep :: Range -> + T_TyVars -> + T_TyVars -> + T_FuncDep + +sem_FuncDep_Dep hsrange_ fromTvs_ toTvs_ | hsrange_ `seq` (fromTvs_ `seq` (toTvs_ `seq` (True))) = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _fromTvsOgUniq | _fromTvsOgUniq `seq` (True) -> + (case (fromTvs_) of + { ( _fromTvsIrange,fromTvs_1) | True -> + (case (fromTvs_1 _fromTvsOgUniq) of + { ( _fromTvsIgUniq,fromTvs_2) | True -> + (case (_fromTvsIgUniq) of + { _toTvsOgUniq | _toTvsOgUniq `seq` (True) -> + (case (toTvs_) of + { ( _toTvsIrange,toTvs_1) | True -> + (case (toTvs_1 _toTvsOgUniq) of + { ( _toTvsIgUniq,toTvs_2) | True -> + (case (_toTvsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_FuncDep_Dep_1 :: T_FuncDep_1 + sem_FuncDep_Dep_1 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _fromTvsOtyGam | _fromTvsOtyGam `seq` (True) -> + (case (fromTvs_2 _fromTvsOtyGam) of + { ( _fromTvsItyGam,fromTvs_3) | True -> + (case (_fromTvsItyGam) of + { _toTvsOtyGam | _toTvsOtyGam `seq` (True) -> + (case (toTvs_2 _toTvsOtyGam) of + { ( _toTvsItyGam,toTvs_3) | True -> + (case (_toTvsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_FuncDep_Dep_2 :: T_FuncDep_2 + sem_FuncDep_Dep_2 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _fromTvsOtyKiGam | _fromTvsOtyKiGam `seq` (True) -> + (case (fromTvs_3 _fromTvsOtyKiGam) of + { ( _fromTvsIgathTyVarPolGam,_fromTvsIintlTyKiGam,_fromTvsIkiL,_fromTvsIpolVarL,_fromTvsItyKiGam,_fromTvsItyL,fromTvs_4) | True -> + (case (_fromTvsItyKiGam) of + { _toTvsOtyKiGam | _toTvsOtyKiGam `seq` (True) -> + (case (toTvs_3 _toTvsOtyKiGam) of + { ( _toTvsIgathTyVarPolGam,_toTvsIintlTyKiGam,_toTvsIkiL,_toTvsIpolVarL,_toTvsItyKiGam,_toTvsItyL,toTvs_4) | True -> + (case (_toTvsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_FuncDep_Dep_3 :: T_FuncDep_3 + sem_FuncDep_Dep_3 = + (\ _lhsIclsTyArgs + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclsTyArgs `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _toTvsOvalTyGlobFreeTvarS | _toTvsOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _toTvsOtyTyTySigFreeTvarS | _toTvsOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _toTvsOtyTyGlobFreeTvarS | _toTvsOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _toTvsOtyKiGlobFreeTvarS | _toTvsOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _toTvsOsysfEnv | _toTvsOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _toTvsOopts | _toTvsOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _toTvsOmoduleNm | _toTvsOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _toTvsOfinTyVarMp | _toTvsOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _toTvsOfinTyKiGam | _toTvsOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _toTvsOfinKiVarMp | _toTvsOfinKiVarMp `seq` (True) -> + (case (toTvs_4 _toTvsOfinKiVarMp _toTvsOfinTyKiGam _toTvsOfinTyVarMp _toTvsOmoduleNm _toTvsOopts _toTvsOsysfEnv _toTvsOtyKiGlobFreeTvarS _toTvsOtyTyGlobFreeTvarS _toTvsOtyTyTySigFreeTvarS _toTvsOvalTyGlobFreeTvarS) of + { ( _toTvsIallErrSq,_toTvsIerrSq,_toTvsIgathMentrelFilterMp,_toTvsInmL,_toTvsIpp,_toTvsIppL) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _fromTvsOvalTyGlobFreeTvarS | _fromTvsOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _fromTvsOtyTyTySigFreeTvarS | _fromTvsOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _fromTvsOtyTyGlobFreeTvarS | _fromTvsOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _fromTvsOtyKiGlobFreeTvarS | _fromTvsOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _fromTvsOsysfEnv | _fromTvsOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _fromTvsOopts | _fromTvsOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _fromTvsOmoduleNm | _fromTvsOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _fromTvsOfinTyVarMp | _fromTvsOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _fromTvsOfinTyKiGam | _fromTvsOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _fromTvsOfinKiVarMp | _fromTvsOfinKiVarMp `seq` (True) -> + (case (fromTvs_4 _fromTvsOfinKiVarMp _fromTvsOfinTyKiGam _fromTvsOfinTyVarMp _fromTvsOmoduleNm _fromTvsOopts _fromTvsOsysfEnv _fromTvsOtyKiGlobFreeTvarS _fromTvsOtyTyGlobFreeTvarS _fromTvsOtyTyTySigFreeTvarS _fromTvsOvalTyGlobFreeTvarS) of + { ( _fromTvsIallErrSq,_fromTvsIerrSq,_fromTvsIgathMentrelFilterMp,_fromTvsInmL,_fromTvsIpp,_fromTvsIppL) | True -> + (case (_fromTvsIallErrSq `Seq.union` _toTvsIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_fromTvsIerrSq `Seq.union` _toTvsIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (let l v = maybe (-1) id . elemIndex v $ _lhsIclsTyArgs + in [ClsFuncDep (map l _fromTvsItyL) (map l _toTvsItyL)]) of + { _lhsOfuncDeps | _lhsOfuncDeps `seq` (True) -> + (case (_fromTvsIgathMentrelFilterMp `mentrelFilterMpUnion` _toTvsIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_fromTvsIpp >#< "->" >#< _toTvsIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (rangeUnions [hsrange_, _fromTvsIrange, _toTvsIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOrange) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_FuncDep_Dep_3)) of + { ( sem_FuncDep_3) | True -> + ( _lhsOtyKiGam,sem_FuncDep_3) }) }) }) }) }) }))) + in sem_FuncDep_Dep_2)) of + { ( sem_FuncDep_2) | True -> + ( _lhsOtyGam,sem_FuncDep_2) }) }) }) }) }) }))) + in sem_FuncDep_Dep_1)) of + { ( sem_FuncDep_1) | True -> + ( _lhsOgUniq,sem_FuncDep_1) }) }) }) }) }) }) }) }))) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs b/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs @@ -0,0 +1,330 @@ + + + +module UHC.Light.Compiler.EH.MainAG_FuncDeps where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- FuncDeps ---------------------------------------------------- +{- + visit 0: + chained attribute: + gUniq : UID + visit 1: + chained attribute: + tyGam : TyGam + visit 2: + chained attribute: + tyKiGam : TyKiGam + visit 3: + inherited attributes: + clsTyArgs : TyL + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + funcDeps : [ClsFuncDep] + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + ppL : [PP_Doc] + range : Range + alternatives: + alternative Cons: + child hd : FuncDep + child tl : FuncDeps + alternative Nil: +-} +sem_FuncDeps_Cons :: T_FuncDep -> + T_FuncDeps -> + T_FuncDeps + +sem_FuncDeps_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_ _hdOgUniq) of + { ( _hdIgUniq,hd_1) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_ _tlOgUniq) of + { ( _tlIgUniq,tl_1) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_FuncDeps_Cons_1 :: T_FuncDeps_1 + sem_FuncDeps_Cons_1 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (hd_1 _hdOtyGam) of + { ( _hdItyGam,hd_2) | True -> + (case (_hdItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (tl_1 _tlOtyGam) of + { ( _tlItyGam,tl_2) | True -> + (case (_tlItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_FuncDeps_Cons_2 :: T_FuncDeps_2 + sem_FuncDeps_Cons_2 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (hd_2 _hdOtyKiGam) of + { ( _hdItyKiGam,hd_3) | True -> + (case (_hdItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (tl_2 _tlOtyKiGam) of + { ( _tlItyKiGam,tl_3) | True -> + (case (_tlItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_FuncDeps_Cons_3 :: T_FuncDeps_3 + sem_FuncDeps_Cons_3 = + (\ _lhsIclsTyArgs + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclsTyArgs `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIclsTyArgs) of + { _tlOclsTyArgs | _tlOclsTyArgs `seq` (True) -> + (case (tl_3 _tlOclsTyArgs _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIerrSq,_tlIfuncDeps,_tlIgathMentrelFilterMp,_tlIpp,_tlIppL,_tlIrange) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (_lhsIclsTyArgs) of + { _hdOclsTyArgs | _hdOclsTyArgs `seq` (True) -> + (case (hd_3 _hdOclsTyArgs _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIerrSq,_hdIfuncDeps,_hdIgathMentrelFilterMp,_hdIpp,_hdIrange) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIfuncDeps ++ _tlIfuncDeps) of + { _lhsOfuncDeps | _lhsOfuncDeps `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOrange) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_FuncDeps_Cons_3)) of + { ( sem_FuncDeps_3) | True -> + ( _lhsOtyKiGam,sem_FuncDeps_3) }) }) }) }) }) }))) + in sem_FuncDeps_Cons_2)) of + { ( sem_FuncDeps_2) | True -> + ( _lhsOtyGam,sem_FuncDeps_2) }) }) }) }) }) }))) + in sem_FuncDeps_Cons_1)) of + { ( sem_FuncDeps_1) | True -> + ( _lhsOgUniq,sem_FuncDeps_1) }) }) }) }) }) }))) + +sem_FuncDeps_Nil :: T_FuncDeps + +sem_FuncDeps_Nil = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_FuncDeps_Nil_1 :: T_FuncDeps_1 + sem_FuncDeps_Nil_1 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_FuncDeps_Nil_2 :: T_FuncDeps_2 + sem_FuncDeps_Nil_2 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_FuncDeps_Nil_3 :: T_FuncDeps_3 + sem_FuncDeps_Nil_3 = + (\ _lhsIclsTyArgs + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclsTyArgs `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfuncDeps | _lhsOfuncDeps `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOrange) }) }) }) }) }) }) }))))))))))))) + in sem_FuncDeps_Nil_3)) of + { ( sem_FuncDeps_3) | True -> + ( _lhsOtyKiGam,sem_FuncDeps_3) }) }))) + in sem_FuncDeps_Nil_2)) of + { ( sem_FuncDeps_2) | True -> + ( _lhsOtyGam,sem_FuncDeps_2) }) }))) + in sem_FuncDeps_Nil_1)) of + { ( sem_FuncDeps_1) | True -> + ( _lhsOgUniq,sem_FuncDeps_1) }) }))) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs @@ -0,0 +1,792 @@ + + + +module UHC.Light.Compiler.EH.MainAG_KiExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- KiExpr ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + kiGam : KiGam + synthesized attribute: + ki : Ty + visit 3: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + appArgPPL : [PP_Doc] + appFunNm : HsName + appFunPP : PP_Doc + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + alternatives: + alternative Con: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + intra range : {Range} + visit 2: + local _tup166 : _ + local kgi : {KiGamInfo} + intra range : {Range} + visit 3: + local pp : _ + local nmErrs : {ErrL} + intra _tup166 : _ + intra range : {Range} + alternative Var: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup168 : _ + visit 2: + local lUniq : {UID} + local _tup167 : _ + local kgi : {KiGamInfo} + intra _tup168 : _ + visit 3: + local pp : _ + alternative App: + child hsrange : {Range} + child func : KiExpr + child arg : KiExpr + visit 0: + local range : {Range} + visit 3: + local pp : _ + alternative AppTop: + child hsrange : {Range} + child kiExpr : KiExpr + visit 0: + local range : {Range} + visit 3: + local pp : _ + alternative Parens: + child hsrange : {Range} + child kiExpr : KiExpr + visit 0: + local range : {Range} + visit 3: + local pp : _ + alternative Ann: + child hsrange : {Range} + child ann : KiExprAnn + child kiExpr : KiExpr + visit 0: + local range : {Range} + visit 3: + local pp : _ +-} +sem_KiExpr_Con :: Range -> + HsName -> + T_KiExpr + +sem_KiExpr_Con hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_Con_1 :: T_KiExpr_1 + sem_KiExpr_Con_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_Con_2 :: T_KiExpr_2 + sem_KiExpr_Con_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (case gamLookup nm_ _lhsIkiGam of + Nothing -> (KiGamInfo Ty_Any,[rngLift _range mkErr_NamesNotIntrod "kind" [nm_]]) + Just kgi -> (kgi,[])) of + { __tup166 | __tup166 `seq` (True) -> + (case (__tup166) of + { (_kgi,_) | _kgi `seq` (True) -> + (case (kgiKi _kgi) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiGam) of + { _lhsOkiGam | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_Con_3 :: T_KiExpr_3 + sem_KiExpr_Con_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (nm_) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (__tup166) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [Seq.fromList _nmErrs]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_Con_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) + in sem_KiExpr_Con_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }))) + in sem_KiExpr_Con_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) + +sem_KiExpr_Var :: Range -> + HsName -> + T_KiExpr + +sem_KiExpr_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_Var_1 :: T_KiExpr_1 + sem_KiExpr_Var_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup168 | __tup168 `seq` (True) -> + (case (__tup168) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_Var_2 :: T_KiExpr_2 + sem_KiExpr_Var_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (__tup168) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (case gamLookup nm_ _lhsIkiGam of + Nothing -> let t = mkNewTyVar _lUniq + kgi = KiGamInfo t + in (kgi,gamAdd nm_ kgi _lhsIkiGam) + Just kgi -> (kgi,_lhsIkiGam)) of + { __tup167 | __tup167 `seq` (True) -> + (case (__tup167) of + { (_kgi,_) | _kgi `seq` (True) -> + (case (kgiKi _kgi) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (__tup167) of + { (_,_lhsOkiGam) | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_Var_3 :: T_KiExpr_3 + sem_KiExpr_Var_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_Var_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }) }))) + in sem_KiExpr_Var_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }) }))) + in sem_KiExpr_Var_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) + +sem_KiExpr_App :: Range -> + T_KiExpr -> + T_KiExpr -> + T_KiExpr + +sem_KiExpr_App hsrange_ func_ arg_ | hsrange_ `seq` (func_ `seq` (arg_ `seq` (True))) = + (case (arg_) of + { ( _argIrange,arg_1) | True -> + (case (func_) of + { ( _funcIrange,func_1) | True -> + (case (rangeUnions [hsrange_, _funcIrange , _argIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_App_1 :: T_KiExpr_1 + sem_KiExpr_App_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _funcOgUniq | _funcOgUniq `seq` (True) -> + (case (func_1 _funcOgUniq) of + { ( _funcIgUniq,func_2) | True -> + (case (_funcIgUniq) of + { _argOgUniq | _argOgUniq `seq` (True) -> + (case (arg_1 _argOgUniq) of + { ( _argIgUniq,arg_2) | True -> + (case (_argIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_App_2 :: T_KiExpr_2 + sem_KiExpr_App_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (_lhsIkiGam) of + { _funcOkiGam | _funcOkiGam `seq` (True) -> + (case (func_2 _funcOkiGam) of + { ( _funcIki,_funcIkiGam,func_3) | True -> + (case (_funcIkiGam) of + { _argOkiGam | _argOkiGam `seq` (True) -> + (case (arg_2 _argOkiGam) of + { ( _argIki,_argIkiGam,arg_3) | True -> + (case (Ty_App _funcIki _argIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_argIkiGam) of + { _lhsOkiGam | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_App_3 :: T_KiExpr_3 + sem_KiExpr_App_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _argOvalTyGlobFreeTvarS | _argOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _argOtyTyTySigFreeTvarS | _argOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _argOtyTyGlobFreeTvarS | _argOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _argOtyKiGlobFreeTvarS | _argOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _argOsysfEnv | _argOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _argOmoduleNm | _argOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _argOfinTyVarMp | _argOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _argOfinTyKiGam | _argOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> + (case (arg_3 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOmoduleNm _argOopts _argOsysfEnv _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIerrSq,_argIgathMentrelFilterMp,_argIpp) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _funcOvalTyGlobFreeTvarS | _funcOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _funcOtyTyTySigFreeTvarS | _funcOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _funcOtyTyGlobFreeTvarS | _funcOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _funcOtyKiGlobFreeTvarS | _funcOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _funcOsysfEnv | _funcOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm | _funcOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _funcOfinTyVarMp | _funcOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _funcOfinTyKiGam | _funcOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _funcOfinKiVarMp | _funcOfinKiVarMp `seq` (True) -> + (case (func_3 _funcOfinKiVarMp _funcOfinTyKiGam _funcOfinTyVarMp _funcOmoduleNm _funcOopts _funcOsysfEnv _funcOtyKiGlobFreeTvarS _funcOtyTyGlobFreeTvarS _funcOtyTyTySigFreeTvarS _funcOvalTyGlobFreeTvarS) of + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp) | True -> + (case (_funcIallErrSq `Seq.union` _argIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_funcIappArgPPL ++ [_argIpp]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (_funcIappFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_funcIappFunPP) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_funcIerrSq `Seq.union` _argIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_funcIgathMentrelFilterMp `mentrelFilterMpUnion` _argIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_funcIpp >#< _argIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_App_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }) }) }))) + in sem_KiExpr_App_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }) }) }) }) }))) + in sem_KiExpr_App_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) }) }) + +sem_KiExpr_AppTop :: Range -> + T_KiExpr -> + T_KiExpr + +sem_KiExpr_AppTop hsrange_ kiExpr_ | hsrange_ `seq` (kiExpr_ `seq` (True)) = + (case (kiExpr_) of + { ( _kiExprIrange,kiExpr_1) | True -> + (case (rangeUnions [hsrange_, _kiExprIrange , _kiExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_AppTop_1 :: T_KiExpr_1 + sem_KiExpr_AppTop_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _kiExprOgUniq | _kiExprOgUniq `seq` (True) -> + (case (kiExpr_1 _kiExprOgUniq) of + { ( _kiExprIgUniq,kiExpr_2) | True -> + (case (_kiExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_AppTop_2 :: T_KiExpr_2 + sem_KiExpr_AppTop_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (_lhsIkiGam) of + { _kiExprOkiGam | _kiExprOkiGam `seq` (True) -> + (case (kiExpr_2 _kiExprOkiGam) of + { ( _kiExprIki,_kiExprIkiGam,kiExpr_3) | True -> + (case (_kiExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_kiExprIkiGam) of + { _lhsOkiGam | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_AppTop_3 :: T_KiExpr_3 + sem_KiExpr_AppTop_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _kiExprOvalTyGlobFreeTvarS | _kiExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _kiExprOtyTyTySigFreeTvarS | _kiExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _kiExprOtyTyGlobFreeTvarS | _kiExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _kiExprOtyKiGlobFreeTvarS | _kiExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _kiExprOsysfEnv | _kiExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _kiExprOopts | _kiExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _kiExprOmoduleNm | _kiExprOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _kiExprOfinTyVarMp | _kiExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _kiExprOfinTyKiGam | _kiExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> + (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp) | True -> + (case (_kiExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppAppTop (_kiExprIappFunNm,_kiExprIappFunPP) + _kiExprIappArgPPL _kiExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_kiExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_kiExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_AppTop_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) + in sem_KiExpr_AppTop_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }) }) }))) + in sem_KiExpr_AppTop_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) }) + +sem_KiExpr_Parens :: Range -> + T_KiExpr -> + T_KiExpr + +sem_KiExpr_Parens hsrange_ kiExpr_ | hsrange_ `seq` (kiExpr_ `seq` (True)) = + (case (kiExpr_) of + { ( _kiExprIrange,kiExpr_1) | True -> + (case (rangeUnions [hsrange_, _kiExprIrange , _kiExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_Parens_1 :: T_KiExpr_1 + sem_KiExpr_Parens_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _kiExprOgUniq | _kiExprOgUniq `seq` (True) -> + (case (kiExpr_1 _kiExprOgUniq) of + { ( _kiExprIgUniq,kiExpr_2) | True -> + (case (_kiExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_Parens_2 :: T_KiExpr_2 + sem_KiExpr_Parens_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (_lhsIkiGam) of + { _kiExprOkiGam | _kiExprOkiGam `seq` (True) -> + (case (kiExpr_2 _kiExprOkiGam) of + { ( _kiExprIki,_kiExprIkiGam,kiExpr_3) | True -> + (case (_kiExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_kiExprIkiGam) of + { _lhsOkiGam | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_Parens_3 :: T_KiExpr_3 + sem_KiExpr_Parens_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _kiExprOvalTyGlobFreeTvarS | _kiExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _kiExprOtyTyTySigFreeTvarS | _kiExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _kiExprOtyTyGlobFreeTvarS | _kiExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _kiExprOtyKiGlobFreeTvarS | _kiExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _kiExprOsysfEnv | _kiExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _kiExprOopts | _kiExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _kiExprOmoduleNm | _kiExprOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _kiExprOfinTyVarMp | _kiExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _kiExprOfinTyKiGam | _kiExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> + (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp) | True -> + (case (_kiExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppParens _kiExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_kiExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_kiExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_Parens_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) + in sem_KiExpr_Parens_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }) }) }))) + in sem_KiExpr_Parens_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) }) + +sem_KiExpr_Ann :: Range -> + T_KiExprAnn -> + T_KiExpr -> + T_KiExpr + +sem_KiExpr_Ann hsrange_ ann_ kiExpr_ | hsrange_ `seq` (ann_ `seq` (kiExpr_ `seq` (True))) = + (case (kiExpr_) of + { ( _kiExprIrange,kiExpr_1) | True -> + (case (rangeUnions [hsrange_, _kiExprIrange , _kiExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_KiExpr_Ann_1 :: T_KiExpr_1 + sem_KiExpr_Ann_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _kiExprOgUniq | _kiExprOgUniq `seq` (True) -> + (case (kiExpr_1 _kiExprOgUniq) of + { ( _kiExprIgUniq,kiExpr_2) | True -> + (case (_kiExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_KiExpr_Ann_2 :: T_KiExpr_2 + sem_KiExpr_Ann_2 = + (\ _lhsIkiGam -> + _lhsIkiGam `seq` + ((case (_lhsIkiGam) of + { _kiExprOkiGam | _kiExprOkiGam `seq` (True) -> + (case (kiExpr_2 _kiExprOkiGam) of + { ( _kiExprIki,_kiExprIkiGam,kiExpr_3) | True -> + (case (_kiExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_kiExprIkiGam) of + { _lhsOkiGam | _lhsOkiGam `seq` (True) -> + (case ((let sem_KiExpr_Ann_3 :: T_KiExpr_3 + sem_KiExpr_Ann_3 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _kiExprOvalTyGlobFreeTvarS | _kiExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _kiExprOtyTyTySigFreeTvarS | _kiExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _kiExprOtyTyGlobFreeTvarS | _kiExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _kiExprOtyKiGlobFreeTvarS | _kiExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _kiExprOsysfEnv | _kiExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _kiExprOopts | _kiExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _kiExprOmoduleNm | _kiExprOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _kiExprOfinTyVarMp | _kiExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _kiExprOfinTyKiGam | _kiExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> + (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp) | True -> + (case (_kiExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_kiExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_kiExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_kiExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_KiExpr_Ann_3)) of + { ( sem_KiExpr_3) | True -> + ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) + in sem_KiExpr_Ann_2)) of + { ( sem_KiExpr_2) | True -> + ( _lhsOgUniq,sem_KiExpr_2) }) }) }) }))) + in sem_KiExpr_Ann_1)) of + { ( sem_KiExpr_1) | True -> + ( _lhsOrange,sem_KiExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs @@ -0,0 +1,101 @@ + + + +module UHC.Light.Compiler.EH.MainAG_KiExprAnn where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- KiExprAnn --------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Empty: + visit 0: + local pp : _ +-} +sem_KiExprAnn_Empty :: T_KiExprAnn + +sem_KiExprAnn_Empty = + (case (empty) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOpp) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs @@ -0,0 +1,383 @@ + + + +module UHC.Light.Compiler.EH.MainAG_MbTyExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- MbTyExpr ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + knPolCtx : Polarity + polGam : PolGam + tyGam : TyGam + chained attribute: + polVarMp : VarMp + synthesized attribute: + tyMb : Maybe Ty + visit 3: + inherited attribute: + tyKiGam : TyKiGam + chained attribute: + kiVarMp : VarMp + synthesized attribute: + intlTyKiGam : TyKiGam + visit 4: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + ppMb : Maybe PP_Doc + tyGam : TyGam + tyKiGam : TyKiGam + tyVarWildMp : TyVarWildMp + alternatives: + alternative Just: + child just : TyExpr + alternative Nothing: +-} +sem_MbTyExpr_Just :: T_TyExpr -> + T_MbTyExpr + +sem_MbTyExpr_Just just_ | just_ `seq` (True) = + (case (just_) of + { ( _justIrange,just_1) | True -> + (case (_justIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_MbTyExpr_Just_1 :: T_MbTyExpr_1 + sem_MbTyExpr_Just_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _justOgUniq | _justOgUniq `seq` (True) -> + (case (just_1 _justOgUniq) of + { ( _justIgUniq,just_2) | True -> + (case (_justIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_MbTyExpr_Just_2 :: T_MbTyExpr_2 + sem_MbTyExpr_Just_2 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (_lhsItyGam) of + { _justOtyGam | _justOtyGam `seq` (True) -> + (case (_lhsIpolVarMp) of + { _justOpolVarMp | _justOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _justOpolGam | _justOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _justOknPolCtx | _justOknPolCtx `seq` (True) -> + (case (just_2 _justOtyGam) of + { ( _justIty,_justItyGam,just_3) | True -> + (case (just_3 _justOknPolCtx) of + { ( _justIpolVarL,just_4) | True -> + (case (just_4 _justOpolGam _justOpolVarMp) of + { ( _justImbStrictness,_justIpolVarMp,just_5) | True -> + (case (_justIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (Just _justIty) of + { _lhsOtyMb | _lhsOtyMb `seq` (True) -> + (case ((let sem_MbTyExpr_Just_3 :: T_MbTyExpr_3 + sem_MbTyExpr_Just_3 = + (\ _lhsIkiVarMp + _lhsItyKiGam -> + _lhsIkiVarMp `seq` + (_lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _justOtyKiGam | _justOtyKiGam `seq` (True) -> + (case (just_5 _justOtyKiGam) of + { ( _justIintlTyKiGam,_justItyKiGam,just_6) | True -> + (case (_justIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _justOkiVarMp | _justOkiVarMp `seq` (True) -> + (case (just_6 _justOkiVarMp) of + { ( _justIgathTyVarPolGam,_justIki,_justIkiVarMp,_justIpol,_justItyVarWildMp,just_7) | True -> + (case (_justIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_MbTyExpr_Just_4 :: T_MbTyExpr_4 + sem_MbTyExpr_Just_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIclGam) of + { _justOclGam | _justOclGam `seq` (True) -> + (case (just_7 _justOclGam) of + { ( _justIevTy,just_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _justOvalTyGlobFreeTvarS | _justOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _justOtyTyTySigFreeTvarS | _justOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _justOtyTyGlobFreeTvarS | _justOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _justOtyKiGlobFreeTvarS | _justOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _justOsysfEnv | _justOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _justOopts | _justOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _justOmoduleNm | _justOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _justOkiGam | _justOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _justOfinTyVarMp | _justOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _justOfinTyKiGam | _justOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _justOfinKiVarMp | _justOfinKiVarMp `seq` (True) -> + (case (just_8 _justOfinKiVarMp _justOfinTyKiGam _justOfinTyVarMp _justOkiGam _justOmoduleNm _justOopts _justOsysfEnv _justOtyKiGlobFreeTvarS _justOtyTyGlobFreeTvarS _justOtyTyTySigFreeTvarS _justOvalTyGlobFreeTvarS) of + { ( _justIallErrSq,_justIappArgPPL,_justIappFunNm,_justIappFunPP,_justIclMissNmS,_justIclNmS,_justIerrSq,_justIgathMentrelFilterMp,_justIpp,_justItyWildL) | True -> + (case (_justIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_justIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_justIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_justIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_justIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_justIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (Just _justIpp) of + { _lhsOppMb | _lhsOppMb `seq` (True) -> + (case (_justItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_justItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case (_justItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppMb,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + in sem_MbTyExpr_Just_4)) of + { ( sem_MbTyExpr_4) | True -> + ( _lhsOintlTyKiGam,_lhsOkiVarMp,sem_MbTyExpr_4) }) }) }) }) }) }) })))) + in sem_MbTyExpr_Just_3)) of + { ( sem_MbTyExpr_3) | True -> + ( _lhsOpolVarMp,_lhsOtyMb,sem_MbTyExpr_3) }) }) }) }) }) }) }) }) }) })))))) + in sem_MbTyExpr_Just_2)) of + { ( sem_MbTyExpr_2) | True -> + ( _lhsOgUniq,sem_MbTyExpr_2) }) }) }) }))) + in sem_MbTyExpr_Just_1)) of + { ( sem_MbTyExpr_1) | True -> + ( _lhsOrange,sem_MbTyExpr_1) }) }) }) + +sem_MbTyExpr_Nothing :: T_MbTyExpr + +sem_MbTyExpr_Nothing = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_MbTyExpr_Nothing_1 :: T_MbTyExpr_1 + sem_MbTyExpr_Nothing_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_MbTyExpr_Nothing_2 :: T_MbTyExpr_2 + sem_MbTyExpr_Nothing_2 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp + _lhsItyGam -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsItyGam `seq` + ((case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (Nothing) of + { _lhsOtyMb | _lhsOtyMb `seq` (True) -> + (case ((let sem_MbTyExpr_Nothing_3 :: T_MbTyExpr_3 + sem_MbTyExpr_Nothing_3 = + (\ _lhsIkiVarMp + _lhsItyKiGam -> + _lhsIkiVarMp `seq` + (_lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ((let sem_MbTyExpr_Nothing_4 :: T_MbTyExpr_4 + sem_MbTyExpr_Nothing_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (Nothing) of + { _lhsOppMb | _lhsOppMb `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppMb,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) })))))))))))))) + in sem_MbTyExpr_Nothing_4)) of + { ( sem_MbTyExpr_4) | True -> + ( _lhsOintlTyKiGam,_lhsOkiVarMp,sem_MbTyExpr_4) }) }) })))) + in sem_MbTyExpr_Nothing_3)) of + { ( sem_MbTyExpr_3) | True -> + ( _lhsOpolVarMp,_lhsOtyMb,sem_MbTyExpr_3) }) }) })))))) + in sem_MbTyExpr_Nothing_2)) of + { ( sem_MbTyExpr_2) | True -> + ( _lhsOgUniq,sem_MbTyExpr_2) }) }))) + in sem_MbTyExpr_Nothing_1)) of + { ( sem_MbTyExpr_1) | True -> + ( _lhsOrange,sem_MbTyExpr_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs @@ -0,0 +1,5938 @@ + + + +module UHC.Light.Compiler.EH.MainAG_PatExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- PatExpr ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + tyGam : TyGam + tyKiGam : TyKiGam + visit 4: + inherited attributes: + clGam : ClGam + dataGam : DataGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + synthesized attributes: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + topNm : HsName + visit 5: + inherited attribute: + valGam : ValGam + synthesized attributes: + arity : Int + mbTopNm : Maybe HsName + patFunTy : Ty + visit 6: + inherited attributes: + fiOpts : FIOpts + inclVarBind : Bool + knTy : Ty + knTyL : TyL + tySigGam : ValGam + chained attribute: + patTyVarMp : VarMp + synthesized attribute: + valGam : ValGam + visit 7: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + cpNm : RPatNm + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + scopeGam : ScopeGam + ty : Ty + visit 8: + inherited attributes: + ceParentNm : HsName + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tySigVarMp : VarMp + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + appArgPPL : [PP_Doc] + appFunNm : HsName + appFunPP : PP_Doc + errSq : ErrSq + fsRPatL : FieldSplitL + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + isBang : Bool + patCRest : CPatRest + pp : PP_Doc + rpat : RPat + valCBindL : CBindL + alternatives: + alternative IConst: + child hsrange : {Range} + child int : {Int} + visit 0: + local range : {Range} + visit 1: + local _tup169 : _ + intra range : {Range} + visit 2: + intra _tup169 : _ + intra range : {Range} + visit 3: + intra _tup169 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup169 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 8: + local pp : _ + local finalTy : _ + local fe : {FIEnv} + local finalTyExpanded : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra ty : {Ty} + intra range : {Range} + intra cpNm : {RPatNm} + alternative CConst: + child hsrange : {Range} + child char : {Char} + visit 0: + local range : {Range} + visit 1: + local _tup170 : _ + intra range : {Range} + visit 2: + intra _tup170 : _ + intra range : {Range} + visit 3: + intra _tup170 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup170 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 8: + local pp : _ + local finalTy : _ + local fe : {FIEnv} + local finalTyExpanded : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra ty : {Ty} + intra range : {Range} + intra cpNm : {RPatNm} + alternative Con: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup173 : _ + intra range : {Range} + visit 2: + intra _tup173 : _ + intra range : {Range} + visit 3: + intra _tup173 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup173 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + local lUniq2 : {UID} + local _tup172 : _ + local tvarv2_ : {Ty} + local tvarv1_ : {Ty} + local knTyShape : _ + local _tup171 : _ + local ty_g_ : {Ty} + local fe : {FIEnv} + local fo_fitP_ : {FIOut} + local tyVarMp_p_ : {VarMp} + local patFunTy : {Ty} + intra _tup173 : _ + intra lUniq : {UID} + intra range : {Range} + intra topNm : {HsName} + visit 6: + local lUniq3 : {UID} + local fo_fitR_ : {FIOut} + intra _tup173 : _ + intra tvarv1_ : {Ty} + intra tyVarMp_p_ : {VarMp} + intra fe : {FIEnv} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra _tup171 : _ + intra range : {Range} + intra ty_g_ : {Ty} + visit 7: + local cpNm : {RPatNm} + local ty_r_ : _ + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra fo_fitR_ : {FIOut} + intra _tup171 : _ + intra range : {Range} + intra ty_g_ : {Ty} + intra tvarv1_ : {Ty} + intra fe : {FIEnv} + visit 8: + local appFunNm : _ + local pp : _ + local nmErrs : {ErrL} + local fsRPatL : _ + local gathMentrelFilterMp : _ + local knPatTy : {Ty} + local finalTy : _ + local finalTyExpanded : _ + local finKnPatTy : _ + local tyConNm : _ + local dgi : {DataGamInfo} + local dti : _ + local tag : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra _tup171 : _ + intra fo_fitR_ : {FIOut} + intra range : {Range} + intra ty_g_ : {Ty} + intra tvarv1_ : {Ty} + intra ty : {Ty} + intra fe : {FIEnv} + intra cpNm : {RPatNm} + alternative Var: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup177 : _ + intra range : {Range} + visit 2: + intra _tup177 : _ + intra range : {Range} + visit 3: + intra _tup177 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup177 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra _tup177 : _ + intra lUniq : {UID} + intra range : {Range} + intra topNm : {HsName} + visit 6: + local lUniq_4_fo : {UID} + local lUniq2 : {UID} + local _tup176 : _ + local ty_kn_ensured : _ + local ty_kn_ : {Ty} + local patTyVarMpKnTyEns : _ + local patTyVarMpKnTy1 : _ + local _tup174 : _ + local ty_g_ : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + local _tup175 : _ + local patTyVarMpKnEx : _ + local ty : {Ty} + local varTy : _ + local addToGam : _ + intra _tup177 : _ + intra lUniq : {UID} + intra range : {Range} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 7: + local cpNm : {RPatNm} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra ty : {Ty} + intra fe : {FIEnv} + visit 8: + local pp : _ + local finalTy : _ + local finalTyExpanded : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra ty : {Ty} + intra fe : {FIEnv} + intra cpNm : {RPatNm} + alternative VarAs: + child hsrange : {Range} + child nm : {HsName} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup180 : _ + intra range : {Range} + visit 2: + intra _tup180 : _ + intra range : {Range} + visit 3: + intra _tup180 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup180 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra _tup180 : _ + intra lUniq : {UID} + intra range : {Range} + intra topNm : {HsName} + visit 6: + local lUniq_4_fo : {UID} + local lUniq2 : {UID} + local patTyVarMpKnTy1 : _ + local ty_kn_ : {Ty} + local _tup178 : _ + local ty_g_ : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + local _tup179 : _ + local patTyVarMpKnEx : _ + local ty : {Ty} + local varTy : _ + local addToGam : _ + intra _tup180 : _ + intra lUniq : {UID} + intra range : {Range} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 7: + local cpNm : {RPatNm} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra ty : {Ty} + visit 8: + local pp : _ + local rpat : _ + intra cpNm : {RPatNm} + alternative App: + child hsrange : {Range} + child func : PatExpr + child arg : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup183 : _ + visit 5: + local mbTopNm : {Maybe HsName} + visit 6: + local _tup182 : _ + local knTyL : {TyL} + local knArgTy : {Ty} + visit 7: + local cpNm : {RPatNm} + visit 8: + local _tup181 : _ + local pp : _ + alternative AppTop: + child hsrange : {Range} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup186 : _ + intra range : {Range} + visit 2: + intra _tup186 : _ + intra range : {Range} + visit 3: + intra _tup186 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup186 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + local patFunTy : {Ty} + intra range : {Range} + intra lUniq : {UID} + intra topNm : {HsName} + visit 6: + local _tup185 : _ + local knProdTy : _ + local prodTyL : _ + local _tup184 : _ + local knTyL : {TyL} + local knPatTy : {Ty} + local fe : {FIEnv} + local fo_fitR_ : {FIOut} + intra patFunTy : {Ty} + intra range : {Range} + intra lUniq : {UID} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra fo_fitR_ : {FIOut} + intra _tup184 : _ + intra range : {Range} + intra fe : {FIEnv} + intra knPatTy : {Ty} + visit 8: + local pp : _ + local arityErrs : {ErrL} + local appFunNm : _ + local finalTy : _ + local finalTyExpanded : _ + local finKnPatTy : _ + local fsRPatL : _ + local rpatBinds : _ + local rest : _ + local tyConNm : _ + local dgi : {DataGamInfo} + local dti : _ + local tag : _ + local sysfty : _ + local acorety : _ + local rpat : _ + local rceEnv : _ + local valCBindLSub : _ + local valCBindL : _ + intra _tup184 : _ + intra fo_fitR_ : {FIOut} + intra range : {Range} + intra ty : {Ty} + intra fe : {FIEnv} + intra knPatTy : {Ty} + intra cpNm : {RPatNm} + alternative Parens: + child hsrange : {Range} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup187 : _ + visit 5: + local mbTopNm : {Maybe HsName} + visit 8: + local pp : _ + alternative Ann: + child hsrange : {Range} + child ann : PatExprAnn + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup188 : _ + visit 5: + local mbTopNm : {Maybe HsName} + visit 8: + local pp : _ + alternative TypeAs: + child hsrange : {Range} + child tyExpr : TyExpr + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup189 : _ + intra range : {Range} + visit 2: + intra _tup189 : _ + intra range : {Range} + visit 3: + intra _tup189 : _ + intra range : {Range} + visit 4: + intra _tup189 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra _tup189 : _ + intra range : {Range} + visit 6: + local lUniq_4_fo : {UID} + local ty_q_ : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup189 : _ + intra range : {Range} + visit 7: + intra fo_ : {FIOut} + intra range : {Range} + visit 8: + local pp : _ + intra fo_ : {FIOut} + intra range : {Range} + alternative SConst: + child hsrange : {Range} + child str : {String} + visit 0: + local range : {Range} + visit 1: + local _tup190 : _ + intra range : {Range} + visit 2: + intra _tup190 : _ + intra range : {Range} + visit 3: + intra _tup190 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup190 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra range : {Range} + intra lUniq : {UID} + intra topNm : {HsName} + visit 6: + local constTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra range : {Range} + intra lUniq : {UID} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra constTy : {Ty} + intra fe : {FIEnv} + visit 8: + local pp : _ + local finalTy : _ + local finalTyExpanded : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra ty : {Ty} + intra fe : {FIEnv} + intra cpNm : {RPatNm} + alternative Rec: + child hsrange : {Range} + child recPatExpr : RecPatExpr + visit 0: + local range : {Range} + visit 1: + local _tup191 : _ + intra range : {Range} + visit 2: + intra _tup191 : _ + intra range : {Range} + visit 3: + intra _tup191 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup191 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 8: + local appFunNm : _ + local pp : _ + local fsRPatL : _ + local finalTy : _ + local fe : {FIEnv} + local finalTyExpanded : _ + local rpatBinds : _ + local rest : _ + local tag : _ + local sysfty : _ + local acorety : _ + local rpat : _ + local rceEnv : _ + local valCBindLSub : _ + local valCBindL : _ + intra range : {Range} + intra ty : {Ty} + intra cpNm : {RPatNm} + alternative DataFields: + child hsrange : {Range} + child dataFieldPatExpr : DataFieldPatExpr + visit 0: + local range : {Range} + visit 1: + local _tup193 : _ + intra range : {Range} + visit 2: + intra _tup193 : _ + intra range : {Range} + visit 3: + intra _tup193 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup193 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 8: + local pp : _ + local finalTy : _ + local fe : {FIEnv} + local finalTyExpanded : _ + local fsRPatL : _ + local tag : _ + local _tup192 : _ + local rpatBind0 : _ + local rpatBindss : _ + local rest : _ + local sysfty : _ + local acorety : _ + local rpat : _ + local rceEnv : _ + local valCBindLSub : _ + local rpatBindsNonSat : _ + local valCBindL : _ + intra ty : {Ty} + intra range : {Range} + intra cpNm : {RPatNm} + alternative Irrefutable: + child hsrange : {Range} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup194 : _ + intra range : {Range} + visit 2: + intra range : {Range} + visit 3: + intra range : {Range} + visit 4: + local topNm : {HsName} + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra range : {Range} + visit 8: + local pp : _ + local finalTy : _ + local fe : {FIEnv} + local finalTyExpanded : _ + local sysfty : _ + local acorety : _ + local rpat : _ + intra ty : {Ty} + intra range : {Range} + intra cpNm : {RPatNm} + alternative Bang: + child hsrange : {Range} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup195 : _ + visit 4: + local topNm : {HsName} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 7: + local cpNm : {RPatNm} + local ty : {Ty} + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + visit 8: + local pp : _ + local rpat : _ + alternative Expr: + child hsrange : {Range} + child expr : Expr + child mbConst : {Maybe SrcConst} + visit 0: + local range : {Range} + visit 1: + local _tup198 : _ + intra range : {Range} + visit 2: + intra _tup198 : _ + intra range : {Range} + visit 3: + intra _tup198 : _ + intra range : {Range} + visit 4: + local lUniq : {UID} + local topNm : {HsName} + intra _tup198 : _ + intra range : {Range} + visit 5: + local mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra _tup198 : _ + intra lUniq : {UID} + intra range : {Range} + visit 6: + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra _tup198 : _ + intra lUniq : {UID} + intra range : {Range} + visit 7: + local cpNm : {RPatNm} + local lUniq_97_fitsIn_ty : {UID} + local knExprTy : {Ty} + local eqFldNm : {HsName} + local _tup197 : _ + local eqTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + local hereCnstrMp : _ + intra mbTopNm : {Maybe HsName} + intra topNm : {HsName} + intra _tup198 : _ + intra lUniq : {UID} + intra range : {Range} + visit 8: + local pp : _ + local lUniq_cexpr : {UID} + local cexprBaseEq : _ + local _tup196 : _ + local cexprpatCSubst : _ + local nmErrs : {ErrL} + local gathMentrelFilterMp : _ + local cexpr : _ + local rpat : _ + intra _tup198 : _ + intra eqFldNm : {HsName} + intra fo_ : {FIOut} + intra _tup197 : _ + intra range : {Range} + intra eqTy : {Ty} + intra cpNm : {RPatNm} +-} +sem_PatExpr_IConst :: Range -> + Int -> + T_PatExpr + +sem_PatExpr_IConst hsrange_ int_ | hsrange_ `seq` (int_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_IConst_1 :: T_PatExpr_1 + sem_PatExpr_IConst_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup169 | __tup169 `seq` (True) -> + (case (__tup169) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_IConst_2 :: T_PatExpr_2 + sem_PatExpr_IConst_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_IConst_3 :: T_PatExpr_3 + sem_PatExpr_IConst_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_IConst_4 :: T_PatExpr_4 + sem_PatExpr_IConst_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup169) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_IConst_5 :: T_PatExpr_5 + sem_PatExpr_IConst_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_IConst_6 :: T_PatExpr_6 + sem_PatExpr_IConst_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_IConst_7 :: T_PatExpr_7 + sem_PatExpr_IConst_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (tyInt) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_IConst_8 :: T_PatExpr_8 + sem_PatExpr_IConst_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp (show int_)) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Int _cpNm _acorety (toInteger int_)) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_IConst_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_IConst_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) })))))))) + in sem_PatExpr_IConst_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_IConst_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }))))))) + in sem_PatExpr_IConst_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) })))))))))) + in sem_PatExpr_IConst_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }))))) + in sem_PatExpr_IConst_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }))) + in sem_PatExpr_IConst_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) + +sem_PatExpr_CConst :: Range -> + Char -> + T_PatExpr + +sem_PatExpr_CConst hsrange_ char_ | hsrange_ `seq` (char_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_CConst_1 :: T_PatExpr_1 + sem_PatExpr_CConst_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup170 | __tup170 `seq` (True) -> + (case (__tup170) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_CConst_2 :: T_PatExpr_2 + sem_PatExpr_CConst_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_CConst_3 :: T_PatExpr_3 + sem_PatExpr_CConst_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_CConst_4 :: T_PatExpr_4 + sem_PatExpr_CConst_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup170) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_CConst_5 :: T_PatExpr_5 + sem_PatExpr_CConst_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_CConst_6 :: T_PatExpr_6 + sem_PatExpr_CConst_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_CConst_7 :: T_PatExpr_7 + sem_PatExpr_CConst_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (tyChar) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_CConst_8 :: T_PatExpr_8 + sem_PatExpr_CConst_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp (show char_)) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Char _cpNm _acorety char_) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_CConst_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_CConst_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) })))))))) + in sem_PatExpr_CConst_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_CConst_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }))))))) + in sem_PatExpr_CConst_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) })))))))))) + in sem_PatExpr_CConst_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }))))) + in sem_PatExpr_CConst_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }))) + in sem_PatExpr_CConst_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) + +sem_PatExpr_Con :: Range -> + HsName -> + T_PatExpr + +sem_PatExpr_Con hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Con_1 :: T_PatExpr_1 + sem_PatExpr_Con_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} )) of + { __tup173 | __tup173 `seq` (True) -> + (case (__tup173) of + { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Con_2 :: T_PatExpr_2 + sem_PatExpr_Con_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Con_3 :: T_PatExpr_3 + sem_PatExpr_Con_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Con_4 :: T_PatExpr_4 + sem_PatExpr_Con_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup173) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Con_5 :: T_PatExpr_5 + sem_PatExpr_Con_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (__tup173) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (let [a,r] = mkNewTyVarL 2 _lUniq in (a,r)) of + { __tup172 | __tup172 `seq` (True) -> + (case (__tup172) of + { (_,_tvarv2_) | _tvarv2_ `seq` (True) -> + (case (__tup172) of + { (_tvarv1_,_) | _tvarv1_ `seq` (True) -> + (case ([_tvarv1_ ] `appArr` _tvarv2_) of + { _knTyShape | _knTyShape `seq` (True) -> + (case (valGamLookupTy (hsnUn nm_) _lhsIvalGam) of + { __tup171 | __tup171 `seq` (True) -> + (case (__tup171) of + { (_ty_g_,_) | _ty_g_ `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn instFIOpts _fe _lUniq2 (emptyVarMp :: VarMp) _ty_g_ _knTyShape) of + { _fo_fitP_ | _fo_fitP_ `seq` (True) -> + (case (foVarMp _fo_fitP_) of + { _tyVarMp_p_ | _tyVarMp_p_ `seq` (True) -> + (case (_tyVarMp_p_ `varUpd` foTy _fo_fitP_) of + { _patFunTy | _patFunTy `seq` (True) -> + (case (_patFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Con_6 :: T_PatExpr_6 + sem_PatExpr_Con_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (__tup173) of + { (_,_,_,_lUniq3) | _lUniq3 `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq3 (_tyVarMp_p_ `varUpd` _lhsIpatTyVarMp) _lhsIknTy _tvarv1_) of + { _fo_fitR_ | _fo_fitR_ `seq` (True) -> + (case (foVarMp _fo_fitR_ `varUpd` _tyVarMp_p_ `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Con_7 :: T_PatExpr_7 + sem_PatExpr_Con_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (foTy _fo_fitR_) of + { _ty_r_ | _ty_r_ `seq` (True) -> + (case (_ty_r_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Con_8 :: T_PatExpr_8 + sem_PatExpr_Con_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (nm_) of + { _appFunNm | _appFunNm `seq` (True) -> + (case (_appFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppCon nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (__tup171) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [Seq.fromList _nmErrs, foErrSq _fo_fitR_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _fsRPatL | _fsRPatL `seq` (True) -> + (case (_fsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val nm_ + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _ty_g_) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tvarv1_) of + { _knPatTy | _knPatTy `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _knPatTy) of + { _finKnPatTy | _finKnPatTy `seq` (True) -> + (case (tyConNm $ fst $ appUnApp _finKnPatTy) of + { _tyConNm | _tyConNm `seq` (True) -> + (case (panicJust ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm) + $ dataGamLookup _tyConNm $ _lhsIdataGam) of + { _dgi | _dgi `seq` (True) -> + (case (panicJust ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) + $ Map.lookup _appFunNm $ dgiConstrTagMp _dgi) of + { _dti | _dti `seq` (True) -> + (case (dtiCTag _dti) of + { _tag | _tag `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Con _cpNm _acorety _tag (RPatConBind_One CPatRest_Empty [])) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Con_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Con_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) })))))))) + in sem_PatExpr_Con_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PatExpr_Con_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }))))))) + in sem_PatExpr_Con_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) })))))))))) + in sem_PatExpr_Con_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }))))) + in sem_PatExpr_Con_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }))) + in sem_PatExpr_Con_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) + +sem_PatExpr_Var :: Range -> + HsName -> + T_PatExpr + +sem_PatExpr_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Var_1 :: T_PatExpr_1 + sem_PatExpr_Var_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq_4_fo) -> (__cont,lUniq,lUniq2,lUniq_4_fo)}}} )) of + { __tup177 | __tup177 `seq` (True) -> + (case (__tup177) of + { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Var_2 :: T_PatExpr_2 + sem_PatExpr_Var_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Var_3 :: T_PatExpr_3 + sem_PatExpr_Var_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Var_4 :: T_PatExpr_4 + sem_PatExpr_Var_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup177) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (if hsnIsWild nm_ then uidHNm _lUniq else nm_) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Var_5 :: T_PatExpr_5 + sem_PatExpr_Var_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (if hsnIsWild nm_ then Nothing else Just nm_) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Var_6 :: T_PatExpr_6 + sem_PatExpr_Var_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (__tup177) of + { (_,_,_,_lUniq_4_fo) | _lUniq_4_fo `seq` (True) -> + (case (__tup177) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (tyAsVarMp' tyEnsureNonAnyImpl _lUniq _lhsIknTy) of + { __tup176 | __tup176 `seq` (True) -> + (case (__tup176) of + { (_ty_kn_ensured,_) | _ty_kn_ensured `seq` (True) -> + (case (_ty_kn_ensured) of + { _ty_kn_ | _ty_kn_ `seq` (True) -> + (case (__tup176) of + { (_,_patTyVarMpKnTyEns) | _patTyVarMpKnTyEns `seq` (True) -> + (case (_patTyVarMpKnTyEns `varUpd` _lhsIpatTyVarMp) of + { _patTyVarMpKnTy1 | _patTyVarMpKnTy1 `seq` (True) -> + (case (valGamLookupTy nm_ _lhsItySigGam) of + { __tup174 | __tup174 `seq` (True) -> + (case (__tup174) of + { (_ty_g_,_) | _ty_g_ `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq_4_fo _patTyVarMpKnTy1 _ty_kn_ _ty_g_) of + { _fo_ | _fo_ `seq` (True) -> + (case (tyAsVarMp' tyInst1Exists _lUniq2 (foTy _fo_)) of + { __tup175 | __tup175 `seq` (True) -> + (case (__tup175) of + { (_,_patTyVarMpKnEx) | _patTyVarMpKnEx `seq` (True) -> + (case (__tup175) of + { (_ty,_) | _ty `seq` (True) -> + (case (tyRestrictKiVarMp [_ty] `varUpd` _patTyVarMpKnEx `varUpd` foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_ty) of + { _varTy | _varTy `seq` (True) -> + (case (if _lhsIinclVarBind && not (hsnIsWild nm_) + then \g -> gamAdd nm_ + (ValGamInfo _varTy) g + else id) of + { _addToGam | _addToGam `seq` (True) -> + (case (_addToGam _lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Var_7 :: T_PatExpr_7 + sem_PatExpr_Var_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (gamSingleton nm_ _lhsIpredScope) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Var_8 :: T_PatExpr_8 + sem_PatExpr_Var_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Var nm_) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Var _cpNm _acorety False) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Var_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Var_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Var_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_Var_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }))))))) + in sem_PatExpr_Var_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) })))))))))) + in sem_PatExpr_Var_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }))))) + in sem_PatExpr_Var_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }))) + in sem_PatExpr_Var_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) + +sem_PatExpr_VarAs :: Range -> + HsName -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_VarAs hsrange_ nm_ patExpr_ | hsrange_ `seq` (nm_ `seq` (patExpr_ `seq` (True))) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_VarAs_1 :: T_PatExpr_1 + sem_PatExpr_VarAs_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq_4_fo) -> (__cont,lUniq,lUniq2,lUniq_4_fo)}}} )) of + { __tup180 | __tup180 `seq` (True) -> + (case (__tup180) of + { (_patExprOgUniq,_,_,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_VarAs_2 :: T_PatExpr_2 + sem_PatExpr_VarAs_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_VarAs_3 :: T_PatExpr_3 + sem_PatExpr_VarAs_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_VarAs_4 :: T_PatExpr_4 + sem_PatExpr_VarAs_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup180) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (if hsnIsWild nm_ then uidHNm _lUniq else nm_) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_VarAs_5 :: T_PatExpr_5 + sem_PatExpr_VarAs_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (if hsnIsWild nm_ then Nothing else Just nm_) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_VarAs_6 :: T_PatExpr_6 + sem_PatExpr_VarAs_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (__tup180) of + { (_,_,_,_lUniq_4_fo) | _lUniq_4_fo `seq` (True) -> + (case (__tup180) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patTyVarMpKnTy1 | _patTyVarMpKnTy1 `seq` (True) -> + (case (tyEnsureNonAny _lUniq _lhsIknTy) of + { _ty_kn_ | _ty_kn_ `seq` (True) -> + (case (valGamLookupTy nm_ _lhsItySigGam) of + { __tup178 | __tup178 `seq` (True) -> + (case (__tup178) of + { (_ty_g_,_) | _ty_g_ `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq_4_fo _patTyVarMpKnTy1 _ty_kn_ _ty_g_) of + { _fo_ | _fo_ `seq` (True) -> + (case (tyAsVarMp' tyInst1Exists _lUniq2 (foTy _fo_)) of + { __tup179 | __tup179 `seq` (True) -> + (case (__tup179) of + { (_,_patTyVarMpKnEx) | _patTyVarMpKnEx `seq` (True) -> + (case (__tup179) of + { (_ty,_) | _ty `seq` (True) -> + (case (tyRestrictKiVarMp [_ty] `varUpd` _patTyVarMpKnEx `varUpd` foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_ty) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_ty) of + { _varTy | _varTy `seq` (True) -> + (case (if _lhsIinclVarBind && not (hsnIsWild nm_) + then \g -> gamAdd nm_ + (ValGamInfo _varTy) g + else id) of + { _addToGam | _addToGam `seq` (True) -> + (case (_addToGam _patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_VarAs_7 :: T_PatExpr_7 + sem_PatExpr_VarAs_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_VarAs_8 :: T_PatExpr_8 + sem_PatExpr_VarAs_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp nm_ >|< "@" >|< _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_patExprIrpat {rcpPNm = _cpNm}) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_VarAs_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_VarAs_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_VarAs_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_VarAs_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_VarAs_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_VarAs_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_VarAs_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_VarAs_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_App :: Range -> + T_PatExpr -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_App hsrange_ func_ arg_ | hsrange_ `seq` (func_ `seq` (arg_ `seq` (True))) = + (case (arg_) of + { ( _argIrange,arg_1) | True -> + (case (func_) of + { ( _funcIrange,func_1) | True -> + (case (rangeUnions [hsrange_, _funcIrange , _argIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_App_1 :: T_PatExpr_1 + sem_PatExpr_App_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup183 | __tup183 `seq` (True) -> + (case (__tup183) of + { (_funcOgUniq,_) | _funcOgUniq `seq` (True) -> + (case (func_1 _funcOgUniq) of + { ( _funcIgUniq,func_2) | True -> + (case (_funcIgUniq) of + { _argOgUniq | _argOgUniq `seq` (True) -> + (case (arg_1 _argOgUniq) of + { ( _argIgUniq,arg_2) | True -> + (case (_argIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_App_2 :: T_PatExpr_2 + sem_PatExpr_App_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _funcOpredSameScopeCounter | _funcOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _funcOlexLev | _funcOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _funcOkiGam | _funcOkiGam `seq` (True) -> + (case (func_2 _funcOkiGam _funcOlexLev _funcOpredSameScopeCounter) of + { ( _funcIpredSameScopeCounter,func_3) | True -> + (case (_funcIpredSameScopeCounter) of + { _argOpredSameScopeCounter | _argOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _argOlexLev | _argOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _argOkiGam | _argOkiGam `seq` (True) -> + (case (arg_2 _argOkiGam _argOlexLev _argOpredSameScopeCounter) of + { ( _argIpredSameScopeCounter,arg_3) | True -> + (case (_argIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_App_3 :: T_PatExpr_3 + sem_PatExpr_App_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _argOtyKiGlobFreeTvarS | _argOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _funcOtyKiGlobFreeTvarS | _funcOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _funcOtyKiGam | _funcOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _funcOtyGam | _funcOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _funcOpredScope | _funcOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _funcOpolVarMp | _funcOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _funcOpolGam | _funcOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _funcOkiVarMp | _funcOkiVarMp `seq` (True) -> + (case (func_3 _funcOkiVarMp _funcOopts _funcOpolGam _funcOpolVarMp _funcOpredScope _funcOtyGam _funcOtyKiGam _funcOtyKiGlobFreeTvarS) of + { ( _funcIkiVarMp,_funcIpolVarMp,_funcItyGam,_funcItyKiGam,func_4) | True -> + (case (_funcItyKiGam) of + { _argOtyKiGam | _argOtyKiGam `seq` (True) -> + (case (_funcItyGam) of + { _argOtyGam | _argOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _argOpredScope | _argOpredScope `seq` (True) -> + (case (_funcIpolVarMp) of + { _argOpolVarMp | _argOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _argOpolGam | _argOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_funcIkiVarMp) of + { _argOkiVarMp | _argOkiVarMp `seq` (True) -> + (case (arg_3 _argOkiVarMp _argOopts _argOpolGam _argOpolVarMp _argOpredScope _argOtyGam _argOtyKiGam _argOtyKiGlobFreeTvarS) of + { ( _argIkiVarMp,_argIpolVarMp,_argItyGam,_argItyKiGam,arg_4) | True -> + (case (_argIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_argIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_argItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_argItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_App_4 :: T_PatExpr_4 + sem_PatExpr_App_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _argOtyTyTySigFreeTvarS | _argOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _argOfinTyKiGam | _argOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _argOdataGam | _argOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _argOclGam | _argOclGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _funcOtyTyTySigFreeTvarS | _funcOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _funcOfinTyKiGam | _funcOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _funcOfinKiVarMp | _funcOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _funcOdataGam | _funcOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _funcOclGam | _funcOclGam `seq` (True) -> + (case (arg_4 _argOclGam _argOdataGam _argOfinKiVarMp _argOfinTyKiGam _argOtyTyTySigFreeTvarS) of + { ( _argIchrInstDeclSq,_argItopNm,arg_5) | True -> + (case (func_4 _funcOclGam _funcOdataGam _funcOfinKiVarMp _funcOfinTyKiGam _funcOtyTyTySigFreeTvarS) of + { ( _funcIchrInstDeclSq,_funcItopNm,func_5) | True -> + (case (_funcIchrInstDeclSq `Seq.union` _argIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (hsnUnknown) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_App_5 :: T_PatExpr_5 + sem_PatExpr_App_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _funcOvalGam | _funcOvalGam `seq` (True) -> + (case (func_5 _funcOvalGam) of + { ( _funcIarity,_funcImbTopNm,_funcIpatFunTy,func_6) | True -> + (case (_funcIarity + 1) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_funcIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_App_6 :: T_PatExpr_6 + sem_PatExpr_App_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _funcOtySigGam | _funcOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _funcOpatTyVarMp | _funcOpatTyVarMp `seq` (True) -> + (case (hdAndTl _lhsIknTyL) of + { __tup182 | __tup182 `seq` (True) -> + (case (__tup182) of + { (_,_knTyL) | _knTyL `seq` (True) -> + (case (_knTyL) of + { _funcOknTyL | _funcOknTyL `seq` (True) -> + (case (_lhsIinclVarBind) of + { _funcOinclVarBind | _funcOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _funcOfiOpts | _funcOfiOpts `seq` (True) -> + (case (Ty_Any) of + { _funcOknTy | _funcOknTy `seq` (True) -> + (case (func_6 _funcOfiOpts _funcOinclVarBind _funcOknTy _funcOknTyL _funcOpatTyVarMp _funcOtySigGam) of + { ( _funcIpatTyVarMp,_funcIvalGam,func_7) | True -> + (case (_funcIvalGam) of + { _argOvalGam | _argOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _argOtySigGam | _argOtySigGam `seq` (True) -> + (case (_funcIpatTyVarMp) of + { _argOpatTyVarMp | _argOpatTyVarMp `seq` (True) -> + (case (_knTyL) of + { _argOknTyL | _argOknTyL `seq` (True) -> + (case (_lhsIinclVarBind) of + { _argOinclVarBind | _argOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _argOfiOpts | _argOfiOpts `seq` (True) -> + (case (__tup182) of + { (_knArgTy,_) | _knArgTy `seq` (True) -> + (case (_knArgTy) of + { _argOknTy | _argOknTy `seq` (True) -> + (case (arg_5 _argOvalGam) of + { ( _argIarity,_argImbTopNm,_argIpatFunTy,arg_6) | True -> + (case (arg_6 _argOfiOpts _argOinclVarBind _argOknTy _argOknTyL _argOpatTyVarMp _argOtySigGam) of + { ( _argIpatTyVarMp,_argIvalGam,arg_7) | True -> + (case (_argIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_argIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_App_7 :: T_PatExpr_7 + sem_PatExpr_App_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _argOvalTyGlobFreeTvarS | _argOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _funcOvalTyGlobFreeTvarS | _funcOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _funcOtyVarMp | _funcOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _funcOtyTyGlobFreeTvarS | _funcOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _funcOtvKiVarMp | _funcOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _funcOclDfGam | _funcOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _funcOchrStore | _funcOchrStore `seq` (True) -> + (case (func_7 _funcOchrStore _funcOclDfGam _funcOtvKiVarMp _funcOtyTyGlobFreeTvarS _funcOtyVarMp _funcOvalTyGlobFreeTvarS) of + { ( _funcIcpNm,_funcIgathCnstrMp,_funcIgathRangeMp,_funcIscopeGam,_funcIty,_funcItyVarMp,func_8) | True -> + (case (_funcItyVarMp) of + { _argOtyVarMp | _argOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _argOtyTyGlobFreeTvarS | _argOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _argOtvKiVarMp | _argOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _argOclDfGam | _argOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _argOchrStore | _argOchrStore `seq` (True) -> + (case (arg_7 _argOchrStore _argOclDfGam _argOtvKiVarMp _argOtyTyGlobFreeTvarS _argOtyVarMp _argOvalTyGlobFreeTvarS) of + { ( _argIcpNm,_argIgathCnstrMp,_argIgathRangeMp,_argIscopeGam,_argIty,_argItyVarMp,arg_8) | True -> + (case (_argIcpNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_funcIgathCnstrMp `cnstrMpUnion` _argIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_funcIgathRangeMp `Map.union` _argIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_funcIscopeGam `gamUnion` _argIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_argIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_argItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_App_8 :: T_PatExpr_8 + sem_PatExpr_App_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _argOsysfEnv | _argOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _argOrangeMp | _argOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _argOfinValGam | _argOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _argOfinTyVarMp | _argOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _funcOsysfEnv | _funcOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _funcOrangeMp | _funcOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _funcOfinValGam | _funcOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _funcOfinTyVarMp | _funcOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _argOtySigVarMp | _argOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _argOmoduleNm | _argOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _argOchrScopeBindMp | _argOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _argOchrEvidBindMp | _argOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _funcOchrScopeBindMp | _funcOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _funcOchrEvidBindMp | _funcOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _funcOcSubst | _funcOcSubst `seq` (True) -> + (case (_lhsItySigVarMp) of + { _funcOtySigVarMp | _funcOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm | _funcOmoduleNm `seq` (True) -> + (case (_lhsIceParentNm) of + { _funcOceParentNm | _funcOceParentNm `seq` (True) -> + (case (func_8 _funcOcSubst _funcOceParentNm _funcOchrEvidBindMp _funcOchrScopeBindMp _funcOfinTyVarMp _funcOfinValGam _funcOmoduleNm _funcOrangeMp _funcOsysfEnv _funcOtySigVarMp) of + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIcSubst,_funcIerrSq,_funcIfsRPatL,_funcIgathMentrelFilterMp,_funcIgathTvKiVarMp,_funcIisBang,_funcIpatCRest,_funcIpp,_funcIrpat,_funcIvalCBindL) | True -> + (case (_funcIcSubst) of + { _argOcSubst | _argOcSubst `seq` (True) -> + (case (rpatNmNm _argIcpNm) of + { _argOceParentNm | _argOceParentNm `seq` (True) -> + (case (arg_8 _argOcSubst _argOceParentNm _argOchrEvidBindMp _argOchrScopeBindMp _argOfinTyVarMp _argOfinValGam _argOmoduleNm _argOrangeMp _argOsysfEnv _argOtySigVarMp) of + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIcSubst,_argIerrSq,_argIfsRPatL,_argIgathMentrelFilterMp,_argIgathTvKiVarMp,_argIisBang,_argIpatCRest,_argIpp,_argIrpat,_argIvalCBindL) | True -> + (case (_funcIallErrSq `Seq.union` _argIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (mkExtAppPP (_funcIappFunNm,_funcIappFunPP,_funcIappArgPPL) + (_argIappFunNm,_argIappFunPP,_argIappArgPPL,_argIpp)) of + { __tup181 | __tup181 `seq` (True) -> + (case (__tup181) of + { (_,_lhsOappArgPPL) | _lhsOappArgPPL `seq` (True) -> + (case (_funcIappFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (__tup181) of + { (_lhsOappFunPP,_) | _lhsOappFunPP `seq` (True) -> + (case (_argIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_funcIerrSq `Seq.union` _argIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ((FldImplicitOffset,_argIrpat) : _funcIfsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_funcIgathMentrelFilterMp `mentrelFilterMpUnion` _argIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_funcIgathTvKiVarMp `varmpUnion` _argIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_funcIpp >#< _argIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_argIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_funcIvalCBindL ++ _argIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_App_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_App_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_App_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_App_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_App_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_App_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }) }) }) }) }))))) + in sem_PatExpr_App_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }) }) }))) + in sem_PatExpr_App_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) }) + +sem_PatExpr_AppTop :: Range -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_AppTop hsrange_ patExpr_ | hsrange_ `seq` (patExpr_ `seq` (True)) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_AppTop_1 :: T_PatExpr_1 + sem_PatExpr_AppTop_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup186 | __tup186 `seq` (True) -> + (case (__tup186) of + { (_patExprOgUniq,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_AppTop_2 :: T_PatExpr_2 + sem_PatExpr_AppTop_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_AppTop_3 :: T_PatExpr_3 + sem_PatExpr_AppTop_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_AppTop_4 :: T_PatExpr_4 + sem_PatExpr_AppTop_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup186) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_AppTop_5 :: T_PatExpr_5 + sem_PatExpr_AppTop_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIpatFunTy) of + { _patFunTy | _patFunTy `seq` (True) -> + (case (_patFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_AppTop_6 :: T_PatExpr_6 + sem_PatExpr_AppTop_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (appUn1Arr _patFunTy) of + { __tup185 | __tup185 `seq` (True) -> + (case (__tup185) of + { (_,_knProdTy) | _knProdTy `seq` (True) -> + (case (tyProdArgs _knProdTy) of + { _prodTyL | _prodTyL `seq` (True) -> + (case (case _prodTyL of + tL | _patExprIarity == length tL + -> (reverse tL,[]) + _ -> (repeat Ty_Any + , [rngLift _range Err_PatArity2 "type" + (ppTy _knProdTy) _patExprIarity])) of + { __tup184 | __tup184 `seq` (True) -> + (case (__tup184) of + { (_knTyL,_) | _knTyL `seq` (True) -> + (case (_knTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (True) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (__tup185) of + { (_knPatTy,_) | _knPatTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq _lhsIpatTyVarMp _lhsIknTy _knPatTy) of + { _fo_fitR_ | _fo_fitR_ `seq` (True) -> + (case (foVarMp _fo_fitR_ `varUpd` _lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_AppTop_7 :: T_PatExpr_7 + sem_PatExpr_AppTop_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (foTy _fo_fitR_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_AppTop_8 :: T_PatExpr_8 + sem_PatExpr_AppTop_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppAppTop (_patExprIappFunNm,_patExprIappFunPP) + _patExprIappArgPPL _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (__tup184) of + { (_,_arityErrs) | _arityErrs `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [_patExprIerrSq, Seq.fromList _arityErrs, foErrSq _fo_fitR_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_patExprIappFunNm) of + { _appFunNm | _appFunNm `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _knPatTy) of + { _finKnPatTy | _finKnPatTy `seq` (True) -> + (case (_patExprIfsRPatL) of + { _fsRPatL | _fsRPatL `seq` (True) -> + (case (fsL2PatOffsetL _lhsIopts $ reverse $ _fsRPatL) of + { _rpatBinds | _rpatBinds `seq` (True) -> + (case (CPatRest_Empty) of + { _rest | _rest `seq` (True) -> + (case (tyConNm $ fst $ appUnApp _finKnPatTy) of + { _tyConNm | _tyConNm `seq` (True) -> + (case (panicJust ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm) + $ dataGamLookup _tyConNm $ _lhsIdataGam) of + { _dgi | _dgi `seq` (True) -> + (case (panicJust ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) + $ Map.lookup _appFunNm $ dgiConstrTagMp _dgi) of + { _dti | _dti `seq` (True) -> + (case (dtiCTag _dti) of + { _tag | _tag `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Con _cpNm _acorety _tag (RPatConBind_One _rest (map fst _rpatBinds))) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ((emptyRCEEnv _lhsIopts) { rceValGam = _lhsIvalGam, rceDataGam = _lhsIdataGam, rceTyVarMp = _lhsIfinTyVarMp }) of + { _rceEnv | _rceEnv `seq` (True) -> + (case (_patExprIvalCBindL) of + { _valCBindLSub | _valCBindLSub `seq` (True) -> + (case (acoreRPatBindL2BindL _rceEnv (not $ null _valCBindLSub) _lhsIceParentNm _tag (Just (_rest,length _fsRPatL)) _rpatBinds) of + { _valCBindL | _valCBindL `seq` (True) -> + (case (_valCBindL ++ _valCBindLSub) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_AppTop_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_AppTop_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_AppTop_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }) }))) + in sem_PatExpr_AppTop_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_AppTop_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_AppTop_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_AppTop_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_AppTop_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_Parens :: Range -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_Parens hsrange_ patExpr_ | hsrange_ `seq` (patExpr_ `seq` (True)) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Parens_1 :: T_PatExpr_1 + sem_PatExpr_Parens_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup187 | __tup187 `seq` (True) -> + (case (__tup187) of + { (_patExprOgUniq,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Parens_2 :: T_PatExpr_2 + sem_PatExpr_Parens_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Parens_3 :: T_PatExpr_3 + sem_PatExpr_Parens_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Parens_4 :: T_PatExpr_4 + sem_PatExpr_Parens_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_patExprItopNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Parens_5 :: T_PatExpr_5 + sem_PatExpr_Parens_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Parens_6 :: T_PatExpr_6 + sem_PatExpr_Parens_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Parens_7 :: T_PatExpr_7 + sem_PatExpr_Parens_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIcpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Parens_8 :: T_PatExpr_8 + sem_PatExpr_Parens_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppParens _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Parens_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Parens_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Parens_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_Parens_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Parens_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Parens_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_Parens_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Parens_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_Ann :: Range -> + T_PatExprAnn -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_Ann hsrange_ ann_ patExpr_ | hsrange_ `seq` (ann_ `seq` (patExpr_ `seq` (True))) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Ann_1 :: T_PatExpr_1 + sem_PatExpr_Ann_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup188 | __tup188 `seq` (True) -> + (case (__tup188) of + { (_patExprOgUniq,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Ann_2 :: T_PatExpr_2 + sem_PatExpr_Ann_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Ann_3 :: T_PatExpr_3 + sem_PatExpr_Ann_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Ann_4 :: T_PatExpr_4 + sem_PatExpr_Ann_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_patExprItopNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Ann_5 :: T_PatExpr_5 + sem_PatExpr_Ann_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Ann_6 :: T_PatExpr_6 + sem_PatExpr_Ann_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Ann_7 :: T_PatExpr_7 + sem_PatExpr_Ann_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIcpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Ann_8 :: T_PatExpr_8 + sem_PatExpr_Ann_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Ann_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Ann_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Ann_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_Ann_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Ann_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Ann_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_Ann_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Ann_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_TypeAs :: Range -> + T_TyExpr -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_TypeAs hsrange_ tyExpr_ patExpr_ | hsrange_ `seq` (tyExpr_ `seq` (patExpr_ `seq` (True))) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_1 :: T_PatExpr_1 + sem_PatExpr_TypeAs_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_4_fo) -> (__cont,lUniq,lUniq_4_fo)}} )) of + { __tup189 | __tup189 `seq` (True) -> + (case (__tup189) of + { (_tyExprOgUniq,_,_) | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _patExprOgUniq | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_2 :: T_PatExpr_2 + sem_PatExpr_TypeAs_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_3 :: T_PatExpr_3 + sem_PatExpr_TypeAs_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (polCovariant) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_tyExprItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_tyExprIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_4 :: T_PatExpr_4 + sem_PatExpr_TypeAs_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_patExprItopNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_5 :: T_PatExpr_5 + sem_PatExpr_TypeAs_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_6 :: T_PatExpr_6 + sem_PatExpr_TypeAs_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (__tup189) of + { (_,_,_lUniq_4_fo) | _lUniq_4_fo `seq` (True) -> + (case (_tyExprIty) of + { _ty_q_ | _ty_q_ `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq_4_fo _lhsIpatTyVarMp _lhsIknTy _ty_q_) of + { _fo_ | _fo_ `seq` (True) -> + (case (foTy _fo_) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_7 :: T_PatExpr_7 + sem_PatExpr_TypeAs_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIcpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_TypeAs_8 :: T_PatExpr_8 + sem_PatExpr_TypeAs_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq `Seq.union` _patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_patExprIpp >#< "::" >#< _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [ _patExprIerrSq, _tyExprIerrSq + , foErrSq _fo_ + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp `mentrelFilterMpUnion` _patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_TypeAs_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_TypeAs_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_TypeAs_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_TypeAs_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_TypeAs_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_TypeAs_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_TypeAs_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }) }) }))) + in sem_PatExpr_TypeAs_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) }) + +sem_PatExpr_SConst :: Range -> + String -> + T_PatExpr + +sem_PatExpr_SConst hsrange_ str_ | hsrange_ `seq` (str_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_SConst_1 :: T_PatExpr_1 + sem_PatExpr_SConst_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup190 | __tup190 `seq` (True) -> + (case (__tup190) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_SConst_2 :: T_PatExpr_2 + sem_PatExpr_SConst_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_SConst_3 :: T_PatExpr_3 + sem_PatExpr_SConst_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_SConst_4 :: T_PatExpr_4 + sem_PatExpr_SConst_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup190) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_SConst_5 :: T_PatExpr_5 + sem_PatExpr_SConst_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_SConst_6 :: T_PatExpr_6 + sem_PatExpr_SConst_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (tyString _lhsIopts) of + { _constTy | _constTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _lhsIfiOpts _fe _lUniq _lhsIpatTyVarMp _lhsIknTy _constTy) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_SConst_7 :: T_PatExpr_7 + sem_PatExpr_SConst_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_constTy) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_SConst_8 :: T_PatExpr_8 + sem_PatExpr_SConst_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp (show str_)) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Int _cpNm _acorety (-1)) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_SConst_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_SConst_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) })))))))) + in sem_PatExpr_SConst_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_SConst_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }))))))) + in sem_PatExpr_SConst_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) })))))))))) + in sem_PatExpr_SConst_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }))))) + in sem_PatExpr_SConst_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }))) + in sem_PatExpr_SConst_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) + +sem_PatExpr_Rec :: Range -> + T_RecPatExpr -> + T_PatExpr + +sem_PatExpr_Rec hsrange_ recPatExpr_ | hsrange_ `seq` (recPatExpr_ `seq` (True)) = + (case (recPatExpr_) of + { ( _recPatExprIrange,recPatExpr_1) | True -> + (case (rangeUnions [hsrange_, _recPatExprIrange + , _recPatExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Rec_1 :: T_PatExpr_1 + sem_PatExpr_Rec_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup191 | __tup191 `seq` (True) -> + (case (__tup191) of + { (_recPatExprOgUniq,_) | _recPatExprOgUniq `seq` (True) -> + (case (recPatExpr_1 _recPatExprOgUniq) of + { ( _recPatExprIgUniq,recPatExpr_2) | True -> + (case (_recPatExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Rec_2 :: T_PatExpr_2 + sem_PatExpr_Rec_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _recPatExprOpredSameScopeCounter | _recPatExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _recPatExprOlexLev | _recPatExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _recPatExprOkiGam | _recPatExprOkiGam `seq` (True) -> + (case (recPatExpr_2 _recPatExprOkiGam _recPatExprOlexLev _recPatExprOpredSameScopeCounter) of + { ( _recPatExprIpredSameScopeCounter,recPatExpr_3) | True -> + (case (_recPatExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Rec_3 :: T_PatExpr_3 + sem_PatExpr_Rec_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _recPatExprOtyKiGlobFreeTvarS | _recPatExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _recPatExprOtyKiGam | _recPatExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _recPatExprOtyGam | _recPatExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _recPatExprOpredScope | _recPatExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _recPatExprOpolVarMp | _recPatExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _recPatExprOpolGam | _recPatExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _recPatExprOopts | _recPatExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _recPatExprOkiVarMp | _recPatExprOkiVarMp `seq` (True) -> + (case (recPatExpr_3 _recPatExprOkiVarMp _recPatExprOopts _recPatExprOpolGam _recPatExprOpolVarMp _recPatExprOpredScope _recPatExprOtyGam _recPatExprOtyKiGam _recPatExprOtyKiGlobFreeTvarS) of + { ( _recPatExprIkiVarMp,_recPatExprIpolVarMp,_recPatExprItyGam,_recPatExprItyKiGam,recPatExpr_4) | True -> + (case (_recPatExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_recPatExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_recPatExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_recPatExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Rec_4 :: T_PatExpr_4 + sem_PatExpr_Rec_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _recPatExprOtyTyTySigFreeTvarS | _recPatExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _recPatExprOfinTyKiGam | _recPatExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _recPatExprOfinKiVarMp | _recPatExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _recPatExprOdataGam | _recPatExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _recPatExprOclGam | _recPatExprOclGam `seq` (True) -> + (case (positionalFldNames) of + { _recPatExprOpositionalFldNmL | _recPatExprOpositionalFldNmL `seq` (True) -> + (case (recPatExpr_4 _recPatExprOclGam _recPatExprOdataGam _recPatExprOfinKiVarMp _recPatExprOfinTyKiGam _recPatExprOpositionalFldNmL _recPatExprOtyTyTySigFreeTvarS) of + { ( _recPatExprIchrInstDeclSq,_recPatExprIhasAFldRef,_recPatExprIpositionalFldNmL,recPatExpr_5) | True -> + (case (_recPatExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup191) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Rec_5 :: T_PatExpr_5 + sem_PatExpr_Rec_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Rec_6 :: T_PatExpr_6 + sem_PatExpr_Rec_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsIvalGam) of + { _recPatExprOvalGam | _recPatExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _recPatExprOtySigGam | _recPatExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _recPatExprOpatTyVarMp | _recPatExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _recPatExprOknTy | _recPatExprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _recPatExprOfiOpts | _recPatExprOfiOpts `seq` (True) -> + (case (_recPatExprIhasAFldRef) of + { _recPatExprOmatchOnFld | _recPatExprOmatchOnFld `seq` (True) -> + (case (recPatExpr_5 _recPatExprOfiOpts _recPatExprOknTy _recPatExprOmatchOnFld _recPatExprOpatTyVarMp _recPatExprOtySigGam _recPatExprOvalGam) of + { ( _recPatExprIpatTyVarMp,_recPatExprIvalGam,recPatExpr_6) | True -> + (case (_recPatExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_recPatExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Rec_7 :: T_PatExpr_7 + sem_PatExpr_Rec_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _recPatExprOvalTyGlobFreeTvarS | _recPatExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _recPatExprOtyVarMp | _recPatExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _recPatExprOtyTyGlobFreeTvarS | _recPatExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _recPatExprOtvKiVarMp | _recPatExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _recPatExprOclDfGam | _recPatExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _recPatExprOchrStore | _recPatExprOchrStore `seq` (True) -> + (case (recPatExpr_6 _recPatExprOchrStore _recPatExprOclDfGam _recPatExprOtvKiVarMp _recPatExprOtyTyGlobFreeTvarS _recPatExprOtyVarMp _recPatExprOvalTyGlobFreeTvarS) of + { ( _recPatExprIgathCnstrMp,_recPatExprIgathRangeMp,_recPatExprIscopeGam,_recPatExprIty,_recPatExprItyVarMp,recPatExpr_7) | True -> + (case (_recPatExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_recPatExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_recPatExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_recPatExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_recPatExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Rec_8 :: T_PatExpr_8 + sem_PatExpr_Rec_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _recPatExprOsysfEnv | _recPatExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _recPatExprOrangeMp | _recPatExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _recPatExprOfinValGam | _recPatExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _recPatExprOfinTyVarMp | _recPatExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _recPatExprOtySigVarMp | _recPatExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _recPatExprOmoduleNm | _recPatExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _recPatExprOchrScopeBindMp | _recPatExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _recPatExprOchrEvidBindMp | _recPatExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _recPatExprOceParentNm | _recPatExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _recPatExprOcSubst | _recPatExprOcSubst `seq` (True) -> + (case (recPatExpr_7 _recPatExprOcSubst _recPatExprOceParentNm _recPatExprOchrEvidBindMp _recPatExprOchrScopeBindMp _recPatExprOfinTyVarMp _recPatExprOfinValGam _recPatExprOmoduleNm _recPatExprOrangeMp _recPatExprOsysfEnv _recPatExprOtySigVarMp) of + { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppL,_recPatExprIvalCBindL) | True -> + (case (_recPatExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (reverse _recPatExprIppL) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_recPatExprIpp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_recPatExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_recPatExprIextNm) of + { _appFunNm | _appFunNm `seq` (True) -> + (case (ppAppTop (hsnRec,mkPPAppFun _appFunNm _recPatExprIpp) + (reverse _recPatExprIppL) _recPatExprIpp) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [_recPatExprIerrSq]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_recPatExprIfsRPatL) of + { _fsRPatL | _fsRPatL `seq` (True) -> + (case (_fsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_recPatExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_recPatExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case (fsL2PatOffsetL _lhsIopts $ rowCanonOrderBy compare $ _fsRPatL) of + { _rpatBinds | _rpatBinds `seq` (True) -> + (case (_recPatExprIpatCRest) of + { _rest | _rest `seq` (True) -> + (case (CTagRec) of + { _tag | _tag `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (case _rest of + CPatRest_Empty + -> RPat_Con _cpNm _acorety _tag (RPatConBind_One _rest (map fst _rpatBinds)) + CPatRest_Var r + -> RPat_Con _cpNm _acorety _tag (RPatConBind_One _rest pbL) + where pbL = map fst $ fsL2PatOffsetL _lhsIopts $ fsLReorder _lhsIopts $ reverse $ _fsRPatL) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ((emptyRCEEnv _lhsIopts) { rceValGam = _lhsIvalGam, rceDataGam = _lhsIdataGam, rceTyVarMp = _lhsIfinTyVarMp }) of + { _rceEnv | _rceEnv `seq` (True) -> + (case (_recPatExprIvalCBindL) of + { _valCBindLSub | _valCBindLSub `seq` (True) -> + (case (acoreRPatBindL2BindL _rceEnv (not $ null _valCBindLSub) _lhsIceParentNm _tag (Just (_rest,length _fsRPatL)) _rpatBinds) of + { _valCBindL | _valCBindL `seq` (True) -> + (case (_valCBindL ++ _valCBindLSub) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Rec_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Rec_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Rec_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_Rec_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Rec_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Rec_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_Rec_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Rec_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_DataFields :: Range -> + T_DataFieldPatExpr -> + T_PatExpr + +sem_PatExpr_DataFields hsrange_ dataFieldPatExpr_ | hsrange_ `seq` (dataFieldPatExpr_ `seq` (True)) = + (case (dataFieldPatExpr_) of + { ( _dataFieldPatExprIrange,dataFieldPatExpr_1) | True -> + (case (rangeUnions [hsrange_, _dataFieldPatExprIrange + , _dataFieldPatExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_DataFields_1 :: T_PatExpr_1 + sem_PatExpr_DataFields_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup193 | __tup193 `seq` (True) -> + (case (__tup193) of + { (_dataFieldPatExprOgUniq,_) | _dataFieldPatExprOgUniq `seq` (True) -> + (case (dataFieldPatExpr_1 _dataFieldPatExprOgUniq) of + { ( _dataFieldPatExprIgUniq,dataFieldPatExpr_2) | True -> + (case (_dataFieldPatExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_DataFields_2 :: T_PatExpr_2 + sem_PatExpr_DataFields_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _dataFieldPatExprOpredSameScopeCounter | _dataFieldPatExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _dataFieldPatExprOlexLev | _dataFieldPatExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _dataFieldPatExprOkiGam | _dataFieldPatExprOkiGam `seq` (True) -> + (case (dataFieldPatExpr_2 _dataFieldPatExprOkiGam _dataFieldPatExprOlexLev _dataFieldPatExprOpredSameScopeCounter) of + { ( _dataFieldPatExprIpredSameScopeCounter,dataFieldPatExpr_3) | True -> + (case (_dataFieldPatExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_DataFields_3 :: T_PatExpr_3 + sem_PatExpr_DataFields_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _dataFieldPatExprOtyKiGlobFreeTvarS | _dataFieldPatExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _dataFieldPatExprOtyKiGam | _dataFieldPatExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _dataFieldPatExprOtyGam | _dataFieldPatExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _dataFieldPatExprOpredScope | _dataFieldPatExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _dataFieldPatExprOpolVarMp | _dataFieldPatExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _dataFieldPatExprOpolGam | _dataFieldPatExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _dataFieldPatExprOopts | _dataFieldPatExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _dataFieldPatExprOkiVarMp | _dataFieldPatExprOkiVarMp `seq` (True) -> + (case (dataFieldPatExpr_3 _dataFieldPatExprOkiVarMp _dataFieldPatExprOopts _dataFieldPatExprOpolGam _dataFieldPatExprOpolVarMp _dataFieldPatExprOpredScope _dataFieldPatExprOtyGam _dataFieldPatExprOtyKiGam _dataFieldPatExprOtyKiGlobFreeTvarS) of + { ( _dataFieldPatExprIkiVarMp,_dataFieldPatExprIpolVarMp,_dataFieldPatExprItyGam,_dataFieldPatExprItyKiGam,dataFieldPatExpr_4) | True -> + (case (_dataFieldPatExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_dataFieldPatExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_dataFieldPatExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_dataFieldPatExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_DataFields_4 :: T_PatExpr_4 + sem_PatExpr_DataFields_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _dataFieldPatExprOtyTyTySigFreeTvarS | _dataFieldPatExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _dataFieldPatExprOfinTyKiGam | _dataFieldPatExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _dataFieldPatExprOfinKiVarMp | _dataFieldPatExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _dataFieldPatExprOdataGam | _dataFieldPatExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _dataFieldPatExprOclGam | _dataFieldPatExprOclGam `seq` (True) -> + (case (dataFieldPatExpr_4 _dataFieldPatExprOclGam _dataFieldPatExprOdataGam _dataFieldPatExprOfinKiVarMp _dataFieldPatExprOfinTyKiGam _dataFieldPatExprOtyTyTySigFreeTvarS) of + { ( _dataFieldPatExprIchrInstDeclSq,dataFieldPatExpr_5) | True -> + (case (_dataFieldPatExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup193) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_DataFields_5 :: T_PatExpr_5 + sem_PatExpr_DataFields_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_DataFields_6 :: T_PatExpr_6 + sem_PatExpr_DataFields_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsIvalGam) of + { _dataFieldPatExprOvalGam | _dataFieldPatExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _dataFieldPatExprOtySigGam | _dataFieldPatExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _dataFieldPatExprOpatTyVarMp | _dataFieldPatExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _dataFieldPatExprOknTy | _dataFieldPatExprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _dataFieldPatExprOfiOpts | _dataFieldPatExprOfiOpts `seq` (True) -> + (case (dataFieldPatExpr_5 _dataFieldPatExprOfiOpts _dataFieldPatExprOknTy _dataFieldPatExprOpatTyVarMp _dataFieldPatExprOtySigGam _dataFieldPatExprOvalGam) of + { ( _dataFieldPatExprIpatTyVarMp,_dataFieldPatExprIvalGam,dataFieldPatExpr_6) | True -> + (case (_dataFieldPatExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_dataFieldPatExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_DataFields_7 :: T_PatExpr_7 + sem_PatExpr_DataFields_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _dataFieldPatExprOvalTyGlobFreeTvarS | _dataFieldPatExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _dataFieldPatExprOtyVarMp | _dataFieldPatExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _dataFieldPatExprOtyTyGlobFreeTvarS | _dataFieldPatExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _dataFieldPatExprOtvKiVarMp | _dataFieldPatExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _dataFieldPatExprOclDfGam | _dataFieldPatExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _dataFieldPatExprOchrStore | _dataFieldPatExprOchrStore `seq` (True) -> + (case (dataFieldPatExpr_6 _dataFieldPatExprOchrStore _dataFieldPatExprOclDfGam _dataFieldPatExprOtvKiVarMp _dataFieldPatExprOtyTyGlobFreeTvarS _dataFieldPatExprOtyVarMp _dataFieldPatExprOvalTyGlobFreeTvarS) of + { ( _dataFieldPatExprIgathCnstrMp,_dataFieldPatExprIgathRangeMp,_dataFieldPatExprIscopeGam,_dataFieldPatExprIty,_dataFieldPatExprItyVarMp,dataFieldPatExpr_7) | True -> + (case (_dataFieldPatExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_dataFieldPatExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_dataFieldPatExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_dataFieldPatExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_dataFieldPatExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_DataFields_8 :: T_PatExpr_8 + sem_PatExpr_DataFields_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _dataFieldPatExprOsysfEnv | _dataFieldPatExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _dataFieldPatExprOrangeMp | _dataFieldPatExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _dataFieldPatExprOfinValGam | _dataFieldPatExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _dataFieldPatExprOfinTyVarMp | _dataFieldPatExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _dataFieldPatExprOtySigVarMp | _dataFieldPatExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _dataFieldPatExprOmoduleNm | _dataFieldPatExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _dataFieldPatExprOchrScopeBindMp | _dataFieldPatExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _dataFieldPatExprOchrEvidBindMp | _dataFieldPatExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _dataFieldPatExprOceParentNm | _dataFieldPatExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _dataFieldPatExprOcSubst | _dataFieldPatExprOcSubst `seq` (True) -> + (case (dataFieldPatExpr_7 _dataFieldPatExprOcSubst _dataFieldPatExprOceParentNm _dataFieldPatExprOchrEvidBindMp _dataFieldPatExprOchrScopeBindMp _dataFieldPatExprOfinTyVarMp _dataFieldPatExprOfinValGam _dataFieldPatExprOmoduleNm _dataFieldPatExprOrangeMp _dataFieldPatExprOsysfEnv _dataFieldPatExprOtySigVarMp) of + { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppL,_dataFieldPatExprIvalCBindL) | True -> + (case (_dataFieldPatExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_dataFieldPatExprIpp >#< ppCurlysCommas' (reverse _dataFieldPatExprIppL)) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_dataFieldPatExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_dataFieldPatExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_dataFieldPatExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_dataFieldPatExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case (_dataFieldPatExprIfsRPatL) of + { _fsRPatL | _fsRPatL `seq` (True) -> + (case (dtiCTag _dataFieldPatExprIdti) of + { _tag | _tag `seq` (True) -> + (case (let fsL = reverse _fsRPatL + grp = groupByOn (\o1 o2 -> (foffOffset o1 `compare` foffOffset o2) /= GT) fst + max = ctagArity _tag - 1 + sat = + listSaturateWith 0 max (foffOffset . fst) $ + (map (\(n,o) -> (fldInt o, (FldKnownOffset n (fldInt o),RPat_Var (RPatNmOrig n) (acoreTyErr $ "EH.ToCore.PatExpr.DataFields: " ++ show n) False))) (refGen 0 1 $ take (max+1) hsnLclSupply)) + in ( map (fsL2PatOffsetL _lhsIopts . sat) $ grp fsL + , fsL2PatOffsetL _lhsIopts fsL + , fsL2PatOffsetL _lhsIopts $ sat [] + )) of + { __tup192 | __tup192 `seq` (True) -> + (case (__tup192) of + { (_,_,_rpatBind0) | _rpatBind0 `seq` (True) -> + (case (__tup192) of + { (_rpatBindss,_,_) | _rpatBindss `seq` (True) -> + (case (_dataFieldPatExprIpatCRest) of + { _rest | _rest `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Con _cpNm _acorety _tag + (rpatConBindUnFlatten (RPatConBind_One _rest $ map fst _rpatBind0) + $ map (RPatConBind_One _rest . map fst) + _rpatBindss + )) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ((emptyRCEEnv _lhsIopts) { rceValGam = _lhsIvalGam, rceDataGam = _lhsIdataGam, rceTyVarMp = _lhsIfinTyVarMp }) of + { _rceEnv | _rceEnv `seq` (True) -> + (case (_dataFieldPatExprIvalCBindL) of + { _valCBindLSub | _valCBindLSub `seq` (True) -> + (case (__tup192) of + { (_,_rpatBindsNonSat,_) | _rpatBindsNonSat `seq` (True) -> + (case (acoreRPatBindL2BindL _rceEnv (not $ null _valCBindLSub) _lhsIceParentNm _tag (Just (_rest,ctagArity _tag)) _rpatBindsNonSat) of + { _valCBindL | _valCBindL `seq` (True) -> + (case (_valCBindL ++ _valCBindLSub) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_DataFields_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_DataFields_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_DataFields_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_DataFields_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_DataFields_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_DataFields_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_DataFields_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_DataFields_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_Irrefutable :: Range -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_Irrefutable hsrange_ patExpr_ | hsrange_ `seq` (patExpr_ `seq` (True)) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_1 :: T_PatExpr_1 + sem_PatExpr_Irrefutable_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup194 | __tup194 `seq` (True) -> + (case (__tup194) of + { (_patExprOgUniq,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_2 :: T_PatExpr_2 + sem_PatExpr_Irrefutable_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_3 :: T_PatExpr_3 + sem_PatExpr_Irrefutable_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_4 :: T_PatExpr_4 + sem_PatExpr_Irrefutable_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_patExprItopNm) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_5 :: T_PatExpr_5 + sem_PatExpr_Irrefutable_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (_patExprImbTopNm) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_6 :: T_PatExpr_6 + sem_PatExpr_Irrefutable_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_7 :: T_PatExpr_7 + sem_PatExpr_Irrefutable_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Irrefutable_8 :: T_PatExpr_8 + sem_PatExpr_Irrefutable_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ("~" >|< _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_lhsIfinTyVarMp `varUpd` _ty) of + { _finalTy | _finalTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (tyCanonicFFI (emptyTyBetaRedEnv' _fe) _finalTy) of + { _finalTyExpanded | _finalTyExpanded `seq` (True) -> + (case ((appDbg "{Expr,PatExpr,Decl,DataFieldExpr}.sysfty not implemented" :: SysfTy)) of + { _sysfty | _sysfty `seq` (True) -> + (case (mkCTy _lhsIopts _finalTyExpanded _sysfty) of + { _acorety | _acorety `seq` (True) -> + (case (RPat_Irrefutable _cpNm _acorety _patExprIvalCBindL) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Irrefutable_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Irrefutable_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Irrefutable_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_Irrefutable_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Irrefutable_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Irrefutable_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_Irrefutable_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Irrefutable_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_Bang :: Range -> + T_PatExpr -> + T_PatExpr + +sem_PatExpr_Bang hsrange_ patExpr_ | hsrange_ `seq` (patExpr_ `seq` (True)) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Bang_1 :: T_PatExpr_1 + sem_PatExpr_Bang_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup195 | __tup195 `seq` (True) -> + (case (__tup195) of + { (_patExprOgUniq,_) | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Bang_2 :: T_PatExpr_2 + sem_PatExpr_Bang_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Bang_3 :: T_PatExpr_3 + sem_PatExpr_Bang_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Bang_4 :: T_PatExpr_4 + sem_PatExpr_Bang_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_patExprItopNm) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Bang_5 :: T_PatExpr_5 + sem_PatExpr_Bang_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (_patExprIarity) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (_patExprImbTopNm) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (_patExprIpatFunTy) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Bang_6 :: T_PatExpr_6 + sem_PatExpr_Bang_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTyL) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIinclVarBind) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Bang_7 :: T_PatExpr_7 + sem_PatExpr_Bang_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Bang_8 :: T_PatExpr_8 + sem_PatExpr_Bang_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ("!" >|< _patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (True) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (case _patExprIrpat of + r@(RPat_Var _ _ _) -> r {rcpMustEval = True} + r -> r) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Bang_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Bang_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Bang_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }) }) }))) + in sem_PatExpr_Bang_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Bang_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Bang_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }))))) + in sem_PatExpr_Bang_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Bang_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + +sem_PatExpr_Expr :: Range -> + T_Expr -> + (Maybe SrcConst) -> + T_PatExpr + +sem_PatExpr_Expr hsrange_ expr_ mbConst_ | hsrange_ `seq` (expr_ `seq` (mbConst_ `seq` (True))) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (rangeUnions [hsrange_, _exprIrange , _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PatExpr_Expr_1 :: T_PatExpr_1 + sem_PatExpr_Expr_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_97_fitsIn_ty) -> case nextUnique __cont of { (__cont, lUniq_cexpr) -> (__cont,lUniq,lUniq_97_fitsIn_ty,lUniq_cexpr)}}} )) of + { __tup198 | __tup198 `seq` (True) -> + (case (__tup198) of + { (_exprOgUniq,_,_,_) | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PatExpr_Expr_2 :: T_PatExpr_2 + sem_PatExpr_Expr_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_PatExpr_Expr_3 :: T_PatExpr_3 + sem_PatExpr_Expr_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PatExpr_Expr_4 :: T_PatExpr_4 + sem_PatExpr_Expr_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (emptyGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (__tup198) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (uidHNm _lUniq) of + { _topNm | _topNm `seq` (True) -> + (case (_topNm) of + { _lhsOtopNm | _lhsOtopNm `seq` (True) -> + (case ((let sem_PatExpr_Expr_5 :: T_PatExpr_5 + sem_PatExpr_Expr_5 = + (\ _lhsIvalGam -> + _lhsIvalGam `seq` + ((case (0) of + { _lhsOarity | _lhsOarity `seq` (True) -> + (case (Nothing) of + { _mbTopNm | _mbTopNm `seq` (True) -> + (case (_mbTopNm) of + { _lhsOmbTopNm | _lhsOmbTopNm `seq` (True) -> + (case (Ty_Any) of + { _lhsOpatFunTy | _lhsOpatFunTy `seq` (True) -> + (case ((let sem_PatExpr_Expr_6 :: T_PatExpr_6 + sem_PatExpr_Expr_6 = + (\ _lhsIfiOpts + _lhsIinclVarBind + _lhsIknTy + _lhsIknTyL + _lhsIpatTyVarMp + _lhsItySigGam -> + _lhsIfiOpts `seq` + (_lhsIinclVarBind `seq` + (_lhsIknTy `seq` + (_lhsIknTyL `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + ((case (_lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_PatExpr_Expr_7 :: T_PatExpr_7 + sem_PatExpr_Expr_7 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (maybe (RPatNmUniq _topNm) RPatNmOrig _mbTopNm) of + { _cpNm | _cpNm `seq` (True) -> + (case (_cpNm) of + { _lhsOcpNm | _lhsOcpNm `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (__tup198) of + { (_,_,_lUniq_97_fitsIn_ty,_) | _lUniq_97_fitsIn_ty `seq` (True) -> + (case (mkTyVar _lUniq) of + { _knExprTy | _knExprTy `seq` (True) -> + (case (ehcOptBuiltin _lhsIopts ehbnClassEqFldEq) of + { _eqFldNm | _eqFldNm `seq` (True) -> + (case (valGamLookupTy _eqFldNm _lhsIvalGam) of + { __tup197 | __tup197 `seq` (True) -> + (case (__tup197) of + { (_eqTy,_) | _eqTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn strongFIOpts _fe _lUniq_97_fitsIn_ty _lhsItyVarMp + _eqTy + ([_knExprTy,_lhsIknTy] `appArr` (appCon $ ehcOptBuiltin _lhsIopts ehbnDataBool))) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (_knExprTy) of + { _exprOknTy | _exprOknTy `seq` (True) -> + (case (foGathCnstrMp _fo_) of + { _hereCnstrMp | _hereCnstrMp `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (cnstrMpUnions [_hereCnstrMp, _exprIgathCnstrMp]) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_exprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_PatExpr_Expr_8 :: T_PatExpr_8 + sem_PatExpr_Expr_8 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ("`" >|< _exprIpp >|< "`") of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (__tup198) of + { (_,_,_,_lUniq_cexpr) | _lUniq_cexpr `seq` (True) -> + (case (acoreVar _eqFldNm) of + { _cexprBaseEq | _cexprBaseEq `seq` (True) -> + (case (let (e,s) = foAppLRCoeAsSubst _lhsIopts _lUniq_cexpr _fo_ _lhsIfinTyVarMp _exprIcSubst _cexprBaseEq + in (acoreApp e [_exprIcexpr], s)) of + { __tup196 | __tup196 `seq` (True) -> + (case (__tup196) of + { (_,_cexprpatCSubst) | _cexprpatCSubst `seq` (True) -> + (case (cSubstApp _exprIcSubst _cexprpatCSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (__tup197) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [ _exprIerrSq + , Seq.fromList _nmErrs, foErrSq _fo_ + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Val _eqFldNm + `mentrelFilterMpUnion` + tyUsedNames _lhsImoduleNm _eqTy) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisBang | _lhsOisBang `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (__tup196) of + { (_cexpr,_) | _cexpr `seq` (True) -> + (case (RPat_BoolExpr _cpNm (acoreTyErr "EH.ToCore.PatExpr.Expr") _cexpr mbConst_) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_PatExpr_Expr_8)) of + { ( sem_PatExpr_8) | True -> + ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_PatExpr_Expr_7)) of + { ( sem_PatExpr_7) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_PatExpr_7) }) }) })))))))) + in sem_PatExpr_Expr_6)) of + { ( sem_PatExpr_6) | True -> + ( _lhsOarity,_lhsOmbTopNm,_lhsOpatFunTy,sem_PatExpr_6) }) }) }) }) }))) + in sem_PatExpr_Expr_5)) of + { ( sem_PatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOtopNm,sem_PatExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_PatExpr_Expr_4)) of + { ( sem_PatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_PatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_PatExpr_Expr_3)) of + { ( sem_PatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_PatExpr_3) }) }) }) }) }) }) }))))) + in sem_PatExpr_Expr_2)) of + { ( sem_PatExpr_2) | True -> + ( _lhsOgUniq,sem_PatExpr_2) }) }) }) }) }))) + in sem_PatExpr_Expr_1)) of + { ( sem_PatExpr_1) | True -> + ( _lhsOrange,sem_PatExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs @@ -0,0 +1,101 @@ + + + +module UHC.Light.Compiler.EH.MainAG_PatExprAnn where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- PatExprAnn -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Empty: + visit 0: + local pp : _ +-} +sem_PatExprAnn_Empty :: T_PatExprAnn + +sem_PatExprAnn_Empty = + (case (empty) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOpp) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs @@ -0,0 +1,1690 @@ + + + +module UHC.Light.Compiler.EH.MainAG_PrExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- PrExpr ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + tyGam : TyGam + synthesized attributes: + prTy : Ty + ty : Ty + visit 3: + inherited attribute: + knPolCtx : Polarity + synthesized attribute: + polVarL : [Polarity] + visit 4: + inherited attribute: + polGam : PolGam + chained attribute: + polVarMp : VarMp + visit 5: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 6: + chained attribute: + kiVarMp : VarMp + synthesized attributes: + gathTyVarPolGam : PolGam + ki : Ty + tyVarWildMp : TyVarWildMp + visit 7: + inherited attribute: + clGam : ClGam + synthesized attribute: + evTy : Ty + visit 8: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + pr : Pred + alternatives: + alternative Class: + child hsrange : {Range} + child nm : {HsName} + child tyExprs : TyExprs + visit 0: + local range : {Range} + visit 1: + local _tup201 : _ + intra range : {Range} + visit 2: + local pr : {Pred} + local ty : {Ty} + local prTy : _ + intra _tup201 : _ + intra range : {Range} + visit 3: + intra _tup201 : _ + intra ty : {Ty} + intra range : {Range} + intra pr : {Pred} + visit 4: + intra _tup201 : _ + intra ty : {Ty} + intra range : {Range} + intra pr : {Pred} + visit 5: + intra _tup201 : _ + intra ty : {Ty} + intra range : {Range} + intra pr : {Pred} + visit 6: + local lUniq : {UID} + local _tup200 : _ + local tkgi_ : {TyKiGamInfo} + local fo_ : {FIOut} + intra _tup201 : _ + intra ty : {Ty} + intra range : {Range} + intra pr : {Pred} + visit 7: + local lUniq3 : {UID} + local lUniq2 : {UID} + local fe2 : _ + local _tup199 : _ + local clgi : {ClGamInfo} + intra _tup201 : _ + intra ty : {Ty} + intra _tup200 : _ + intra range : {Range} + intra fo_ : {FIOut} + intra pr : {Pred} + visit 8: + local clMissNmS : {Set HsName} + local clNmS : {Set HsName} + local clKiNmErrs : {ErrL} + local nmErrs : {ErrL} + local pp : _ + local gathMentrelFilterMp : _ + intra _tup199 : _ + intra _tup200 : _ + intra range : {Range} + intra fo_ : {FIOut} + intra pr : {Pred} + alternative Arrow: + child hsrange : {Range} + child arg : PrExpr + child res : PrExpr + visit 0: + local range : {Range} + visit 2: + local prTy : _ + local pr : {Pred} + local ty : {Ty} + visit 3: + intra pr : {Pred} + visit 4: + intra pr : {Pred} + visit 5: + intra pr : {Pred} + visit 6: + intra pr : {Pred} + visit 7: + intra pr : {Pred} + visit 8: + local pp : _ + intra pr : {Pred} + alternative Forall: + child hsrange : {Range} + child tyVar : {HsName} + child prExpr : PrExpr + visit 0: + local range : {Range} + visit 1: + local _tup203 : _ + visit 2: + local lUniq_ki : {UID} + local lUniq : {UID} + local _tup202 : _ + local tgi_ : {TyGamInfo} + local tv : {UID} + local prTy : _ + local pr : {Pred} + local ty : {Ty} + intra _tup203 : _ + visit 3: + intra _tup202 : _ + intra tgi_ : {TyGamInfo} + intra pr : {Pred} + visit 4: + intra _tup202 : _ + intra tgi_ : {TyGamInfo} + intra pr : {Pred} + visit 5: + local tkgi_ : {TyKiGamInfo} + local tyKiGamNew : _ + intra _tup202 : _ + intra tgi_ : {TyGamInfo} + intra pr : {Pred} + visit 6: + intra pr : {Pred} + visit 7: + intra pr : {Pred} + visit 8: + local pp : _ + intra pr : {Pred} + alternative Lacks: + child hsrange : {Range} + child rowTyExpr : RowTyExpr + child nm : {HsName} + visit 0: + local range : {Range} + visit 2: + local pr : {Pred} + local ty : {Ty} + local prTy : _ + visit 3: + intra pr : {Pred} + visit 4: + intra pr : {Pred} + visit 5: + intra pr : {Pred} + visit 6: + intra pr : {Pred} + visit 7: + intra pr : {Pred} + visit 8: + local pp : _ + intra pr : {Pred} + alternative DynVar: + child hsrange : {Range} + child nm : {HsName} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 2: + local pr : {Pred} + local ty : {Ty} + local prTy : _ + visit 3: + intra pr : {Pred} + visit 4: + intra pr : {Pred} + visit 5: + intra pr : {Pred} + visit 6: + intra pr : {Pred} + visit 7: + intra pr : {Pred} + visit 8: + local pp : _ + intra pr : {Pred} + alternative Eq: + child hsrange : {Range} + child tyExpr1 : TyExpr + child tyExpr2 : TyExpr + visit 0: + local range : {Range} + visit 1: + local _tup204 : _ + visit 2: + local pr : {Pred} + local ty : {Ty} + local prTy : _ + intra _tup204 : _ + visit 3: + intra _tup204 : _ + intra pr : {Pred} + visit 4: + intra _tup204 : _ + intra pr : {Pred} + visit 5: + intra _tup204 : _ + intra pr : {Pred} + visit 6: + local lUniq : {UID} + local fo_ : {FIOut} + intra _tup204 : _ + intra pr : {Pred} + visit 7: + intra pr : {Pred} + visit 8: + local pp : _ + intra pr : {Pred} +-} +sem_PrExpr_Class :: Range -> + HsName -> + T_TyExprs -> + T_PrExpr + +sem_PrExpr_Class hsrange_ nm_ tyExprs_ | hsrange_ `seq` (nm_ `seq` (tyExprs_ `seq` (True))) = + (case (tyExprs_) of + { ( _tyExprsIrange,tyExprs_1) | True -> + (case (rangeUnions [hsrange_, _tyExprsIrange, _tyExprsIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_Class_1 :: T_PrExpr_1 + sem_PrExpr_Class_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} )) of + { __tup201 | __tup201 `seq` (True) -> + (case (__tup201) of + { (_tyExprsOgUniq,_,_,_) | _tyExprsOgUniq `seq` (True) -> + (case (tyExprs_1 _tyExprsOgUniq) of + { ( _tyExprsIgUniq,tyExprs_2) | True -> + (case (_tyExprsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_Class_2 :: T_PrExpr_2 + sem_PrExpr_Class_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExprsOtyGam | _tyExprsOtyGam `seq` (True) -> + (case (tyExprs_2 _tyExprsOtyGam) of + { ( _tyExprsIpolVarL,_tyExprsItyGam,_tyExprsItyL,tyExprs_3) | True -> + (case (Pred_Class (nm_ `appConApp` _tyExprsItyL)) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExprsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_Class_3 :: T_PrExpr_3 + sem_PrExpr_Class_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_tyExprsIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_Class_4 :: T_PrExpr_4 + sem_PrExpr_Class_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _tyExprsOpolVarMp | _tyExprsOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprsOpolGam | _tyExprsOpolGam `seq` (True) -> + (case (tyExprs_3 _tyExprsOpolGam _tyExprsOpolVarMp) of + { ( _tyExprsIpolVarMp,tyExprs_4) | True -> + (case (_tyExprsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_Class_5 :: T_PrExpr_5 + sem_PrExpr_Class_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprsOtyKiGam | _tyExprsOtyKiGam `seq` (True) -> + (case (tyExprs_4 _tyExprsOtyKiGam) of + { ( _tyExprsIintlTyKiGam,_tyExprsItyKiGam,tyExprs_5) | True -> + (case (_tyExprsIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_Class_6 :: T_PrExpr_6 + sem_PrExpr_Class_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprsOkiVarMp | _tyExprsOkiVarMp `seq` (True) -> + (case (tyExprs_5 _tyExprsOkiVarMp) of + { ( _tyExprsIgathTyVarPolGam,_tyExprsIkiL,_tyExprsIkiVarMp,_tyExprsItyVarWildMp,tyExprs_6) | True -> + (case (_tyExprsIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiStar) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (__tup201) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (tyKiGamLookupByNameErr (hsnClass2Kind nm_) _lhsItyKiGam) of + { __tup200 | __tup200 `seq` (True) -> + (case (__tup200) of + { (_tkgi_,_) | _tkgi_ `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq _tyExprsIkiVarMp + (_tyExprsIkiL `appArr` kiStar) (tkgiKi _tkgi_)) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _tyExprsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprsItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_Class_7 :: T_PrExpr_7 + sem_PrExpr_Class_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (__tup201) of + { (_,_,_,_lUniq3) | _lUniq3 `seq` (True) -> + (case (__tup201) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (defaultFIEnv + { feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + }) of + { _fe2 | _fe2 `seq` (True) -> + (case (case gamLookup nm_ _lhsIclGam of + Just p -> (p ,Set.singleton nm_ ,Set.empty ) + Nothing -> (emptyCLGI ,Set.empty ,Set.singleton nm_ )) of + { __tup199 | __tup199 `seq` (True) -> + (case (__tup199) of + { (_clgi,_,_) | _clgi `seq` (True) -> + (case (let fo = fitsIn (predFIOpts {fioDontBind = varFreeSet _ty}) _fe2 _lUniq3 (emptyVarMp :: VarMp) + (clgiPrToEvidTy _clgi) ([_ty] `appArr` mkNewTyVar _lUniq2) + in appUnArrRes $ foVarMp fo `varUpd` foTy fo) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_Class_8 :: T_PrExpr_8 + sem_PrExpr_Class_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprsOvalTyGlobFreeTvarS | _tyExprsOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprsOtyTyTySigFreeTvarS | _tyExprsOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprsOtyTyGlobFreeTvarS | _tyExprsOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprsOtyKiGlobFreeTvarS | _tyExprsOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprsOsysfEnv | _tyExprsOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprsOopts | _tyExprsOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprsOmoduleNm | _tyExprsOmoduleNm `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExprsOknPolCtx | _tyExprsOknPolCtx `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprsOkiGam | _tyExprsOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprsOfinTyVarMp | _tyExprsOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprsOfinTyKiGam | _tyExprsOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprsOfinKiVarMp | _tyExprsOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _tyExprsOclGam | _tyExprsOclGam `seq` (True) -> + (case (tyExprs_6 _tyExprsOclGam _tyExprsOfinKiVarMp _tyExprsOfinTyKiGam _tyExprsOfinTyVarMp _tyExprsOkiGam _tyExprsOknPolCtx _tyExprsOmoduleNm _tyExprsOopts _tyExprsOsysfEnv _tyExprsOtyKiGlobFreeTvarS _tyExprsOtyTyGlobFreeTvarS _tyExprsOtyTyTySigFreeTvarS _tyExprsOvalTyGlobFreeTvarS) of + { ( _tyExprsIallErrSq,_tyExprsIclMissNmS,_tyExprsIclNmS,_tyExprsIerrSq,_tyExprsIgathMentrelFilterMp,_tyExprsIpp,_tyExprsIppL) | True -> + (case (_tyExprsIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (__tup199) of + { (_,_,_clMissNmS) | _clMissNmS `seq` (True) -> + (case (_clMissNmS `Set.union` _tyExprsIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (__tup199) of + { (_,_clNmS,_) | _clNmS `seq` (True) -> + (case (_clNmS `Set.union` _tyExprsIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (__tup200) of + { (_,_clKiNmErrs) | _clKiNmErrs `seq` (True) -> + (case (if ehcOptHsChecksInEH _lhsIopts + then rngLift _range checkClNms _clMissNmS + else []) of + { _nmErrs | _nmErrs `seq` (True) -> + (case (ppSpaced (pp nm_ : _tyExprsIppL)) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [ _tyExprsIerrSq + , Seq.fromList $ firstNotEmpty [_nmErrs,_clKiNmErrs], foErrSq _fo_ + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Type nm_ + `mentrelFilterMpUnion` + _tyExprsIgathMentrelFilterMp) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_Class_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }) }) }) }) }) }))) + in sem_PrExpr_Class_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Class_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }))) + in sem_PrExpr_Class_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) })))) + in sem_PrExpr_Class_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }))) + in sem_PrExpr_Class_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Class_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }) }))) + in sem_PrExpr_Class_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) + +sem_PrExpr_Arrow :: Range -> + T_PrExpr -> + T_PrExpr -> + T_PrExpr + +sem_PrExpr_Arrow hsrange_ arg_ res_ | hsrange_ `seq` (arg_ `seq` (res_ `seq` (True))) = + (case (res_) of + { ( _resIrange,res_1) | True -> + (case (arg_) of + { ( _argIrange,arg_1) | True -> + (case (rangeUnions [hsrange_, _argIrange , _resIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_Arrow_1 :: T_PrExpr_1 + sem_PrExpr_Arrow_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _argOgUniq | _argOgUniq `seq` (True) -> + (case (arg_1 _argOgUniq) of + { ( _argIgUniq,arg_2) | True -> + (case (_argIgUniq) of + { _resOgUniq | _resOgUniq `seq` (True) -> + (case (res_1 _resOgUniq) of + { ( _resIgUniq,res_2) | True -> + (case (_resIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_Arrow_2 :: T_PrExpr_2 + sem_PrExpr_Arrow_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _argOtyGam | _argOtyGam `seq` (True) -> + (case (arg_2 _argOtyGam) of + { ( _argIprTy,_argIty,_argItyGam,arg_3) | True -> + (case (_argItyGam) of + { _resOtyGam | _resOtyGam `seq` (True) -> + (case (res_2 _resOtyGam) of + { ( _resIprTy,_resIty,_resItyGam,res_3) | True -> + (case ([_argIprTy] `appArr` _resIprTy) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (Pred_Pred _prTy) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_resItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_Arrow_3 :: T_PrExpr_3 + sem_PrExpr_Arrow_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_lhsIknPolCtx) of + { _resOknPolCtx | _resOknPolCtx `seq` (True) -> + (case (res_3 _resOknPolCtx) of + { ( _resIpolVarL,res_4) | True -> + (case (_resIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_Arrow_4 :: T_PrExpr_4 + sem_PrExpr_Arrow_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _argOpolVarMp | _argOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _argOpolGam | _argOpolGam `seq` (True) -> + (case (mkPolNegate _lhsIknPolCtx) of + { _argOknPolCtx | _argOknPolCtx `seq` (True) -> + (case (arg_3 _argOknPolCtx) of + { ( _argIpolVarL,arg_4) | True -> + (case (arg_4 _argOpolGam _argOpolVarMp) of + { ( _argIpolVarMp,arg_5) | True -> + (case (_argIpolVarMp) of + { _resOpolVarMp | _resOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _resOpolGam | _resOpolGam `seq` (True) -> + (case (res_4 _resOpolGam _resOpolVarMp) of + { ( _resIpolVarMp,res_5) | True -> + (case (_resIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_Arrow_5 :: T_PrExpr_5 + sem_PrExpr_Arrow_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _argOtyKiGam | _argOtyKiGam `seq` (True) -> + (case (arg_5 _argOtyKiGam) of + { ( _argIintlTyKiGam,_argItyKiGam,arg_6) | True -> + (case (_argItyKiGam) of + { _resOtyKiGam | _resOtyKiGam `seq` (True) -> + (case (res_5 _resOtyKiGam) of + { ( _resIintlTyKiGam,_resItyKiGam,res_6) | True -> + (case (_argIintlTyKiGam `gamUnion` _resIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_resItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_Arrow_6 :: T_PrExpr_6 + sem_PrExpr_Arrow_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _argOkiVarMp | _argOkiVarMp `seq` (True) -> + (case (arg_6 _argOkiVarMp) of + { ( _argIgathTyVarPolGam,_argIki,_argIkiVarMp,_argItyVarWildMp,arg_7) | True -> + (case (_argIkiVarMp) of + { _resOkiVarMp | _resOkiVarMp `seq` (True) -> + (case (res_6 _resOkiVarMp) of + { ( _resIgathTyVarPolGam,_resIki,_resIkiVarMp,_resItyVarWildMp,res_7) | True -> + (case (_argIgathTyVarPolGam `gamUnion` _resIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiStar) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_resIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_argItyVarWildMp `Map.union` _resItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_Arrow_7 :: T_PrExpr_7 + sem_PrExpr_Arrow_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _resOclGam | _resOclGam `seq` (True) -> + (case (_lhsIclGam) of + { _argOclGam | _argOclGam `seq` (True) -> + (case (res_7 _resOclGam) of + { ( _resIevTy,res_8) | True -> + (case (arg_7 _argOclGam) of + { ( _argIevTy,arg_8) | True -> + (case ([_argIevTy] `appArr` _resIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_Arrow_8 :: T_PrExpr_8 + sem_PrExpr_Arrow_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _resOvalTyGlobFreeTvarS | _resOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _resOtyTyTySigFreeTvarS | _resOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _resOtyTyGlobFreeTvarS | _resOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _resOtyKiGlobFreeTvarS | _resOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _resOsysfEnv | _resOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _resOopts | _resOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _resOmoduleNm | _resOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _resOkiGam | _resOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _resOfinTyVarMp | _resOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _resOfinTyKiGam | _resOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _resOfinKiVarMp | _resOfinKiVarMp `seq` (True) -> + (case (res_8 _resOfinKiVarMp _resOfinTyKiGam _resOfinTyVarMp _resOkiGam _resOmoduleNm _resOopts _resOsysfEnv _resOtyKiGlobFreeTvarS _resOtyTyGlobFreeTvarS _resOtyTyTySigFreeTvarS _resOvalTyGlobFreeTvarS) of + { ( _resIallErrSq,_resIclMissNmS,_resIclNmS,_resIerrSq,_resIgathMentrelFilterMp,_resIpp,_resIpr) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _argOvalTyGlobFreeTvarS | _argOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _argOtyTyTySigFreeTvarS | _argOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _argOtyTyGlobFreeTvarS | _argOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _argOtyKiGlobFreeTvarS | _argOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _argOsysfEnv | _argOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _argOmoduleNm | _argOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _argOkiGam | _argOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _argOfinTyVarMp | _argOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _argOfinTyKiGam | _argOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> + (case (arg_8 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOkiGam _argOmoduleNm _argOopts _argOsysfEnv _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of + { ( _argIallErrSq,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argIpr) | True -> + (case (_argIallErrSq `Seq.union` _resIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_argIclMissNmS `Set.union` _resIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_argIclNmS `Set.union` _resIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_argIerrSq `Seq.union` _resIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_argIgathMentrelFilterMp `mentrelFilterMpUnion` _resIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_argIpp >#< hsnPrArrow >#< _resIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_Arrow_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }) }) }) }) }))) + in sem_PrExpr_Arrow_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Arrow_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }) }) }))) + in sem_PrExpr_Arrow_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) }) }) }) }) }) })))) + in sem_PrExpr_Arrow_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }) }) }))) + in sem_PrExpr_Arrow_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Arrow_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }) }) }))) + in sem_PrExpr_Arrow_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) }) + +sem_PrExpr_Forall :: Range -> + HsName -> + T_PrExpr -> + T_PrExpr + +sem_PrExpr_Forall hsrange_ tyVar_ prExpr_ | hsrange_ `seq` (tyVar_ `seq` (prExpr_ `seq` (True))) = + (case (prExpr_) of + { ( _prExprIrange,prExpr_1) | True -> + (case (rangeUnions [hsrange_, _prExprIrange , _prExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_Forall_1 :: T_PrExpr_1 + sem_PrExpr_Forall_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_ki)}} )) of + { __tup203 | __tup203 `seq` (True) -> + (case (__tup203) of + { (_prExprOgUniq,_,_) | _prExprOgUniq `seq` (True) -> + (case (prExpr_1 _prExprOgUniq) of + { ( _prExprIgUniq,prExpr_2) | True -> + (case (_prExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_Forall_2 :: T_PrExpr_2 + sem_PrExpr_Forall_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup203) of + { (_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (__tup203) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (let t = mkTyVar _lUniq + in (_lUniq,mkTGI t,TyKiGamInfo (mkNewTyVar _lUniq_ki))) of + { __tup202 | __tup202 `seq` (True) -> + (case (__tup202) of + { (_,_tgi_,_) | _tgi_ `seq` (True) -> + (case (tvGathFlowIn (tyVar_ `gamSingleton` _tgi_) _lhsItyGam) of + { _prExprOtyGam | _prExprOtyGam `seq` (True) -> + (case (__tup202) of + { (_tv,_,_) | _tv `seq` (True) -> + (case (prExpr_2 _prExprOtyGam) of + { ( _prExprIprTy,_prExprIty,_prExprItyGam,prExpr_3) | True -> + (case (mkTyQu tyQu_Forall [(_tv,kiStar)] _prExprIprTy) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (Pred_Pred _prTy) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (tvGathFlowOut _lhsItyGam _prExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_Forall_3 :: T_PrExpr_3 + sem_PrExpr_Forall_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_lhsIknPolCtx) of + { _prExprOknPolCtx | _prExprOknPolCtx `seq` (True) -> + (case (prExpr_3 _prExprOknPolCtx) of + { ( _prExprIpolVarL,prExpr_4) | True -> + (case (_prExprIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_Forall_4 :: T_PrExpr_4 + sem_PrExpr_Forall_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _prExprOpolVarMp | _prExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _prExprOpolGam | _prExprOpolGam `seq` (True) -> + (case (prExpr_4 _prExprOpolGam _prExprOpolVarMp) of + { ( _prExprIpolVarMp,prExpr_5) | True -> + (case (_prExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_Forall_5 :: T_PrExpr_5 + sem_PrExpr_Forall_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup202) of + { (_,_,_tkgi_) | _tkgi_ `seq` (True) -> + (case (tgiTy _tgi_ `tyKiGamSingleton` _tkgi_) of + { _tyKiGamNew | _tyKiGamNew `seq` (True) -> + (case (tvGathFlowIn _tyKiGamNew _lhsItyKiGam) of + { _prExprOtyKiGam | _prExprOtyKiGam `seq` (True) -> + (case (prExpr_5 _prExprOtyKiGam) of + { ( _prExprIintlTyKiGam,_prExprItyKiGam,prExpr_6) | True -> + (case (gamUnions [_tyKiGamNew,_prExprIintlTyKiGam]) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (tvGathFlowOut _lhsItyKiGam _prExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_Forall_6 :: T_PrExpr_6 + sem_PrExpr_Forall_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _prExprOkiVarMp | _prExprOkiVarMp `seq` (True) -> + (case (prExpr_6 _prExprOkiVarMp) of + { ( _prExprIgathTyVarPolGam,_prExprIki,_prExprIkiVarMp,_prExprItyVarWildMp,prExpr_7) | True -> + (case (_prExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiStar) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_prExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_prExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_Forall_7 :: T_PrExpr_7 + sem_PrExpr_Forall_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _prExprOclGam | _prExprOclGam `seq` (True) -> + (case (prExpr_7 _prExprOclGam) of + { ( _prExprIevTy,prExpr_8) | True -> + (case (_prExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_Forall_8 :: T_PrExpr_8 + sem_PrExpr_Forall_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _prExprOvalTyGlobFreeTvarS | _prExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _prExprOtyTyTySigFreeTvarS | _prExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _prExprOtyTyGlobFreeTvarS | _prExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _prExprOtyKiGlobFreeTvarS | _prExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _prExprOsysfEnv | _prExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _prExprOopts | _prExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _prExprOmoduleNm | _prExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _prExprOkiGam | _prExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _prExprOfinTyVarMp | _prExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _prExprOfinTyKiGam | _prExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _prExprOfinKiVarMp | _prExprOfinKiVarMp `seq` (True) -> + (case (prExpr_8 _prExprOfinKiVarMp _prExprOfinTyKiGam _prExprOfinTyVarMp _prExprOkiGam _prExprOmoduleNm _prExprOopts _prExprOsysfEnv _prExprOtyKiGlobFreeTvarS _prExprOtyTyGlobFreeTvarS _prExprOtyTyTySigFreeTvarS _prExprOvalTyGlobFreeTvarS) of + { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIpr) | True -> + (case (_prExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_prExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_prExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_prExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_prExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case ("forall" >#< tyVar_ >#< "." >#< _prExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_Forall_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) + in sem_PrExpr_Forall_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }))) + in sem_PrExpr_Forall_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }) }) }))) + in sem_PrExpr_Forall_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) })))) + in sem_PrExpr_Forall_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }) }) }))) + in sem_PrExpr_Forall_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Forall_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }) }))) + in sem_PrExpr_Forall_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) + +sem_PrExpr_Lacks :: Range -> + T_RowTyExpr -> + HsName -> + T_PrExpr + +sem_PrExpr_Lacks hsrange_ rowTyExpr_ nm_ | hsrange_ `seq` (rowTyExpr_ `seq` (nm_ `seq` (True))) = + (case (rowTyExpr_) of + { ( _rowTyExprIrange,rowTyExpr_1) | True -> + (case (rangeUnions [hsrange_, _rowTyExprIrange + , _rowTyExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_Lacks_1 :: T_PrExpr_1 + sem_PrExpr_Lacks_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _rowTyExprOgUniq | _rowTyExprOgUniq `seq` (True) -> + (case (positionalFldNames) of + { _rowTyExprOpositionalFldNmL | _rowTyExprOpositionalFldNmL `seq` (True) -> + (case (rowTyExpr_1 _rowTyExprOgUniq _rowTyExprOpositionalFldNmL) of + { ( _rowTyExprIgUniq,_rowTyExprIpositionalFldNmL,rowTyExpr_2) | True -> + (case (_rowTyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_Lacks_2 :: T_PrExpr_2 + sem_PrExpr_Lacks_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _rowTyExprOtyGam | _rowTyExprOtyGam `seq` (True) -> + (case (rowTyExpr_2 _rowTyExprOtyGam) of + { ( _rowTyExprItyGam,_rowTyExprItyRow,rowTyExpr_3) | True -> + (case (Pred_Lacks _rowTyExprItyRow (Label_Lab nm_)) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_rowTyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_Lacks_3 :: T_PrExpr_3 + sem_PrExpr_Lacks_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_Lacks_4 :: T_PrExpr_4 + sem_PrExpr_Lacks_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _rowTyExprOpolVarMp | _rowTyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _rowTyExprOpolGam | _rowTyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _rowTyExprOknPolCtx | _rowTyExprOknPolCtx `seq` (True) -> + (case (rowTyExpr_3 _rowTyExprOknPolCtx _rowTyExprOpolGam _rowTyExprOpolVarMp) of + { ( _rowTyExprIpolVarMp,rowTyExpr_4) | True -> + (case (_rowTyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_Lacks_5 :: T_PrExpr_5 + sem_PrExpr_Lacks_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _rowTyExprOtyKiGam | _rowTyExprOtyKiGam `seq` (True) -> + (case (rowTyExpr_4 _rowTyExprOtyKiGam) of + { ( _rowTyExprIintlTyKiGam,_rowTyExprItyKiGam,rowTyExpr_5) | True -> + (case (_rowTyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_rowTyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_Lacks_6 :: T_PrExpr_6 + sem_PrExpr_Lacks_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiStar) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _rowTyExprOkiVarMp | _rowTyExprOkiVarMp `seq` (True) -> + (case (rowTyExpr_5 _rowTyExprOkiVarMp) of + { ( _rowTyExprIkiVarMp,_rowTyExprItyVarWildMp,rowTyExpr_6) | True -> + (case (_rowTyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_rowTyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_Lacks_7 :: T_PrExpr_7 + sem_PrExpr_Lacks_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (tyInt) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_Lacks_8 :: T_PrExpr_8 + sem_PrExpr_Lacks_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _rowTyExprOvalTyGlobFreeTvarS | _rowTyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _rowTyExprOtyTyTySigFreeTvarS | _rowTyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _rowTyExprOtyTyGlobFreeTvarS | _rowTyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _rowTyExprOtyKiGlobFreeTvarS | _rowTyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _rowTyExprOsysfEnv | _rowTyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _rowTyExprOopts | _rowTyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _rowTyExprOmoduleNm | _rowTyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _rowTyExprOkiGam | _rowTyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _rowTyExprOfinTyVarMp | _rowTyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _rowTyExprOfinTyKiGam | _rowTyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _rowTyExprOfinKiVarMp | _rowTyExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> + (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL) | True -> + (case (_rowTyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_rowTyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_rowTyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_rowTyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_rowTyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_rowTyExprIpp >|< "\\" >|< pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_Lacks_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }))) + in sem_PrExpr_Lacks_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }))) + in sem_PrExpr_Lacks_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }))) + in sem_PrExpr_Lacks_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) }) })))) + in sem_PrExpr_Lacks_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }))) + in sem_PrExpr_Lacks_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Lacks_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }) }))) + in sem_PrExpr_Lacks_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) + +sem_PrExpr_DynVar :: Range -> + HsName -> + T_TyExpr -> + T_PrExpr + +sem_PrExpr_DynVar hsrange_ nm_ tyExpr_ | hsrange_ `seq` (nm_ `seq` (tyExpr_ `seq` (True))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_DynVar_1 :: T_PrExpr_1 + sem_PrExpr_DynVar_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_DynVar_2 :: T_PrExpr_2 + sem_PrExpr_DynVar_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (Pred_Class ((hsnDynVar `hsnConcat` nm_) `appConApp` [_tyExprIty])) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_DynVar_3 :: T_PrExpr_3 + sem_PrExpr_DynVar_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (_tyExprIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_DynVar_4 :: T_PrExpr_4 + sem_PrExpr_DynVar_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_DynVar_5 :: T_PrExpr_5 + sem_PrExpr_DynVar_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_DynVar_6 :: T_PrExpr_6 + sem_PrExpr_DynVar_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiStar) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_DynVar_7 :: T_PrExpr_7 + sem_PrExpr_DynVar_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_tyExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_DynVar_8 :: T_PrExpr_8 + sem_PrExpr_DynVar_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (hsnDynVar >|< nm_ >#< "::" >#< _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_DynVar_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) + in sem_PrExpr_DynVar_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }))) + in sem_PrExpr_DynVar_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }))) + in sem_PrExpr_DynVar_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) })))) + in sem_PrExpr_DynVar_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }) }) }))) + in sem_PrExpr_DynVar_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_DynVar_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }))) + in sem_PrExpr_DynVar_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) + +sem_PrExpr_Eq :: Range -> + T_TyExpr -> + T_TyExpr -> + T_PrExpr + +sem_PrExpr_Eq hsrange_ tyExpr1_ tyExpr2_ | hsrange_ `seq` (tyExpr1_ `seq` (tyExpr2_ `seq` (True))) = + (case (tyExpr2_) of + { ( _tyExpr2Irange,tyExpr2_1) | True -> + (case (tyExpr1_) of + { ( _tyExpr1Irange,tyExpr1_1) | True -> + (case (rangeUnions [hsrange_, _tyExpr1Irange, _tyExpr2Irange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_PrExpr_Eq_1 :: T_PrExpr_1 + sem_PrExpr_Eq_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup204 | __tup204 `seq` (True) -> + (case (__tup204) of + { (_tyExpr1OgUniq,_) | _tyExpr1OgUniq `seq` (True) -> + (case (tyExpr1_1 _tyExpr1OgUniq) of + { ( _tyExpr1IgUniq,tyExpr1_2) | True -> + (case (_tyExpr1IgUniq) of + { _tyExpr2OgUniq | _tyExpr2OgUniq `seq` (True) -> + (case (tyExpr2_1 _tyExpr2OgUniq) of + { ( _tyExpr2IgUniq,tyExpr2_2) | True -> + (case (_tyExpr2IgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_PrExpr_Eq_2 :: T_PrExpr_2 + sem_PrExpr_Eq_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExpr1OtyGam | _tyExpr1OtyGam `seq` (True) -> + (case (tyExpr1_2 _tyExpr1OtyGam) of + { ( _tyExpr1Ity,_tyExpr1ItyGam,tyExpr1_3) | True -> + (case (_tyExpr1ItyGam) of + { _tyExpr2OtyGam | _tyExpr2OtyGam `seq` (True) -> + (case (tyExpr2_2 _tyExpr2OtyGam) of + { ( _tyExpr2Ity,_tyExpr2ItyGam,tyExpr2_3) | True -> + (case (Pred_Eq _tyExpr1Ity _tyExpr2Ity) of + { _pr | _pr `seq` (True) -> + (case (mkTyPr _pr) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _prTy | _prTy `seq` (True) -> + (case (_prTy) of + { _lhsOprTy | _lhsOprTy `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExpr2ItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_PrExpr_Eq_3 :: T_PrExpr_3 + sem_PrExpr_Eq_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_lhsIknPolCtx) of + { _tyExpr2OknPolCtx | _tyExpr2OknPolCtx `seq` (True) -> + (case (tyExpr2_3 _tyExpr2OknPolCtx) of + { ( _tyExpr2IpolVarL,tyExpr2_4) | True -> + (case (_tyExpr2IpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_PrExpr_Eq_4 :: T_PrExpr_4 + sem_PrExpr_Eq_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _tyExpr1OpolVarMp | _tyExpr1OpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExpr1OpolGam | _tyExpr1OpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExpr1OknPolCtx | _tyExpr1OknPolCtx `seq` (True) -> + (case (tyExpr1_3 _tyExpr1OknPolCtx) of + { ( _tyExpr1IpolVarL,tyExpr1_4) | True -> + (case (tyExpr1_4 _tyExpr1OpolGam _tyExpr1OpolVarMp) of + { ( _tyExpr1ImbStrictness,_tyExpr1IpolVarMp,tyExpr1_5) | True -> + (case (_tyExpr1IpolVarMp) of + { _tyExpr2OpolVarMp | _tyExpr2OpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExpr2OpolGam | _tyExpr2OpolGam `seq` (True) -> + (case (tyExpr2_4 _tyExpr2OpolGam _tyExpr2OpolVarMp) of + { ( _tyExpr2ImbStrictness,_tyExpr2IpolVarMp,tyExpr2_5) | True -> + (case (_tyExpr2IpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_PrExpr_Eq_5 :: T_PrExpr_5 + sem_PrExpr_Eq_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExpr1OtyKiGam | _tyExpr1OtyKiGam `seq` (True) -> + (case (tyExpr1_5 _tyExpr1OtyKiGam) of + { ( _tyExpr1IintlTyKiGam,_tyExpr1ItyKiGam,tyExpr1_6) | True -> + (case (_tyExpr1ItyKiGam) of + { _tyExpr2OtyKiGam | _tyExpr2OtyKiGam `seq` (True) -> + (case (tyExpr2_5 _tyExpr2OtyKiGam) of + { ( _tyExpr2IintlTyKiGam,_tyExpr2ItyKiGam,tyExpr2_6) | True -> + (case (_tyExpr1IintlTyKiGam `gamUnion` _tyExpr2IintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExpr2ItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_PrExpr_Eq_6 :: T_PrExpr_6 + sem_PrExpr_Eq_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExpr1OkiVarMp | _tyExpr1OkiVarMp `seq` (True) -> + (case (tyExpr1_6 _tyExpr1OkiVarMp) of + { ( _tyExpr1IgathTyVarPolGam,_tyExpr1Iki,_tyExpr1IkiVarMp,_tyExpr1Ipol,_tyExpr1ItyVarWildMp,tyExpr1_7) | True -> + (case (_tyExpr1IkiVarMp) of + { _tyExpr2OkiVarMp | _tyExpr2OkiVarMp `seq` (True) -> + (case (tyExpr2_6 _tyExpr2OkiVarMp) of + { ( _tyExpr2IgathTyVarPolGam,_tyExpr2Iki,_tyExpr2IkiVarMp,_tyExpr2Ipol,_tyExpr2ItyVarWildMp,tyExpr2_7) | True -> + (case (_tyExpr1IgathTyVarPolGam `gamUnion` _tyExpr2IgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_tyExpr2Iki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (__tup204) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (fitsIn unifyFIOpts defaultFIEnv _lUniq _tyExpr2IkiVarMp _tyExpr1Iki _tyExpr2Iki) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _tyExpr2IkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExpr1ItyVarWildMp `Map.union` _tyExpr2ItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_PrExpr_Eq_7 :: T_PrExpr_7 + sem_PrExpr_Eq_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _tyExpr2OclGam | _tyExpr2OclGam `seq` (True) -> + (case (tyExpr2_7 _tyExpr2OclGam) of + { ( _tyExpr2IevTy,tyExpr2_8) | True -> + (case (_tyExpr2IevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_PrExpr_Eq_8 :: T_PrExpr_8 + sem_PrExpr_Eq_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExpr2OvalTyGlobFreeTvarS | _tyExpr2OvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExpr2OtyTyTySigFreeTvarS | _tyExpr2OtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExpr2OtyTyGlobFreeTvarS | _tyExpr2OtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExpr2OtyKiGlobFreeTvarS | _tyExpr2OtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExpr2OsysfEnv | _tyExpr2OsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExpr2Oopts | _tyExpr2Oopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExpr2OmoduleNm | _tyExpr2OmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExpr2OkiGam | _tyExpr2OkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExpr2OfinTyVarMp | _tyExpr2OfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExpr2OfinTyKiGam | _tyExpr2OfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExpr2OfinKiVarMp | _tyExpr2OfinKiVarMp `seq` (True) -> + (case (tyExpr2_8 _tyExpr2OfinKiVarMp _tyExpr2OfinTyKiGam _tyExpr2OfinTyVarMp _tyExpr2OkiGam _tyExpr2OmoduleNm _tyExpr2Oopts _tyExpr2OsysfEnv _tyExpr2OtyKiGlobFreeTvarS _tyExpr2OtyTyGlobFreeTvarS _tyExpr2OtyTyTySigFreeTvarS _tyExpr2OvalTyGlobFreeTvarS) of + { ( _tyExpr2IallErrSq,_tyExpr2IappArgPPL,_tyExpr2IappFunNm,_tyExpr2IappFunPP,_tyExpr2IclMissNmS,_tyExpr2IclNmS,_tyExpr2IerrSq,_tyExpr2IgathMentrelFilterMp,_tyExpr2Ipp,_tyExpr2ItyWildL) | True -> + (case (_lhsIclGam) of + { _tyExpr1OclGam | _tyExpr1OclGam `seq` (True) -> + (case (tyExpr1_7 _tyExpr1OclGam) of + { ( _tyExpr1IevTy,tyExpr1_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExpr1OvalTyGlobFreeTvarS | _tyExpr1OvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExpr1OtyTyTySigFreeTvarS | _tyExpr1OtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExpr1OtyTyGlobFreeTvarS | _tyExpr1OtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExpr1OtyKiGlobFreeTvarS | _tyExpr1OtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExpr1OsysfEnv | _tyExpr1OsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExpr1Oopts | _tyExpr1Oopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExpr1OmoduleNm | _tyExpr1OmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExpr1OkiGam | _tyExpr1OkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExpr1OfinTyVarMp | _tyExpr1OfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExpr1OfinTyKiGam | _tyExpr1OfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExpr1OfinKiVarMp | _tyExpr1OfinKiVarMp `seq` (True) -> + (case (tyExpr1_8 _tyExpr1OfinKiVarMp _tyExpr1OfinTyKiGam _tyExpr1OfinTyVarMp _tyExpr1OkiGam _tyExpr1OmoduleNm _tyExpr1Oopts _tyExpr1OsysfEnv _tyExpr1OtyKiGlobFreeTvarS _tyExpr1OtyTyGlobFreeTvarS _tyExpr1OtyTyTySigFreeTvarS _tyExpr1OvalTyGlobFreeTvarS) of + { ( _tyExpr1IallErrSq,_tyExpr1IappArgPPL,_tyExpr1IappFunNm,_tyExpr1IappFunPP,_tyExpr1IclMissNmS,_tyExpr1IclNmS,_tyExpr1IerrSq,_tyExpr1IgathMentrelFilterMp,_tyExpr1Ipp,_tyExpr1ItyWildL) | True -> + (case (_tyExpr1IallErrSq `Seq.union` _tyExpr2IallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_tyExpr1IclMissNmS `Set.union` _tyExpr2IclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExpr1IclNmS `Set.union` _tyExpr2IclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExpr1IerrSq `Seq.union` _tyExpr2IerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExpr1IgathMentrelFilterMp `mentrelFilterMpUnion` _tyExpr2IgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_tyExpr1Ipp >#< hsnEqTilde >#< _tyExpr2Ipp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_PrExpr_Eq_8)) of + { ( sem_PrExpr_8) | True -> + ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) + in sem_PrExpr_Eq_7)) of + { ( sem_PrExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_PrExpr_7) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Eq_6)) of + { ( sem_PrExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_PrExpr_6) }) }) }) }) }) }) }))) + in sem_PrExpr_Eq_5)) of + { ( sem_PrExpr_5) | True -> + ( _lhsOpolVarMp,sem_PrExpr_5) }) }) }) }) }) }) }) }) }) })))) + in sem_PrExpr_Eq_4)) of + { ( sem_PrExpr_4) | True -> + ( _lhsOpolVarL,sem_PrExpr_4) }) }) }) }))) + in sem_PrExpr_Eq_3)) of + { ( sem_PrExpr_3) | True -> + ( _lhsOprTy,_lhsOty,_lhsOtyGam,sem_PrExpr_3) }) }) }) }) }) }) }) }) }) }) }))) + in sem_PrExpr_Eq_2)) of + { ( sem_PrExpr_2) | True -> + ( _lhsOgUniq,sem_PrExpr_2) }) }) }) }) }) }) }))) + in sem_PrExpr_Eq_1)) of + { ( sem_PrExpr_1) | True -> + ( _lhsOrange,sem_PrExpr_1) }) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs b/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs @@ -0,0 +1,377 @@ + + + +module UHC.Light.Compiler.EH.MainAG_PrExprs where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- PrExprs ----------------------------------------------------- +{- + visit 0: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + knPolCtx : Polarity + moduleNm : HsName + opts : EHCOpts + polGam : PolGam + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attributes: + gUniq : UID + kiVarMp : VarMp + polVarMp : VarMp + tyGam : TyGam + tyKiGam : TyKiGam + synthesized attributes: + allErrSq : ErrSq + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + intlTyKiGam : TyKiGam + pp : PP_Doc + ppL : [PP_Doc] + prL : [Pred] + range : Range + tyL : TyL + tyVarWildMp : TyVarWildMp + alternatives: + alternative Cons: + child hd : PrExpr + child tl : PrExprs + alternative Nil: +-} +sem_PrExprs_Cons :: T_PrExpr -> + T_PrExprs -> + T_PrExprs + +sem_PrExprs_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIgUniq + _lhsIkiGam + _lhsIkiVarMp + _lhsIknPolCtx + _lhsImoduleNm + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIsysfEnv + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIgUniq `seq` + (_lhsIkiGam `seq` + (_lhsIkiVarMp `seq` + (_lhsIknPolCtx `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _hdOknPolCtx | _hdOknPolCtx `seq` (True) -> + (case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (hd_2 _hdOtyGam) of + { ( _hdIprTy,_hdIty,_hdItyGam,hd_3) | True -> + (case (hd_3 _hdOknPolCtx) of + { ( _hdIpolVarL,hd_4) | True -> + (case (hd_4 _hdOpolGam _hdOpolVarMp) of + { ( _hdIpolVarMp,hd_5) | True -> + (case (hd_5 _hdOtyKiGam) of + { ( _hdIintlTyKiGam,_hdItyKiGam,hd_6) | True -> + (case (_hdItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (_hdItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tlOknPolCtx | _tlOknPolCtx `seq` (True) -> + (case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (hd_6 _hdOkiVarMp) of + { ( _hdIgathTyVarPolGam,_hdIki,_hdIkiVarMp,_hdItyVarWildMp,hd_7) | True -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (tl_ _tlOclGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOgUniq _tlOkiGam _tlOkiVarMp _tlOknPolCtx _tlOmoduleNm _tlOopts _tlOpolGam _tlOpolVarMp _tlOsysfEnv _tlOtyGam _tlOtyKiGam _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgUniq,_tlIgathMentrelFilterMp,_tlIintlTyKiGam,_tlIkiVarMp,_tlIpolVarMp,_tlIpp,_tlIppL,_tlIprL,_tlIrange,_tlItyGam,_tlItyKiGam,_tlItyL,_tlItyVarWildMp) | True -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (hd_7 _hdOclGam) of + { ( _hdIevTy,hd_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (hd_8 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOkiGam _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdIpr) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIclMissNmS `Set.union` _tlIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_hdIclNmS `Set.union` _tlIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdIpr : _tlIprL) of + { _lhsOprL | _lhsOprL `seq` (True) -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (_tlItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_tlItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case (_hdIty : _tlItyL) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case (_hdItyVarWildMp `Map.union` _tlItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgUniq,_lhsOgathMentrelFilterMp,_lhsOintlTyKiGam,_lhsOkiVarMp,_lhsOpolVarMp,_lhsOpp,_lhsOppL,_lhsOprL,_lhsOrange,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))) + +sem_PrExprs_Nil :: T_PrExprs + +sem_PrExprs_Nil = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIgUniq + _lhsIkiGam + _lhsIkiVarMp + _lhsIknPolCtx + _lhsImoduleNm + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIsysfEnv + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIgUniq `seq` + (_lhsIkiGam `seq` + (_lhsIkiVarMp `seq` + (_lhsIknPolCtx `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOprL | _lhsOprL `seq` (True) -> + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ([]) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgUniq,_lhsOgathMentrelFilterMp,_lhsOintlTyKiGam,_lhsOkiVarMp,_lhsOpolVarMp,_lhsOpp,_lhsOppL,_lhsOprL,_lhsOrange,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs @@ -0,0 +1,1566 @@ + + + +module UHC.Light.Compiler.EH.MainAG_RecExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- RecExpr ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyGam : TyGam + tyKiGam : TyKiGam + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + visit 4: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + chained attribute: + gathDataGam : DataGam + visit 5: + inherited attribute: + dataGam : DataGam + chained attribute: + positionalFldNmL : [HsName] + synthesized attribute: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + fiOpts : FIOpts + knTy : Ty + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valGam : ValGam + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + noLetQuantTyVarIdS : TyVarIdS + visit 7: + inherited attributes: + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + extNm : HsName + fuCExprL : FieldUpdateL CExpr + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + isExtFromEmpty : Bool + pp : PP_Doc + ppL : [PP_Doc] + recCExpr : CExpr + ty : Ty + alternatives: + alternative Empty: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 1: + local _tup205 : _ + intra range : {Range} + visit 2: + intra _tup205 : _ + intra range : {Range} + visit 3: + intra _tup205 : _ + intra range : {Range} + visit 4: + intra _tup205 : _ + intra range : {Range} + visit 5: + intra _tup205 : _ + intra range : {Range} + visit 6: + local lUniq : {UID} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup205 : _ + intra range : {Range} + visit 7: + local pp : _ + local recCExpr : _ + local ty : {Ty} + intra fo_ : {FIOut} + intra range : {Range} + alternative Ext: + child hsrange : {Range} + child recExpr : RecExpr + child mbNm : {Maybe HsName} + child expr : Expr + visit 0: + local range : {Range} + visit 1: + local _tup209 : _ + intra range : {Range} + visit 2: + intra _tup209 : _ + intra range : {Range} + visit 3: + intra _tup209 : _ + intra range : {Range} + visit 4: + intra _tup209 : _ + intra range : {Range} + visit 5: + local _tup208 : _ + intra _tup209 : _ + intra range : {Range} + visit 6: + local lUniq2 : {UID} + local lUniq : {UID} + local positionalNm : {HsName} + local nm : {HsName} + local _tup206 : _ + local knRecTy : {Ty} + local knFIOpts : {FIOpts} + local fe : {FIEnv} + local foKnRec : {FIOut} + local recTyVarMp : _ + local knExprTy : {Ty} + local knTailTy : _ + local _tup207 : _ + local recKnTlTy : {Ty} + local lUniq3 : {UID} + local knRowTy : _ + local prUid : {PredOccId} + local prOccL : {[PredOcc]} + local hereCnstrMp : _ + intra _tup209 : _ + intra _tup208 : _ + intra range : {Range} + visit 7: + local pp : _ + local knRecHasLab : {Bool} + local offset : _ + local rcexpr : _ + local ty : {Ty} + intra nm : {HsName} + intra positionalNm : {HsName} + intra foKnRec : {FIOut} + intra range : {Range} + intra _tup207 : _ + intra prUid : {PredOccId} + alternative Upd: + child hsrange : {Range} + child recExpr : RecExpr + child nm : {HsName} + child expr : Expr + visit 0: + local range : {Range} + visit 1: + local _tup212 : _ + intra range : {Range} + visit 2: + intra _tup212 : _ + intra range : {Range} + visit 3: + intra _tup212 : _ + intra range : {Range} + visit 4: + intra _tup212 : _ + intra range : {Range} + visit 5: + intra _tup212 : _ + intra range : {Range} + visit 6: + local lUniq3 : {UID} + local lUniq2 : {UID} + local lUniq : {UID} + local _tup210 : _ + local knRecTy : {Ty} + local knFIOpts : {FIOpts} + local fe : {FIEnv} + local foKnRec : {FIOut} + local recTyVarMp : _ + local knExprTy : {Ty} + local knTailTy : _ + local _tup211 : _ + local recKnTlTy : {Ty} + local lUniq4 : {UID} + local knRowTy : _ + local prUid : {PredOccId} + local prOccL : {[PredOcc]} + local hereCnstrMp : _ + intra _tup212 : _ + intra range : {Range} + visit 7: + local pp : _ + local knRecHasLab : {Bool} + local offset : _ + local rcexpr : _ + local ty : {Ty} + intra foKnRec : {FIOut} + intra range : {Range} + intra _tup211 : _ + intra prUid : {PredOccId} + alternative Expr: + child hsrange : {Range} + child expr : Expr + visit 0: + local range : {Range} + visit 7: + local pp : _ + local recCExpr : _ +-} +sem_RecExpr_Empty :: Range -> + T_RecExpr + +sem_RecExpr_Empty hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecExpr_Empty_1 :: T_RecExpr_1 + sem_RecExpr_Empty_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup205 | __tup205 `seq` (True) -> + (case (__tup205) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecExpr_Empty_2 :: T_RecExpr_2 + sem_RecExpr_Empty_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecExpr_Empty_3 :: T_RecExpr_3 + sem_RecExpr_Empty_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RecExpr_Empty_4 :: T_RecExpr_4 + sem_RecExpr_Empty_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_RecExpr_Empty_5 :: T_RecExpr_5 + sem_RecExpr_Empty_5 = + (\ _lhsIdataGam + _lhsIpositionalFldNmL -> + _lhsIdataGam `seq` + (_lhsIpositionalFldNmL `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecExpr_Empty_6 :: T_RecExpr_6 + sem_RecExpr_Empty_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsIknTy + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (Set.empty) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (__tup205) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn (_lhsIfiOpts) _fe _lUniq _lhsItyVarMp recRecEmp _lhsIknTy) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecExpr_Empty_7 :: T_RecExpr_7 + sem_RecExpr_Empty_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (hsnORec >|< hsnCRec) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [foErrSq _fo_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnRowEmpty) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case ([]) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (True) of + { _lhsOisExtFromEmpty | _lhsOisExtFromEmpty `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (acoreTagTupTy CTagRec (acoreTyErr "RecExpr.Empty.recCExpr") []) of + { _recCExpr | _recCExpr `seq` (True) -> + (case (_recCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (foTy _fo_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppL,_lhsOrecCExpr,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Empty_7)) of + { ( sem_RecExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }))))))))))) + in sem_RecExpr_Empty_6)) of + { ( sem_RecExpr_6) | True -> + ( _lhsOchrInstDeclSq,_lhsOpositionalFldNmL,sem_RecExpr_6) }) }) })))) + in sem_RecExpr_Empty_5)) of + { ( sem_RecExpr_5) | True -> + ( _lhsOgathDataGam,sem_RecExpr_5) }) }))))))) + in sem_RecExpr_Empty_4)) of + { ( sem_RecExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_RecExpr_4) }) }) })))))))))) + in sem_RecExpr_Empty_3)) of + { ( sem_RecExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecExpr_3) }) }))))) + in sem_RecExpr_Empty_2)) of + { ( sem_RecExpr_2) | True -> + ( _lhsOgUniq,sem_RecExpr_2) }) }) }))) + in sem_RecExpr_Empty_1)) of + { ( sem_RecExpr_1) | True -> + ( _lhsOrange,sem_RecExpr_1) }) }) }) + +sem_RecExpr_Ext :: Range -> + T_RecExpr -> + (Maybe HsName) -> + T_Expr -> + T_RecExpr + +sem_RecExpr_Ext hsrange_ recExpr_ mbNm_ expr_ | hsrange_ `seq` (recExpr_ `seq` (mbNm_ `seq` (expr_ `seq` (True)))) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (recExpr_) of + { ( _recExprIrange,recExpr_1) | True -> + (case (rangeUnions [hsrange_, _recExprIrange, _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecExpr_Ext_1 :: T_RecExpr_1 + sem_RecExpr_Ext_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} )) of + { __tup209 | __tup209 `seq` (True) -> + (case (__tup209) of + { (_recExprOgUniq,_,_,_) | _recExprOgUniq `seq` (True) -> + (case (recExpr_1 _recExprOgUniq) of + { ( _recExprIgUniq,recExpr_2) | True -> + (case (_recExprIgUniq) of + { _exprOgUniq | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecExpr_Ext_2 :: T_RecExpr_2 + sem_RecExpr_Ext_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _recExprOpredSameScopeCounter | _recExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _recExprOlexLev | _recExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _recExprOkiGam | _recExprOkiGam `seq` (True) -> + (case (recExpr_2 _recExprOkiGam _recExprOlexLev _recExprOpredSameScopeCounter) of + { ( _recExprIpredSameScopeCounter,recExpr_3) | True -> + (case (_recExprIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecExpr_Ext_3 :: T_RecExpr_3 + sem_RecExpr_Ext_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _recExprOtyKiGlobFreeTvarS | _recExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _recExprOtyKiGam | _recExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _recExprOtyGam | _recExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _recExprOpredScope | _recExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _recExprOpolVarMp | _recExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _recExprOpolGam | _recExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _recExprOopts | _recExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _recExprOkiVarMp | _recExprOkiVarMp `seq` (True) -> + (case (recExpr_3 _recExprOkiVarMp _recExprOopts _recExprOpolGam _recExprOpolVarMp _recExprOpredScope _recExprOtyGam _recExprOtyKiGam _recExprOtyKiGlobFreeTvarS) of + { ( _recExprIkiVarMp,_recExprIpolVarMp,recExpr_4) | True -> + (case (_recExprIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_recExprIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RecExpr_Ext_4 :: T_RecExpr_4 + sem_RecExpr_Ext_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _recExprOtyTyTySigFreeTvarS | _recExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIgathDataGam) of + { _recExprOgathDataGam | _recExprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _recExprOfinTyKiGam | _recExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _recExprOfinKiVarMp | _recExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _recExprOclGam | _recExprOclGam `seq` (True) -> + (case (recExpr_4 _recExprOclGam _recExprOfinKiVarMp _recExprOfinTyKiGam _recExprOgathDataGam _recExprOtyTyTySigFreeTvarS) of + { ( _recExprIgathDataGam,recExpr_5) | True -> + (case (_recExprIgathDataGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_RecExpr_Ext_5 :: T_RecExpr_5 + sem_RecExpr_Ext_5 = + (\ _lhsIdataGam + _lhsIpositionalFldNmL -> + _lhsIdataGam `seq` + (_lhsIpositionalFldNmL `seq` + ((case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _recExprOdataGam | _recExprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_lhsIpositionalFldNmL) of + { _recExprOpositionalFldNmL | _recExprOpositionalFldNmL `seq` (True) -> + (case (recExpr_5 _recExprOdataGam _recExprOpositionalFldNmL) of + { ( _recExprIchrInstDeclSq,_recExprIpositionalFldNmL,recExpr_6) | True -> + (case (_recExprIchrInstDeclSq `Seq.union` _exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (hdAndTl _recExprIpositionalFldNmL) of + { __tup208 | __tup208 `seq` (True) -> + (case (__tup208) of + { (_,_lhsOpositionalFldNmL) | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecExpr_Ext_6 :: T_RecExpr_6 + sem_RecExpr_Ext_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsIknTy + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _recExprOvalTyGlobFreeTvarS | _recExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _recExprOvalGam | _recExprOvalGam `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _recExprOtyTyGlobFreeTvarS | _recExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _recExprOtvKiVarMp | _recExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _recExprOclDfGam | _recExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _recExprOchrStore | _recExprOchrStore `seq` (True) -> + (case (__tup209) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (__tup209) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (__tup208) of + { (_positionalNm,_) | _positionalNm `seq` (True) -> + (case (maybe _positionalNm id mbNm_) of + { _nm | _nm `seq` (True) -> + (case (let [r,e] = mkNewTyVarL 2 _lUniq + tl = hsnRec `appConApp` [r] + in (r, tl `recRecExt` [(_nm,e)], tl, e)) of + { __tup206 | __tup206 `seq` (True) -> + (case (__tup206) of + { (_,_knRecTy,_,_) | _knRecTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _knFIOpts | _knFIOpts `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _knFIOpts _fe _lUniq2 _lhsItyVarMp _knRecTy _lhsIknTy) of + { _foKnRec | _foKnRec `seq` (True) -> + (case (foVarMp _foKnRec `varUpd` _lhsItyVarMp) of + { _recTyVarMp | _recTyVarMp `seq` (True) -> + (case (__tup206) of + { (_,_,_,_knExprTy) | _knExprTy `seq` (True) -> + (case (__tup206) of + { (_,_,_knTailTy,_) | _knTailTy `seq` (True) -> + (case (maybe (False,_knTailTy,_knExprTy) (\(r,e) -> (True,r,e)) $ tyRecExtrWithLkup (varmpTyLookupCyc2 _recTyVarMp) _nm $ foTy _foKnRec) of + { __tup207 | __tup207 `seq` (True) -> + (case (__tup207) of + { (_,_recKnTlTy,_) | _recKnTlTy `seq` (True) -> + (case (_recKnTlTy) of + { _recExprOknTy | _recExprOknTy `seq` (True) -> + (case (_recTyVarMp) of + { _recExprOtyVarMp | _recExprOtyVarMp `seq` (True) -> + (case (_lhsIfiOpts {fioNoRLabElimFor = _nm : fioNoRLabElimFor _lhsIfiOpts}) of + { _recExprOfiOpts | _recExprOfiOpts `seq` (True) -> + (case (recExpr_6 _recExprOchrStore _recExprOclDfGam _recExprOfiOpts _recExprOknTy _recExprOtvKiVarMp _recExprOtyTyGlobFreeTvarS _recExprOtyVarMp _recExprOvalGam _recExprOvalTyGlobFreeTvarS) of + { ( _recExprIgathCnstrMp,_recExprIgathRangeMp,_recExprInoLetQuantTyVarIdS,_recExprItyVarMp,recExpr_7) | True -> + (case (_recExprItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (__tup209) of + { (_,_,_,_lUniq3) | _lUniq3 `seq` (True) -> + (case (__tup207) of + { (_,_,_exprOknTy) | _exprOknTy `seq` (True) -> + (case (__tup206) of + { (_knRowTy,_,_,_) | _knRowTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (mkPrIdCHR _lUniq3) of + { _prUid | _prUid `seq` (True) -> + (case ([rngLift _range mkPredOccRng (Pred_Lacks _knRowTy (Label_Lab _nm)) _prUid _lhsIpredScope]) of + { _prOccL | _prOccL `seq` (True) -> + (case (gathPredLToProveCnstrMp _prOccL) of + { _hereCnstrMp | _hereCnstrMp `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (cnstrMpUnions [_hereCnstrMp, _recExprIgathCnstrMp, _exprIgathCnstrMp]) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_recExprIgathRangeMp `Map.union` _exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_recExprInoLetQuantTyVarIdS `Set.union` _exprInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecExpr_Ext_7 :: T_RecExpr_7 + sem_RecExpr_Ext_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _recExprOsysfEnv | _recExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _recExprOrangeMp | _recExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _recExprOfinValGam | _recExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _recExprOfinTyVarMp | _recExprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _recExprOchrScopeBindMp | _recExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _recExprOchrEvidBindMp | _recExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _recExprOcSubst | _recExprOcSubst `seq` (True) -> + (case (_lhsImoduleNm) of + { _recExprOmoduleNm | _recExprOmoduleNm `seq` (True) -> + (case (recExpr_7 _recExprOcSubst _recExprOchrEvidBindMp _recExprOchrScopeBindMp _recExprOfinTyVarMp _recExprOfinValGam _recExprOmoduleNm _recExprOrangeMp _recExprOsysfEnv) of + { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppL,_recExprIrecCExpr,_recExprIty) | True -> + (case (_recExprIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_recExprIallErrSq `Seq.union` _exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (ppFld "=" (Just _positionalNm) _nm (pp _nm) _exprIpp) of + { _pp | _pp `seq` (True) -> + (case (Seq.unions [ _recExprIerrSq + , rngLift _range mkNestErr' _pp [_exprIerrSq, foErrSq _foKnRec] + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_recExprIextNm) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (__tup207) of + { (_knRecHasLab,_,_) | _knRecHasLab `seq` (True) -> + (case (cSubstApp _exprIcSubst $ acoreNmHolePred _prUid) of + { _offset | _offset `seq` (True) -> + (case (CExpr_TupIns _recExprIrecCExpr CTagRec _nm _offset _exprIcexpr) of + { _rcexpr | _rcexpr `seq` (True) -> + (case (if _knRecHasLab + then (_nm,(_rcexpr,Nothing)) : _recExprIfuCExprL + else _recExprIfuCExprL) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (_recExprIgathMentrelFilterMp `mentrelFilterMpUnion` _exprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_recExprIgathTvKiVarMp `varmpUnion` _exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_recExprIisExtFromEmpty) of + { _lhsOisExtFromEmpty | _lhsOisExtFromEmpty `seq` (True) -> + (case (_recExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pp : _recExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recExprIrecCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (foTy _foKnRec) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppL,_lhsOrecCExpr,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Ext_7)) of + { ( sem_RecExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_RecExpr_Ext_6)) of + { ( sem_RecExpr_6) | True -> + ( _lhsOchrInstDeclSq,_lhsOpositionalFldNmL,sem_RecExpr_6) }) }) }) }) }) }) }) }) })))) + in sem_RecExpr_Ext_5)) of + { ( sem_RecExpr_5) | True -> + ( _lhsOgathDataGam,sem_RecExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_RecExpr_Ext_4)) of + { ( sem_RecExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_RecExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Ext_3)) of + { ( sem_RecExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecExpr_3) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_RecExpr_Ext_2)) of + { ( sem_RecExpr_2) | True -> + ( _lhsOgUniq,sem_RecExpr_2) }) }) }) }) }) }) }))) + in sem_RecExpr_Ext_1)) of + { ( sem_RecExpr_1) | True -> + ( _lhsOrange,sem_RecExpr_1) }) }) }) }) }) + +sem_RecExpr_Upd :: Range -> + T_RecExpr -> + HsName -> + T_Expr -> + T_RecExpr + +sem_RecExpr_Upd hsrange_ recExpr_ nm_ expr_ | hsrange_ `seq` (recExpr_ `seq` (nm_ `seq` (expr_ `seq` (True)))) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (recExpr_) of + { ( _recExprIrange,recExpr_1) | True -> + (case (rangeUnions [hsrange_, _recExprIrange, _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecExpr_Upd_1 :: T_RecExpr_1 + sem_RecExpr_Upd_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> case nextUnique __cont of { (__cont, lUniq4) -> (__cont,lUniq,lUniq2,lUniq3,lUniq4)}}}} )) of + { __tup212 | __tup212 `seq` (True) -> + (case (__tup212) of + { (_recExprOgUniq,_,_,_,_) | _recExprOgUniq `seq` (True) -> + (case (recExpr_1 _recExprOgUniq) of + { ( _recExprIgUniq,recExpr_2) | True -> + (case (_recExprIgUniq) of + { _exprOgUniq | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecExpr_Upd_2 :: T_RecExpr_2 + sem_RecExpr_Upd_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _recExprOpredSameScopeCounter | _recExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _recExprOlexLev | _recExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _recExprOkiGam | _recExprOkiGam `seq` (True) -> + (case (recExpr_2 _recExprOkiGam _recExprOlexLev _recExprOpredSameScopeCounter) of + { ( _recExprIpredSameScopeCounter,recExpr_3) | True -> + (case (_recExprIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecExpr_Upd_3 :: T_RecExpr_3 + sem_RecExpr_Upd_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _recExprOtyKiGlobFreeTvarS | _recExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _recExprOtyKiGam | _recExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _recExprOtyGam | _recExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _recExprOpredScope | _recExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _recExprOpolVarMp | _recExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _recExprOpolGam | _recExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _recExprOopts | _recExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _recExprOkiVarMp | _recExprOkiVarMp `seq` (True) -> + (case (recExpr_3 _recExprOkiVarMp _recExprOopts _recExprOpolGam _recExprOpolVarMp _recExprOpredScope _recExprOtyGam _recExprOtyKiGam _recExprOtyKiGlobFreeTvarS) of + { ( _recExprIkiVarMp,_recExprIpolVarMp,recExpr_4) | True -> + (case (_recExprIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_recExprIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RecExpr_Upd_4 :: T_RecExpr_4 + sem_RecExpr_Upd_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _recExprOtyTyTySigFreeTvarS | _recExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIgathDataGam) of + { _recExprOgathDataGam | _recExprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _recExprOfinTyKiGam | _recExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _recExprOfinKiVarMp | _recExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _recExprOclGam | _recExprOclGam `seq` (True) -> + (case (recExpr_4 _recExprOclGam _recExprOfinKiVarMp _recExprOfinTyKiGam _recExprOgathDataGam _recExprOtyTyTySigFreeTvarS) of + { ( _recExprIgathDataGam,recExpr_5) | True -> + (case (_recExprIgathDataGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_RecExpr_Upd_5 :: T_RecExpr_5 + sem_RecExpr_Upd_5 = + (\ _lhsIdataGam + _lhsIpositionalFldNmL -> + _lhsIdataGam `seq` + (_lhsIpositionalFldNmL `seq` + ((case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (_lhsIdataGam) of + { _recExprOdataGam | _recExprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_lhsIpositionalFldNmL) of + { _recExprOpositionalFldNmL | _recExprOpositionalFldNmL `seq` (True) -> + (case (recExpr_5 _recExprOdataGam _recExprOpositionalFldNmL) of + { ( _recExprIchrInstDeclSq,_recExprIpositionalFldNmL,recExpr_6) | True -> + (case (_recExprIchrInstDeclSq `Seq.union` _exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_recExprIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecExpr_Upd_6 :: T_RecExpr_6 + sem_RecExpr_Upd_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsIknTy + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _recExprOvalTyGlobFreeTvarS | _recExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _recExprOvalGam | _recExprOvalGam `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _recExprOtyTyGlobFreeTvarS | _recExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _recExprOtvKiVarMp | _recExprOtvKiVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _recExprOfiOpts | _recExprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _recExprOclDfGam | _recExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _recExprOchrStore | _recExprOchrStore `seq` (True) -> + (case (__tup212) of + { (_,_,_,_lUniq3,_) | _lUniq3 `seq` (True) -> + (case (__tup212) of + { (_,_,_lUniq2,_,_) | _lUniq2 `seq` (True) -> + (case (__tup212) of + { (_,_lUniq,_,_,_) | _lUniq `seq` (True) -> + (case (let [r,e] = mkNewTyVarL 2 _lUniq + tl = hsnRec `appConApp` [r] + in (r, tl `recRecExt` [(nm_,e)], tl, e)) of + { __tup210 | __tup210 `seq` (True) -> + (case (__tup210) of + { (_,_knRecTy,_,_) | _knRecTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _knFIOpts | _knFIOpts `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn _knFIOpts _fe _lUniq2 _lhsItyVarMp _knRecTy _lhsIknTy) of + { _foKnRec | _foKnRec `seq` (True) -> + (case (foVarMp _foKnRec `varUpd` _lhsItyVarMp) of + { _recTyVarMp | _recTyVarMp `seq` (True) -> + (case (__tup210) of + { (_,_,_,_knExprTy) | _knExprTy `seq` (True) -> + (case (__tup210) of + { (_,_,_knTailTy,_) | _knTailTy `seq` (True) -> + (case (maybe (False,_knTailTy,_knExprTy) (\(r,e) -> (True,r,e)) $ tyRecExtrWithLkup (varmpTyLookupCyc2 _recTyVarMp) nm_ $ foTy _foKnRec) of + { __tup211 | __tup211 `seq` (True) -> + (case (__tup211) of + { (_,_recKnTlTy,_) | _recKnTlTy `seq` (True) -> + (case (_recKnTlTy `recRecExt` [(nm_,mkNewTyVar _lUniq3)]) of + { _recExprOknTy | _recExprOknTy `seq` (True) -> + (case (_recTyVarMp) of + { _recExprOtyVarMp | _recExprOtyVarMp `seq` (True) -> + (case (recExpr_6 _recExprOchrStore _recExprOclDfGam _recExprOfiOpts _recExprOknTy _recExprOtvKiVarMp _recExprOtyTyGlobFreeTvarS _recExprOtyVarMp _recExprOvalGam _recExprOvalTyGlobFreeTvarS) of + { ( _recExprIgathCnstrMp,_recExprIgathRangeMp,_recExprInoLetQuantTyVarIdS,_recExprItyVarMp,recExpr_7) | True -> + (case (_recExprItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (__tup212) of + { (_,_,_,_,_lUniq4) | _lUniq4 `seq` (True) -> + (case (__tup211) of + { (_,_,_exprOknTy) | _exprOknTy `seq` (True) -> + (case (__tup210) of + { (_knRowTy,_,_,_) | _knRowTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (mkPrIdCHR _lUniq4) of + { _prUid | _prUid `seq` (True) -> + (case ([rngLift _range mkPredOccRng (Pred_Lacks _knRowTy (Label_Lab nm_)) _prUid _lhsIpredScope]) of + { _prOccL | _prOccL `seq` (True) -> + (case (gathPredLToProveCnstrMp _prOccL) of + { _hereCnstrMp | _hereCnstrMp `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (cnstrMpUnions [_hereCnstrMp, _recExprIgathCnstrMp, _exprIgathCnstrMp]) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_recExprIgathRangeMp `Map.union` _exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_recExprInoLetQuantTyVarIdS `Set.union` _exprInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecExpr_Upd_7 :: T_RecExpr_7 + sem_RecExpr_Upd_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _recExprOsysfEnv | _recExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _recExprOrangeMp | _recExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _recExprOfinValGam | _recExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _recExprOfinTyVarMp | _recExprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _recExprOchrScopeBindMp | _recExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _recExprOchrEvidBindMp | _recExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _recExprOcSubst | _recExprOcSubst `seq` (True) -> + (case (_lhsImoduleNm) of + { _recExprOmoduleNm | _recExprOmoduleNm `seq` (True) -> + (case (recExpr_7 _recExprOcSubst _recExprOchrEvidBindMp _recExprOchrScopeBindMp _recExprOfinTyVarMp _recExprOfinValGam _recExprOmoduleNm _recExprOrangeMp _recExprOsysfEnv) of + { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppL,_recExprIrecCExpr,_recExprIty) | True -> + (case (_recExprIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_recExprIallErrSq `Seq.union` _exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (ppFld ":=" Nothing nm_ (pp nm_) _exprIpp) of + { _pp | _pp `seq` (True) -> + (case (Seq.unions [ _recExprIerrSq + , rngLift _range mkNestErr' _pp [_exprIerrSq, foErrSq _foKnRec] + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_recExprIextNm) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (__tup211) of + { (_knRecHasLab,_,_) | _knRecHasLab `seq` (True) -> + (case (cSubstApp _exprIcSubst $ acoreNmHolePred _prUid) of + { _offset | _offset `seq` (True) -> + (case (CExpr_TupUpd _recExprIrecCExpr CTagRec nm_ _offset _exprIcexpr) of + { _rcexpr | _rcexpr `seq` (True) -> + (case (if _knRecHasLab + then (nm_,(_rcexpr,Nothing)) : _recExprIfuCExprL + else _recExprIfuCExprL) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (_recExprIgathMentrelFilterMp `mentrelFilterMpUnion` _exprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_recExprIgathTvKiVarMp `varmpUnion` _exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (not _knRecHasLab && _recExprIisExtFromEmpty) of + { _lhsOisExtFromEmpty | _lhsOisExtFromEmpty `seq` (True) -> + (case (_recExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_pp : _recExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recExprIrecCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (foTy _foKnRec) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppL,_lhsOrecCExpr,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Upd_7)) of + { ( sem_RecExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_RecExpr_Upd_6)) of + { ( sem_RecExpr_6) | True -> + ( _lhsOchrInstDeclSq,_lhsOpositionalFldNmL,sem_RecExpr_6) }) }) }) }) }) }) }) })))) + in sem_RecExpr_Upd_5)) of + { ( sem_RecExpr_5) | True -> + ( _lhsOgathDataGam,sem_RecExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))) + in sem_RecExpr_Upd_4)) of + { ( sem_RecExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_RecExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Upd_3)) of + { ( sem_RecExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecExpr_3) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_RecExpr_Upd_2)) of + { ( sem_RecExpr_2) | True -> + ( _lhsOgUniq,sem_RecExpr_2) }) }) }) }) }) }) }))) + in sem_RecExpr_Upd_1)) of + { ( sem_RecExpr_1) | True -> + ( _lhsOrange,sem_RecExpr_1) }) }) }) }) }) + +sem_RecExpr_Expr :: Range -> + T_Expr -> + T_RecExpr + +sem_RecExpr_Expr hsrange_ expr_ | hsrange_ `seq` (expr_ `seq` (True)) = + (case (expr_) of + { ( _exprIrange,expr_1) | True -> + (case (rangeUnions [hsrange_, _exprIrange , _exprIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecExpr_Expr_1 :: T_RecExpr_1 + sem_RecExpr_Expr_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _exprOgUniq | _exprOgUniq `seq` (True) -> + (case (expr_1 _exprOgUniq) of + { ( _exprIgUniq,_exprIhasInstDecl,expr_2) | True -> + (case (_exprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecExpr_Expr_2 :: T_RecExpr_2 + sem_RecExpr_Expr_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _exprOpredSameScopeCounter | _exprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _exprOlexLev | _exprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _exprOkiGam | _exprOkiGam `seq` (True) -> + (case (True) of + { _exprOisFirstLet | _exprOisFirstLet `seq` (True) -> + (case (expr_2 _exprOisFirstLet _exprOkiGam _exprOlexLev _exprOpredSameScopeCounter) of + { ( _exprIpredSameScopeCounter,expr_3) | True -> + (case (_exprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecExpr_Expr_3 :: T_RecExpr_3 + sem_RecExpr_Expr_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _exprOtyKiGlobFreeTvarS | _exprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _exprOtyKiGam | _exprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _exprOtyGam | _exprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _exprOpredScope | _exprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _exprOpolVarMp | _exprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _exprOpolGam | _exprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _exprOopts | _exprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _exprOkiVarMp | _exprOkiVarMp `seq` (True) -> + (case (expr_3 _exprOkiVarMp _exprOopts _exprOpolGam _exprOpolVarMp _exprOpredScope _exprOtyGam _exprOtyKiGam _exprOtyKiGlobFreeTvarS) of + { ( _exprIkiVarMp,_exprIpolVarMp,expr_4) | True -> + (case (_exprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_exprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RecExpr_Expr_4 :: T_RecExpr_4 + sem_RecExpr_Expr_4 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIgathDataGam + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIgathDataGam `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _exprOtyTyTySigFreeTvarS | _exprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIgathDataGam) of + { _exprOgathDataGam | _exprOgathDataGam `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _exprOfinTyKiGam | _exprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _exprOfinKiVarMp | _exprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _exprOclGam | _exprOclGam `seq` (True) -> + (case (expr_4 _exprOclGam _exprOfinKiVarMp _exprOfinTyKiGam _exprOgathDataGam _exprOtyTyTySigFreeTvarS) of + { ( _exprIgathDataGam,expr_5) | True -> + (case (_exprIgathDataGam) of + { _lhsOgathDataGam | _lhsOgathDataGam `seq` (True) -> + (case ((let sem_RecExpr_Expr_5 :: T_RecExpr_5 + sem_RecExpr_Expr_5 = + (\ _lhsIdataGam + _lhsIpositionalFldNmL -> + _lhsIdataGam `seq` + (_lhsIpositionalFldNmL `seq` + ((case (_lhsIdataGam) of + { _exprOdataGam | _exprOdataGam `seq` (True) -> + (case (expr_5 _exprOdataGam) of + { ( _exprIchrClassDeclSq,_exprIchrFIIn,_exprIchrInstDeclSq,_exprIgathClDfGam,expr_6) | True -> + (case (_exprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecExpr_Expr_6 :: T_RecExpr_6 + sem_RecExpr_Expr_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsIfiOpts + _lhsIknTy + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalGam + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalGam `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _exprOvalTyGlobFreeTvarS | _exprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalGam) of + { _exprOvalGam | _exprOvalGam `seq` (True) -> + (case (_lhsItyVarMp) of + { _exprOtyVarMp | _exprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _exprOtyTyGlobFreeTvarS | _exprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _exprOtvKiVarMp | _exprOtvKiVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _exprOknTy | _exprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _exprOfiOpts | _exprOfiOpts `seq` (True) -> + (case (_lhsIclDfGam) of + { _exprOclDfGam | _exprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _exprOchrStore | _exprOchrStore `seq` (True) -> + (case (expr_6 _exprOchrStore _exprOclDfGam _exprOfiOpts _exprOknTy _exprOtvKiVarMp _exprOtyTyGlobFreeTvarS _exprOtyVarMp _exprOvalGam _exprOvalTyGlobFreeTvarS) of + { ( _exprIgathCnstrMp,_exprIgathRangeMp,_exprIgathValGam,_exprInoLetQuantTyVarIdS,_exprIty,_exprItyVarMp,expr_7) | True -> + (case (_exprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_exprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_exprInoLetQuantTyVarIdS) of + { _lhsOnoLetQuantTyVarIdS | _lhsOnoLetQuantTyVarIdS `seq` (True) -> + (case (_exprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecExpr_Expr_7 :: T_RecExpr_7 + sem_RecExpr_Expr_7 = + (\ _lhsIcSubst + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv -> + _lhsIcSubst `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + ((case (_lhsIsysfEnv) of + { _exprOsysfEnv | _exprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _exprOrangeMp | _exprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _exprOfinValGam | _exprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _exprOfinTyVarMp | _exprOfinTyVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _exprOmoduleNm | _exprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _exprOchrScopeBindMp | _exprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _exprOchrEvidBindMp | _exprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _exprOcSubst | _exprOcSubst `seq` (True) -> + (case (ExprCtxt_Top) of + { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> + (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv) of + { ( _exprIallErrSq,_exprIappArgCoeL,_exprIappArgPPL,_exprIappFunCExpr,_exprIappFunNm,_exprIappFunPP,_exprIbackCBindL,_exprIcSubst,_exprIcaseFailS,_exprIcexpr,_exprIerrSq,_exprIfrontCBindL,_exprIfuCExprL,_exprIgathClGam,_exprIgathHiddenExports,_exprIgathKiGam,_exprIgathLamMp,_exprIgathMentrelFilterMp,_exprIgathPolGam,_exprIgathTvKiVarMp,_exprIgathTyGam,_exprIgathTyKiGam,_exprIisNewtype,_exprIlamArgPPL,_exprIlamBodyPP,_exprIletCBody,_exprIletTyCBindL,_exprIletValCBindL,_exprIorphanS,_exprIpp) | True -> + (case (_exprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_exprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_exprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnUnknown) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case ([]) of + { _lhsOfuCExprL | _lhsOfuCExprL `seq` (True) -> + (case (_exprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_exprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (False) of + { _lhsOisExtFromEmpty | _lhsOisExtFromEmpty `seq` (True) -> + (case (_exprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_exprIcexpr) of + { _recCExpr | _recCExpr `seq` (True) -> + (case (_recCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (_exprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppL,_lhsOrecCExpr,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Expr_7)) of + { ( sem_RecExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + in sem_RecExpr_Expr_6)) of + { ( sem_RecExpr_6) | True -> + ( _lhsOchrInstDeclSq,_lhsOpositionalFldNmL,sem_RecExpr_6) }) }) }) }) })))) + in sem_RecExpr_Expr_5)) of + { ( sem_RecExpr_5) | True -> + ( _lhsOgathDataGam,sem_RecExpr_5) }) }) }) }) }) }) }) }))))))) + in sem_RecExpr_Expr_4)) of + { ( sem_RecExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,sem_RecExpr_4) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecExpr_Expr_3)) of + { ( sem_RecExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecExpr_3) }) }) }) }) }) }) }))))) + in sem_RecExpr_Expr_2)) of + { ( sem_RecExpr_2) | True -> + ( _lhsOgUniq,sem_RecExpr_2) }) }) }) }))) + in sem_RecExpr_Expr_1)) of + { ( sem_RecExpr_1) | True -> + ( _lhsOrange,sem_RecExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs @@ -0,0 +1,1168 @@ + + + +module UHC.Light.Compiler.EH.MainAG_RecPatExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- RecPatExpr -------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + inherited attributes: + kiGam : KiGam + lexLev : Int + chained attribute: + predSameScopeCounter : Int + visit 3: + inherited attributes: + opts : EHCOpts + polGam : PolGam + predScope : PredScope + tyKiGlobFreeTvarS : TyVarIdS + chained attributes: + kiVarMp : VarMp + polVarMp : VarMp + tyGam : TyGam + tyKiGam : TyKiGam + visit 4: + inherited attributes: + clGam : ClGam + dataGam : DataGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + tyTyTySigFreeTvarS : TyVarIdS + chained attribute: + positionalFldNmL : [HsName] + synthesized attributes: + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + hasAFldRef : Bool + visit 5: + inherited attributes: + fiOpts : FIOpts + knTy : Ty + matchOnFld : Bool + tySigGam : ValGam + chained attributes: + patTyVarMp : VarMp + valGam : ValGam + visit 6: + inherited attributes: + chrStore : ScopedPredStore + clDfGam : ClassDefaultGam + tvKiVarMp : VarMp + tyTyGlobFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + chained attribute: + tyVarMp : VarMp + synthesized attributes: + gathCnstrMp : CHRPredOccCnstrMp + gathRangeMp : RangeMp + scopeGam : ScopeGam + ty : Ty + visit 7: + inherited attributes: + ceParentNm : HsName + chrEvidBindMp : EvidKeyToCBindMap + chrScopeBindMp : PredScopeToCBindMap + finTyVarMp : VarMp + finValGam : ValGam + moduleNm : HsName + rangeMp : RangeMp + sysfEnv : ToSysfEnv + tySigVarMp : VarMp + chained attribute: + cSubst : CSubst + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + extNm : HsName + fsRPatL : FieldSplitL + gathMentrelFilterMp : ModEntRelFilterMp + gathTvKiVarMp : VarMp + patCRest : CPatRest + pp : PP_Doc + ppL : [PP_Doc] + valCBindL : CBindL + alternatives: + alternative Empty: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 1: + local _tup213 : _ + intra range : {Range} + visit 2: + intra _tup213 : _ + intra range : {Range} + visit 3: + intra _tup213 : _ + intra range : {Range} + visit 4: + intra _tup213 : _ + intra range : {Range} + visit 5: + local lUniq : {UID} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup213 : _ + intra range : {Range} + visit 6: + local ty : {Ty} + intra fo_ : {FIOut} + intra range : {Range} + visit 7: + local pp : _ + intra fo_ : {FIOut} + intra range : {Range} + alternative Ext: + child hsrange : {Range} + child recPatExpr : RecPatExpr + child mbNm : {Maybe HsName} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 1: + local _tup216 : _ + intra range : {Range} + visit 2: + intra _tup216 : _ + intra range : {Range} + visit 3: + intra _tup216 : _ + intra range : {Range} + visit 4: + local _tup215 : _ + intra _tup216 : _ + intra range : {Range} + visit 5: + local lUniq2 : {UID} + local lUniq : {UID} + local positionalNm : {HsName} + local nm : {HsName} + local _tup214 : _ + local rowTy : {Ty} + local extTy : {Ty} + local patTy : {Ty} + local recTy : {Ty} + local fe : {FIEnv} + local fo_ : {FIOut} + intra _tup216 : _ + intra _tup215 : _ + intra range : {Range} + visit 6: + local lUniq3 : {UID} + local prUid : {PredOccId} + local prOccL : {[PredOcc]} + local hereCnstrMp : _ + local ty : {Ty} + intra _tup216 : _ + intra nm : {HsName} + intra rowTy : {Ty} + intra range : {Range} + intra fo_ : {FIOut} + intra positionalNm : {HsName} + visit 7: + local pp : _ + local offset : _ + intra fo_ : {FIOut} + intra range : {Range} + intra prUid : {PredOccId} + intra nm : {HsName} + intra positionalNm : {HsName} + alternative Expr: + child hsrange : {Range} + child patExpr : PatExpr + visit 0: + local range : {Range} + visit 7: + local pp : _ +-} +sem_RecPatExpr_Empty :: Range -> + T_RecPatExpr + +sem_RecPatExpr_Empty hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_1 :: T_RecPatExpr_1 + sem_RecPatExpr_Empty_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup213 | __tup213 `seq` (True) -> + (case (__tup213) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_2 :: T_RecPatExpr_2 + sem_RecPatExpr_Empty_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_3 :: T_RecPatExpr_3 + sem_RecPatExpr_Empty_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_4 :: T_RecPatExpr_4 + sem_RecPatExpr_Empty_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIpositionalFldNmL + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIpositionalFldNmL `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (False) of + { _lhsOhasAFldRef | _lhsOhasAFldRef `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_5 :: T_RecPatExpr_5 + sem_RecPatExpr_Empty_5 = + (\ _lhsIfiOpts + _lhsIknTy + _lhsImatchOnFld + _lhsIpatTyVarMp + _lhsItySigGam + _lhsIvalGam -> + _lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsImatchOnFld `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + (_lhsIvalGam `seq` + ((case (__tup213) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn (_lhsIfiOpts) _fe _lUniq _lhsIpatTyVarMp _lhsIknTy recRecEmp) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_lhsIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_6 :: T_RecPatExpr_6 + sem_RecPatExpr_Empty_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Map.empty) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (Map.empty) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (emptyGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (foTy _fo_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecPatExpr_Empty_7 :: T_RecPatExpr_7 + sem_RecPatExpr_Empty_7 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_lhsIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (hsnORec >|< hsnCRec) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [foErrSq _fo_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnRowEmpty) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case ([]) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (emptyVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (CPatRest_Empty) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_RecPatExpr_Empty_7)) of + { ( sem_RecPatExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Empty_6)) of + { ( sem_RecPatExpr_6) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_RecPatExpr_6) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Empty_5)) of + { ( sem_RecPatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOhasAFldRef,_lhsOpositionalFldNmL,sem_RecPatExpr_5) }) }) }) })))))))) + in sem_RecPatExpr_Empty_4)) of + { ( sem_RecPatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_RecPatExpr_4) }) }) }) }) })))))))))) + in sem_RecPatExpr_Empty_3)) of + { ( sem_RecPatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecPatExpr_3) }) }))))) + in sem_RecPatExpr_Empty_2)) of + { ( sem_RecPatExpr_2) | True -> + ( _lhsOgUniq,sem_RecPatExpr_2) }) }) }))) + in sem_RecPatExpr_Empty_1)) of + { ( sem_RecPatExpr_1) | True -> + ( _lhsOrange,sem_RecPatExpr_1) }) }) }) + +sem_RecPatExpr_Ext :: Range -> + T_RecPatExpr -> + (Maybe HsName) -> + T_PatExpr -> + T_RecPatExpr + +sem_RecPatExpr_Ext hsrange_ recPatExpr_ mbNm_ patExpr_ | hsrange_ `seq` (recPatExpr_ `seq` (mbNm_ `seq` (patExpr_ `seq` (True)))) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (recPatExpr_) of + { ( _recPatExprIrange,recPatExpr_1) | True -> + (case (rangeUnions [hsrange_, _recPatExprIrange + , _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_1 :: T_RecPatExpr_1 + sem_RecPatExpr_Ext_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq3) -> (__cont,lUniq,lUniq2,lUniq3)}}} )) of + { __tup216 | __tup216 `seq` (True) -> + (case (__tup216) of + { (_recPatExprOgUniq,_,_,_) | _recPatExprOgUniq `seq` (True) -> + (case (recPatExpr_1 _recPatExprOgUniq) of + { ( _recPatExprIgUniq,recPatExpr_2) | True -> + (case (_recPatExprIgUniq) of + { _patExprOgUniq | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_2 :: T_RecPatExpr_2 + sem_RecPatExpr_Ext_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _recPatExprOpredSameScopeCounter | _recPatExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _recPatExprOlexLev | _recPatExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _recPatExprOkiGam | _recPatExprOkiGam `seq` (True) -> + (case (recPatExpr_2 _recPatExprOkiGam _recPatExprOlexLev _recPatExprOpredSameScopeCounter) of + { ( _recPatExprIpredSameScopeCounter,recPatExpr_3) | True -> + (case (_recPatExprIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_3 :: T_RecPatExpr_3 + sem_RecPatExpr_Ext_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _recPatExprOtyKiGlobFreeTvarS | _recPatExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _recPatExprOtyKiGam | _recPatExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _recPatExprOtyGam | _recPatExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _recPatExprOpredScope | _recPatExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _recPatExprOpolVarMp | _recPatExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _recPatExprOpolGam | _recPatExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _recPatExprOopts | _recPatExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _recPatExprOkiVarMp | _recPatExprOkiVarMp `seq` (True) -> + (case (recPatExpr_3 _recPatExprOkiVarMp _recPatExprOopts _recPatExprOpolGam _recPatExprOpolVarMp _recPatExprOpredScope _recPatExprOtyGam _recPatExprOtyKiGam _recPatExprOtyKiGlobFreeTvarS) of + { ( _recPatExprIkiVarMp,_recPatExprIpolVarMp,_recPatExprItyGam,_recPatExprItyKiGam,recPatExpr_4) | True -> + (case (_recPatExprItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_recPatExprItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_recPatExprIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_recPatExprIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_4 :: T_RecPatExpr_4 + sem_RecPatExpr_Ext_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIpositionalFldNmL + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIpositionalFldNmL `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _recPatExprOtyTyTySigFreeTvarS | _recPatExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _recPatExprOfinTyKiGam | _recPatExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _recPatExprOfinKiVarMp | _recPatExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _recPatExprOdataGam | _recPatExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _recPatExprOclGam | _recPatExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_lhsIpositionalFldNmL) of + { _recPatExprOpositionalFldNmL | _recPatExprOpositionalFldNmL `seq` (True) -> + (case (recPatExpr_4 _recPatExprOclGam _recPatExprOdataGam _recPatExprOfinKiVarMp _recPatExprOfinTyKiGam _recPatExprOpositionalFldNmL _recPatExprOtyTyTySigFreeTvarS) of + { ( _recPatExprIchrInstDeclSq,_recPatExprIhasAFldRef,_recPatExprIpositionalFldNmL,recPatExpr_5) | True -> + (case (_recPatExprIchrInstDeclSq `Seq.union` _patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (maybe _recPatExprIhasAFldRef (const True) mbNm_) of + { _lhsOhasAFldRef | _lhsOhasAFldRef `seq` (True) -> + (case (hdAndTl _recPatExprIpositionalFldNmL) of + { __tup215 | __tup215 `seq` (True) -> + (case (__tup215) of + { (_,_lhsOpositionalFldNmL) | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_5 :: T_RecPatExpr_5 + sem_RecPatExpr_Ext_5 = + (\ _lhsIfiOpts + _lhsIknTy + _lhsImatchOnFld + _lhsIpatTyVarMp + _lhsItySigGam + _lhsIvalGam -> + _lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsImatchOnFld `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + (_lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _recPatExprOvalGam | _recPatExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _recPatExprOtySigGam | _recPatExprOtySigGam `seq` (True) -> + (case (_lhsImatchOnFld) of + { _recPatExprOmatchOnFld | _recPatExprOmatchOnFld `seq` (True) -> + (case (_lhsIfiOpts) of + { _recPatExprOfiOpts | _recPatExprOfiOpts `seq` (True) -> + (case (__tup216) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (__tup216) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (__tup215) of + { (_positionalNm,_) | _positionalNm `seq` (True) -> + (case (case mbNm_ of + Just nm -> nm + Nothing | _lhsImatchOnFld -> _patExprItopNm + | otherwise -> _positionalNm) of + { _nm | _nm `seq` (True) -> + (case (let [r,e] = mkNewTyVarL 2 _lUniq + in (r,e)) of + { __tup214 | __tup214 `seq` (True) -> + (case (__tup214) of + { (_rowTy,_) | _rowTy `seq` (True) -> + (case (hsnRec `appConApp` [_rowTy]) of + { _extTy | _extTy `seq` (True) -> + (case (__tup214) of + { (_,_patTy) | _patTy `seq` (True) -> + (case (_extTy `recRecExt` [(_nm,_patTy)]) of + { _recTy | _recTy `seq` (True) -> + (case (defaultFIEnv + { feEHCOpts = _lhsIopts + , fePredScope = _lhsIpredScope + , feTyGam = _lhsItyGam + , fePolGam = _lhsIpolGam + , feRange = _range + }) of + { _fe | _fe `seq` (True) -> + (case (fitsIn (_lhsIfiOpts) _fe _lUniq2 _lhsIpatTyVarMp _lhsIknTy _recTy) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIpatTyVarMp) of + { _recPatExprOpatTyVarMp | _recPatExprOpatTyVarMp `seq` (True) -> + (case (_extTy) of + { _recPatExprOknTy | _recPatExprOknTy `seq` (True) -> + (case (recPatExpr_5 _recPatExprOfiOpts _recPatExprOknTy _recPatExprOmatchOnFld _recPatExprOpatTyVarMp _recPatExprOtySigGam _recPatExprOvalGam) of + { ( _recPatExprIpatTyVarMp,_recPatExprIvalGam,recPatExpr_6) | True -> + (case (_recPatExprIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_recPatExprIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (True) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case (_patTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case ([]) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_6 :: T_RecPatExpr_6 + sem_RecPatExpr_Ext_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _recPatExprOvalTyGlobFreeTvarS | _recPatExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _recPatExprOtyVarMp | _recPatExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _recPatExprOtyTyGlobFreeTvarS | _recPatExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _recPatExprOtvKiVarMp | _recPatExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _recPatExprOclDfGam | _recPatExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _recPatExprOchrStore | _recPatExprOchrStore `seq` (True) -> + (case (recPatExpr_6 _recPatExprOchrStore _recPatExprOclDfGam _recPatExprOtvKiVarMp _recPatExprOtyTyGlobFreeTvarS _recPatExprOtyVarMp _recPatExprOvalTyGlobFreeTvarS) of + { ( _recPatExprIgathCnstrMp,_recPatExprIgathRangeMp,_recPatExprIscopeGam,_recPatExprIty,_recPatExprItyVarMp,recPatExpr_7) | True -> + (case (_recPatExprItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (__tup216) of + { (_,_,_,_lUniq3) | _lUniq3 `seq` (True) -> + (case (mkPrIdCHR _lUniq3) of + { _prUid | _prUid `seq` (True) -> + (case ([rngLift _range mkPredOccRng (Pred_Lacks _rowTy (Label_Lab _nm)) _prUid _lhsIpredScope]) of + { _prOccL | _prOccL `seq` (True) -> + (case (gathPredLToProveCnstrMp _prOccL) of + { _hereCnstrMp | _hereCnstrMp `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (cnstrMpUnions [_hereCnstrMp, _recPatExprIgathCnstrMp, _patExprIgathCnstrMp]) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_recPatExprIgathRangeMp `Map.union` _patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_recPatExprIscopeGam `gamUnion` _patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (foTy _fo_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecPatExpr_Ext_7 :: T_RecPatExpr_7 + sem_RecPatExpr_Ext_7 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsIsysfEnv) of + { _recPatExprOsysfEnv | _recPatExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _recPatExprOrangeMp | _recPatExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _recPatExprOfinValGam | _recPatExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _recPatExprOfinTyVarMp | _recPatExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _recPatExprOchrScopeBindMp | _recPatExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _recPatExprOchrEvidBindMp | _recPatExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIcSubst) of + { _recPatExprOcSubst | _recPatExprOcSubst `seq` (True) -> + (case (_lhsItySigVarMp) of + { _recPatExprOtySigVarMp | _recPatExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _recPatExprOmoduleNm | _recPatExprOmoduleNm `seq` (True) -> + (case (_lhsIceParentNm) of + { _recPatExprOceParentNm | _recPatExprOceParentNm `seq` (True) -> + (case (recPatExpr_7 _recPatExprOcSubst _recPatExprOceParentNm _recPatExprOchrEvidBindMp _recPatExprOchrScopeBindMp _recPatExprOfinTyVarMp _recPatExprOfinValGam _recPatExprOmoduleNm _recPatExprOrangeMp _recPatExprOsysfEnv _recPatExprOtySigVarMp) of + { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppL,_recPatExprIvalCBindL) | True -> + (case (_recPatExprIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (rpatNmNm _patExprIcpNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_recPatExprIallErrSq `Seq.union` _patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_recPatExprIpp) of + { _pp | _pp `seq` (True) -> + (case (Seq.unions [ _recPatExprIerrSq + , rngLift _range mkNestErr' _pp [_patExprIerrSq, foErrSq _fo_] + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_recPatExprIextNm) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (cSubstApp _patExprIcSubst $ acoreNmHolePred _prUid) of + { _offset | _offset `seq` (True) -> + (case ((FldComputeOffset _nm _offset,_patExprIrpat) : _recPatExprIfsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_recPatExprIgathMentrelFilterMp `mentrelFilterMpUnion` _patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_recPatExprIgathTvKiVarMp `varmpUnion` _patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_recPatExprIpatCRest) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (ppFld "=" (Just _positionalNm) _nm (pp _nm) _patExprIpp : _recPatExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recPatExprIvalCBindL ++ _patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_RecPatExpr_Ext_7)) of + { ( sem_RecPatExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Ext_6)) of + { ( sem_RecPatExpr_6) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_RecPatExpr_6) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Ext_5)) of + { ( sem_RecPatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOhasAFldRef,_lhsOpositionalFldNmL,sem_RecPatExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Ext_4)) of + { ( sem_RecPatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_RecPatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecPatExpr_Ext_3)) of + { ( sem_RecPatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecPatExpr_3) }) }) }) }) }) }) }) }) }) }))))) + in sem_RecPatExpr_Ext_2)) of + { ( sem_RecPatExpr_2) | True -> + ( _lhsOgUniq,sem_RecPatExpr_2) }) }) }) }) }) }) }))) + in sem_RecPatExpr_Ext_1)) of + { ( sem_RecPatExpr_1) | True -> + ( _lhsOrange,sem_RecPatExpr_1) }) }) }) }) }) + +sem_RecPatExpr_Expr :: Range -> + T_PatExpr -> + T_RecPatExpr + +sem_RecPatExpr_Expr hsrange_ patExpr_ | hsrange_ `seq` (patExpr_ `seq` (True)) = + (case (patExpr_) of + { ( _patExprIrange,patExpr_1) | True -> + (case (rangeUnions [hsrange_, _patExprIrange, _patExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_1 :: T_RecPatExpr_1 + sem_RecPatExpr_Expr_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _patExprOgUniq | _patExprOgUniq `seq` (True) -> + (case (patExpr_1 _patExprOgUniq) of + { ( _patExprIgUniq,patExpr_2) | True -> + (case (_patExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_2 :: T_RecPatExpr_2 + sem_RecPatExpr_Expr_2 = + (\ _lhsIkiGam + _lhsIlexLev + _lhsIpredSameScopeCounter -> + _lhsIkiGam `seq` + (_lhsIlexLev `seq` + (_lhsIpredSameScopeCounter `seq` + ((case (_lhsIpredSameScopeCounter) of + { _patExprOpredSameScopeCounter | _patExprOpredSameScopeCounter `seq` (True) -> + (case (_lhsIlexLev) of + { _patExprOlexLev | _patExprOlexLev `seq` (True) -> + (case (_lhsIkiGam) of + { _patExprOkiGam | _patExprOkiGam `seq` (True) -> + (case (patExpr_2 _patExprOkiGam _patExprOlexLev _patExprOpredSameScopeCounter) of + { ( _patExprIpredSameScopeCounter,patExpr_3) | True -> + (case (_patExprIpredSameScopeCounter) of + { _lhsOpredSameScopeCounter | _lhsOpredSameScopeCounter `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_3 :: T_RecPatExpr_3 + sem_RecPatExpr_Expr_3 = + (\ _lhsIkiVarMp + _lhsIopts + _lhsIpolGam + _lhsIpolVarMp + _lhsIpredScope + _lhsItyGam + _lhsItyKiGam + _lhsItyKiGlobFreeTvarS -> + _lhsIkiVarMp `seq` + (_lhsIopts `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + (_lhsIpredScope `seq` + (_lhsItyGam `seq` + (_lhsItyKiGam `seq` + (_lhsItyKiGlobFreeTvarS `seq` + ((case (_lhsItyKiGlobFreeTvarS) of + { _patExprOtyKiGlobFreeTvarS | _patExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGam) of + { _patExprOtyKiGam | _patExprOtyKiGam `seq` (True) -> + (case (_lhsItyGam) of + { _patExprOtyGam | _patExprOtyGam `seq` (True) -> + (case (_lhsIpredScope) of + { _patExprOpredScope | _patExprOpredScope `seq` (True) -> + (case (_lhsIpolVarMp) of + { _patExprOpolVarMp | _patExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _patExprOpolGam | _patExprOpolGam `seq` (True) -> + (case (_lhsIopts) of + { _patExprOopts | _patExprOopts `seq` (True) -> + (case (_lhsIkiVarMp) of + { _patExprOkiVarMp | _patExprOkiVarMp `seq` (True) -> + (case (patExpr_3 _patExprOkiVarMp _patExprOopts _patExprOpolGam _patExprOpolVarMp _patExprOpredScope _patExprOtyGam _patExprOtyKiGam _patExprOtyKiGlobFreeTvarS) of + { ( _patExprIkiVarMp,_patExprIpolVarMp,_patExprItyGam,_patExprItyKiGam,patExpr_4) | True -> + (case (_patExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_patExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case (_patExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_patExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_4 :: T_RecPatExpr_4 + sem_RecPatExpr_Expr_4 = + (\ _lhsIclGam + _lhsIdataGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIpositionalFldNmL + _lhsItyTyTySigFreeTvarS -> + _lhsIclGam `seq` + (_lhsIdataGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIpositionalFldNmL `seq` + (_lhsItyTyTySigFreeTvarS `seq` + ((case (_lhsItyTyTySigFreeTvarS) of + { _patExprOtyTyTySigFreeTvarS | _patExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _patExprOfinTyKiGam | _patExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _patExprOfinKiVarMp | _patExprOfinKiVarMp `seq` (True) -> + (case (_lhsIdataGam) of + { _patExprOdataGam | _patExprOdataGam `seq` (True) -> + (case (_lhsIclGam) of + { _patExprOclGam | _patExprOclGam `seq` (True) -> + (case (patExpr_4 _patExprOclGam _patExprOdataGam _patExprOfinKiVarMp _patExprOfinTyKiGam _patExprOtyTyTySigFreeTvarS) of + { ( _patExprIchrInstDeclSq,_patExprItopNm,patExpr_5) | True -> + (case (_patExprIchrInstDeclSq) of + { _lhsOchrInstDeclSq | _lhsOchrInstDeclSq `seq` (True) -> + (case (False) of + { _lhsOhasAFldRef | _lhsOhasAFldRef `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_5 :: T_RecPatExpr_5 + sem_RecPatExpr_Expr_5 = + (\ _lhsIfiOpts + _lhsIknTy + _lhsImatchOnFld + _lhsIpatTyVarMp + _lhsItySigGam + _lhsIvalGam -> + _lhsIfiOpts `seq` + (_lhsIknTy `seq` + (_lhsImatchOnFld `seq` + (_lhsIpatTyVarMp `seq` + (_lhsItySigGam `seq` + (_lhsIvalGam `seq` + ((case (_lhsIvalGam) of + { _patExprOvalGam | _patExprOvalGam `seq` (True) -> + (case (_lhsItySigGam) of + { _patExprOtySigGam | _patExprOtySigGam `seq` (True) -> + (case (_lhsIpatTyVarMp) of + { _patExprOpatTyVarMp | _patExprOpatTyVarMp `seq` (True) -> + (case (_lhsIknTy) of + { _patExprOknTy | _patExprOknTy `seq` (True) -> + (case (_lhsIfiOpts) of + { _patExprOfiOpts | _patExprOfiOpts `seq` (True) -> + (case (True) of + { _patExprOinclVarBind | _patExprOinclVarBind `seq` (True) -> + (case ([]) of + { _patExprOknTyL | _patExprOknTyL `seq` (True) -> + (case (patExpr_5 _patExprOvalGam) of + { ( _patExprIarity,_patExprImbTopNm,_patExprIpatFunTy,patExpr_6) | True -> + (case (patExpr_6 _patExprOfiOpts _patExprOinclVarBind _patExprOknTy _patExprOknTyL _patExprOpatTyVarMp _patExprOtySigGam) of + { ( _patExprIpatTyVarMp,_patExprIvalGam,patExpr_7) | True -> + (case (_patExprIpatTyVarMp) of + { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> + (case (_patExprIvalGam) of + { _lhsOvalGam | _lhsOvalGam `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_6 :: T_RecPatExpr_6 + sem_RecPatExpr_Expr_6 = + (\ _lhsIchrStore + _lhsIclDfGam + _lhsItvKiVarMp + _lhsItyTyGlobFreeTvarS + _lhsItyVarMp + _lhsIvalTyGlobFreeTvarS -> + _lhsIchrStore `seq` + (_lhsIclDfGam `seq` + (_lhsItvKiVarMp `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyVarMp `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _patExprOvalTyGlobFreeTvarS | _patExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyVarMp) of + { _patExprOtyVarMp | _patExprOtyVarMp `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _patExprOtyTyGlobFreeTvarS | _patExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItvKiVarMp) of + { _patExprOtvKiVarMp | _patExprOtvKiVarMp `seq` (True) -> + (case (_lhsIclDfGam) of + { _patExprOclDfGam | _patExprOclDfGam `seq` (True) -> + (case (_lhsIchrStore) of + { _patExprOchrStore | _patExprOchrStore `seq` (True) -> + (case (patExpr_7 _patExprOchrStore _patExprOclDfGam _patExprOtvKiVarMp _patExprOtyTyGlobFreeTvarS _patExprOtyVarMp _patExprOvalTyGlobFreeTvarS) of + { ( _patExprIcpNm,_patExprIgathCnstrMp,_patExprIgathRangeMp,_patExprIscopeGam,_patExprIty,_patExprItyVarMp,patExpr_8) | True -> + (case (_patExprIgathCnstrMp) of + { _lhsOgathCnstrMp | _lhsOgathCnstrMp `seq` (True) -> + (case (_patExprIgathRangeMp) of + { _lhsOgathRangeMp | _lhsOgathRangeMp `seq` (True) -> + (case (_patExprIscopeGam) of + { _lhsOscopeGam | _lhsOscopeGam `seq` (True) -> + (case (_patExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_patExprItyVarMp) of + { _lhsOtyVarMp | _lhsOtyVarMp `seq` (True) -> + (case ((let sem_RecPatExpr_Expr_7 :: T_RecPatExpr_7 + sem_RecPatExpr_Expr_7 = + (\ _lhsIcSubst + _lhsIceParentNm + _lhsIchrEvidBindMp + _lhsIchrScopeBindMp + _lhsIfinTyVarMp + _lhsIfinValGam + _lhsImoduleNm + _lhsIrangeMp + _lhsIsysfEnv + _lhsItySigVarMp -> + _lhsIcSubst `seq` + (_lhsIceParentNm `seq` + (_lhsIchrEvidBindMp `seq` + (_lhsIchrScopeBindMp `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIfinValGam `seq` + (_lhsImoduleNm `seq` + (_lhsIrangeMp `seq` + (_lhsIsysfEnv `seq` + (_lhsItySigVarMp `seq` + ((case (_lhsIsysfEnv) of + { _patExprOsysfEnv | _patExprOsysfEnv `seq` (True) -> + (case (_lhsIrangeMp) of + { _patExprOrangeMp | _patExprOrangeMp `seq` (True) -> + (case (_lhsIfinValGam) of + { _patExprOfinValGam | _patExprOfinValGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _patExprOfinTyVarMp | _patExprOfinTyVarMp `seq` (True) -> + (case (_lhsItySigVarMp) of + { _patExprOtySigVarMp | _patExprOtySigVarMp `seq` (True) -> + (case (_lhsImoduleNm) of + { _patExprOmoduleNm | _patExprOmoduleNm `seq` (True) -> + (case (_lhsIchrScopeBindMp) of + { _patExprOchrScopeBindMp | _patExprOchrScopeBindMp `seq` (True) -> + (case (_lhsIchrEvidBindMp) of + { _patExprOchrEvidBindMp | _patExprOchrEvidBindMp `seq` (True) -> + (case (_lhsIceParentNm) of + { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> + (case (_lhsIcSubst) of + { _patExprOcSubst | _patExprOcSubst `seq` (True) -> + (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtySigVarMp) of + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprIvalCBindL) | True -> + (case (_patExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_patExprIcSubst) of + { _lhsOcSubst | _lhsOcSubst `seq` (True) -> + (case (_patExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnUnknown) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (_patExprIfsRPatL) of + { _lhsOfsRPatL | _lhsOfsRPatL `seq` (True) -> + (case (_patExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_patExprIgathTvKiVarMp) of + { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> + (case (_patExprIpatCRest) of + { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> + (case (_patExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_RecPatExpr_Expr_7)) of + { ( sem_RecPatExpr_7) | True -> + ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Expr_6)) of + { ( sem_RecPatExpr_6) | True -> + ( _lhsOpatTyVarMp,_lhsOvalGam,sem_RecPatExpr_6) }) }) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Expr_5)) of + { ( sem_RecPatExpr_5) | True -> + ( _lhsOchrInstDeclSq,_lhsOhasAFldRef,_lhsOpositionalFldNmL,sem_RecPatExpr_5) }) }) }) }) }) }) }) }) }) })))))))) + in sem_RecPatExpr_Expr_4)) of + { ( sem_RecPatExpr_4) | True -> + ( _lhsOkiVarMp,_lhsOpolVarMp,_lhsOtyGam,_lhsOtyKiGam,sem_RecPatExpr_4) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) + in sem_RecPatExpr_Expr_3)) of + { ( sem_RecPatExpr_3) | True -> + ( _lhsOpredSameScopeCounter,sem_RecPatExpr_3) }) }) }) }) }) }))))) + in sem_RecPatExpr_Expr_2)) of + { ( sem_RecPatExpr_2) | True -> + ( _lhsOgUniq,sem_RecPatExpr_2) }) }) }) }))) + in sem_RecPatExpr_Expr_1)) of + { ( sem_RecPatExpr_1) | True -> + ( _lhsOrange,sem_RecPatExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs @@ -0,0 +1,700 @@ + + + +module UHC.Light.Compiler.EH.MainAG_RowTyExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- RowTyExpr --------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attributes: + gUniq : UID + positionalFldNmL : [HsName] + visit 2: + chained attribute: + tyGam : TyGam + synthesized attribute: + tyRow : Ty + visit 3: + inherited attributes: + knPolCtx : Polarity + polGam : PolGam + chained attribute: + polVarMp : VarMp + visit 4: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 5: + chained attribute: + kiVarMp : VarMp + synthesized attribute: + tyVarWildMp : TyVarWildMp + visit 6: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + extNm : HsName + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Empty: + child hsrange : {Range} + visit 0: + local range : {Range} + alternative Ext: + child hsrange : {Range} + child rowTyExpr : RowTyExpr + child mbNm : {Maybe HsName} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 1: + local _tup218 : _ + local _tup217 : _ + visit 2: + local positionalNm : {HsName} + local nm : {HsName} + intra _tup217 : _ + intra _tup218 : _ + visit 3: + intra _tup218 : _ + intra nm : {HsName} + intra positionalNm : {HsName} + visit 4: + intra _tup218 : _ + intra nm : {HsName} + intra positionalNm : {HsName} + visit 5: + local lUniq : {UID} + local fo_ : {FIOut} + intra _tup218 : _ + intra nm : {HsName} + intra positionalNm : {HsName} + visit 6: + intra nm : {HsName} + intra positionalNm : {HsName} + alternative Var: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup221 : _ + intra range : {Range} + visit 2: + local lUniq : {UID} + local _tup219 : _ + local tgi_ : {TyGamInfo} + intra _tup221 : _ + intra range : {Range} + visit 3: + intra _tup221 : _ + intra tgi_ : {TyGamInfo} + intra range : {Range} + visit 4: + local lUniq_ki : {UID} + local _tup220 : _ + local tyKiGamNew : _ + intra _tup221 : _ + intra tgi_ : {TyGamInfo} + intra range : {Range} + visit 5: + local lUniq2 : {UID} + local tkgi_ : {TyKiGamInfo} + local fo_ : {FIOut} + intra _tup221 : _ + intra _tup220 : _ + intra range : {Range} + visit 6: + local pp : _ + intra fo_ : {FIOut} + intra range : {Range} +-} +sem_RowTyExpr_Empty :: Range -> + T_RowTyExpr + +sem_RowTyExpr_Empty hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_1 :: T_RowTyExpr_1 + sem_RowTyExpr_Empty_1 = + (\ _lhsIgUniq + _lhsIpositionalFldNmL -> + _lhsIgUniq `seq` + (_lhsIpositionalFldNmL `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_2 :: T_RowTyExpr_2 + sem_RowTyExpr_Empty_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (recRowEmp) of + { _lhsOtyRow | _lhsOtyRow `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_3 :: T_RowTyExpr_3 + sem_RowTyExpr_Empty_3 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_4 :: T_RowTyExpr_4 + sem_RowTyExpr_Empty_4 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_5 :: T_RowTyExpr_5 + sem_RowTyExpr_Empty_5 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_RowTyExpr_Empty_6 :: T_RowTyExpr_6 + sem_RowTyExpr_Empty_6 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnRowEmpty) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) })))))))))))))) + in sem_RowTyExpr_Empty_6)) of + { ( sem_RowTyExpr_6) | True -> + ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }))) + in sem_RowTyExpr_Empty_5)) of + { ( sem_RowTyExpr_5) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_RowTyExpr_5) }) }) }))) + in sem_RowTyExpr_Empty_4)) of + { ( sem_RowTyExpr_4) | True -> + ( _lhsOpolVarMp,sem_RowTyExpr_4) }) }))))) + in sem_RowTyExpr_Empty_3)) of + { ( sem_RowTyExpr_3) | True -> + ( _lhsOtyGam,_lhsOtyRow,sem_RowTyExpr_3) }) }) }))) + in sem_RowTyExpr_Empty_2)) of + { ( sem_RowTyExpr_2) | True -> + ( _lhsOgUniq,_lhsOpositionalFldNmL,sem_RowTyExpr_2) }) }) })))) + in sem_RowTyExpr_Empty_1)) of + { ( sem_RowTyExpr_1) | True -> + ( _lhsOrange,sem_RowTyExpr_1) }) }) }) + +sem_RowTyExpr_Ext :: Range -> + T_RowTyExpr -> + (Maybe HsName) -> + T_TyExpr -> + T_RowTyExpr + +sem_RowTyExpr_Ext hsrange_ rowTyExpr_ mbNm_ tyExpr_ | hsrange_ `seq` (rowTyExpr_ `seq` (mbNm_ `seq` (tyExpr_ `seq` (True)))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rowTyExpr_) of + { ( _rowTyExprIrange,rowTyExpr_1) | True -> + (case (rangeUnions [hsrange_, _rowTyExprIrange + , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_1 :: T_RowTyExpr_1 + sem_RowTyExpr_Ext_1 = + (\ _lhsIgUniq + _lhsIpositionalFldNmL -> + _lhsIgUniq `seq` + (_lhsIpositionalFldNmL `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup218 | __tup218 `seq` (True) -> + (case (__tup218) of + { (_rowTyExprOgUniq,_) | _rowTyExprOgUniq `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _rowTyExprOpositionalFldNmL | _rowTyExprOpositionalFldNmL `seq` (True) -> + (case (rowTyExpr_1 _rowTyExprOgUniq _rowTyExprOpositionalFldNmL) of + { ( _rowTyExprIgUniq,_rowTyExprIpositionalFldNmL,rowTyExpr_2) | True -> + (case (_rowTyExprIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case (hdAndTl _rowTyExprIpositionalFldNmL) of + { __tup217 | __tup217 `seq` (True) -> + (case (__tup217) of + { (_,_lhsOpositionalFldNmL) | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_2 :: T_RowTyExpr_2 + sem_RowTyExpr_Ext_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _rowTyExprOtyGam | _rowTyExprOtyGam `seq` (True) -> + (case (rowTyExpr_2 _rowTyExprOtyGam) of + { ( _rowTyExprItyGam,_rowTyExprItyRow,rowTyExpr_3) | True -> + (case (_rowTyExprItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (__tup217) of + { (_positionalNm,_) | _positionalNm `seq` (True) -> + (case (maybe _positionalNm id mbNm_) of + { _nm | _nm `seq` (True) -> + (case (Ty_Ext _rowTyExprItyRow _nm _tyExprIty) of + { _lhsOtyRow | _lhsOtyRow `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_3 :: T_RowTyExpr_3 + sem_RowTyExpr_Ext_3 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _rowTyExprOpolVarMp | _rowTyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _rowTyExprOpolGam | _rowTyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _rowTyExprOknPolCtx | _rowTyExprOknPolCtx `seq` (True) -> + (case (rowTyExpr_3 _rowTyExprOknPolCtx _rowTyExprOpolGam _rowTyExprOpolVarMp) of + { ( _rowTyExprIpolVarMp,rowTyExpr_4) | True -> + (case (_rowTyExprIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_4 :: T_RowTyExpr_4 + sem_RowTyExpr_Ext_4 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _rowTyExprOtyKiGam | _rowTyExprOtyKiGam `seq` (True) -> + (case (rowTyExpr_4 _rowTyExprOtyKiGam) of + { ( _rowTyExprIintlTyKiGam,_rowTyExprItyKiGam,rowTyExpr_5) | True -> + (case (_rowTyExprItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_rowTyExprIintlTyKiGam `gamUnion` _tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_5 :: T_RowTyExpr_5 + sem_RowTyExpr_Ext_5 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _rowTyExprOkiVarMp | _rowTyExprOkiVarMp `seq` (True) -> + (case (rowTyExpr_5 _rowTyExprOkiVarMp) of + { ( _rowTyExprIkiVarMp,_rowTyExprItyVarWildMp,rowTyExpr_6) | True -> + (case (_rowTyExprIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (__tup218) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq _tyExprIkiVarMp _tyExprIki kiStar) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_rowTyExprItyVarWildMp `Map.union` _tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_RowTyExpr_Ext_6 :: T_RowTyExpr_6 + sem_RowTyExpr_Ext_6 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _rowTyExprOvalTyGlobFreeTvarS | _rowTyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _rowTyExprOtyTyTySigFreeTvarS | _rowTyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _rowTyExprOtyTyGlobFreeTvarS | _rowTyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _rowTyExprOtyKiGlobFreeTvarS | _rowTyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _rowTyExprOsysfEnv | _rowTyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _rowTyExprOopts | _rowTyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _rowTyExprOmoduleNm | _rowTyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _rowTyExprOkiGam | _rowTyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _rowTyExprOfinTyVarMp | _rowTyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _rowTyExprOfinTyKiGam | _rowTyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _rowTyExprOfinKiVarMp | _rowTyExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> + (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL) | True -> + (case (_rowTyExprIallErrSq `Seq.union` _tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_rowTyExprIclMissNmS `Set.union` _tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_rowTyExprIclNmS `Set.union` _tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_rowTyExprIerrSq `Seq.union` _tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_rowTyExprIextNm) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (_rowTyExprIgathMentrelFilterMp `mentrelFilterMpUnion` _tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_rowTyExprIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (ppFld "::" (Just _positionalNm) _nm (pp _nm) _tyExprIpp : _rowTyExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + in sem_RowTyExpr_Ext_6)) of + { ( sem_RowTyExpr_6) | True -> + ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }) }) }) }) }) }) }))) + in sem_RowTyExpr_Ext_5)) of + { ( sem_RowTyExpr_5) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_RowTyExpr_5) }) }) }) }) }) }) }))) + in sem_RowTyExpr_Ext_4)) of + { ( sem_RowTyExpr_4) | True -> + ( _lhsOpolVarMp,sem_RowTyExpr_4) }) }) }) }) }) }) }) }) }) }) }))))) + in sem_RowTyExpr_Ext_3)) of + { ( sem_RowTyExpr_3) | True -> + ( _lhsOtyGam,_lhsOtyRow,sem_RowTyExpr_3) }) }) }) }) }) }) }) }) }))) + in sem_RowTyExpr_Ext_2)) of + { ( sem_RowTyExpr_2) | True -> + ( _lhsOgUniq,_lhsOpositionalFldNmL,sem_RowTyExpr_2) }) }) }) }) }) }) }) }) }) })))) + in sem_RowTyExpr_Ext_1)) of + { ( sem_RowTyExpr_1) | True -> + ( _lhsOrange,sem_RowTyExpr_1) }) }) }) }) }) + +sem_RowTyExpr_Var :: Range -> + HsName -> + T_RowTyExpr + +sem_RowTyExpr_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_RowTyExpr_Var_1 :: T_RowTyExpr_1 + sem_RowTyExpr_Var_1 = + (\ _lhsIgUniq + _lhsIpositionalFldNmL -> + _lhsIgUniq `seq` + (_lhsIpositionalFldNmL `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq2,lUniq_ki)}}} )) of + { __tup221 | __tup221 `seq` (True) -> + (case (__tup221) of + { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL | _lhsOpositionalFldNmL `seq` (True) -> + (case ((let sem_RowTyExpr_Var_2 :: T_RowTyExpr_2 + sem_RowTyExpr_Var_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup221) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (tyGamLookupOrAdd _lUniq nm_ _lhsItyGam _lhsItyGam) of + { __tup219 | __tup219 `seq` (True) -> + (case (__tup219) of + { (_,_lhsOtyGam) | _lhsOtyGam `seq` (True) -> + (case (__tup219) of + { (_tgi_,_) | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _lhsOtyRow | _lhsOtyRow `seq` (True) -> + (case ((let sem_RowTyExpr_Var_3 :: T_RowTyExpr_3 + sem_RowTyExpr_Var_3 = + (\ _lhsIknPolCtx + _lhsIpolGam + _lhsIpolVarMp -> + _lhsIknPolCtx `seq` + (_lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_RowTyExpr_Var_4 :: T_RowTyExpr_4 + sem_RowTyExpr_Var_4 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup221) of + { (_,_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (tyKiGamLookupOrAdd _lUniq_ki (tgiTy _tgi_) _lhsItyKiGam) of + { __tup220 | __tup220 `seq` (True) -> + (case (__tup220) of + { (_,_,_tyKiGamNew) | _tyKiGamNew `seq` (True) -> + (case (_tyKiGamNew) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (__tup220) of + { (_,_lhsOtyKiGam,_) | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_RowTyExpr_Var_5 :: T_RowTyExpr_5 + sem_RowTyExpr_Var_5 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (__tup221) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case (__tup220) of + { (_tkgi_,_,_) | _tkgi_ `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq2 _lhsIkiVarMp (tkgiKi _tkgi_) kiRow) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_RowTyExpr_Var_6 :: T_RowTyExpr_6 + sem_RowTyExpr_Var_6 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [foErrSq _fo_]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (hsnUnknown) of + { _lhsOextNm | _lhsOextNm `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) })))))))))))))) + in sem_RowTyExpr_Var_6)) of + { ( sem_RowTyExpr_6) | True -> + ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }) }) }) }))) + in sem_RowTyExpr_Var_5)) of + { ( sem_RowTyExpr_5) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_RowTyExpr_5) }) }) }) }) }) }))) + in sem_RowTyExpr_Var_4)) of + { ( sem_RowTyExpr_4) | True -> + ( _lhsOpolVarMp,sem_RowTyExpr_4) }) }))))) + in sem_RowTyExpr_Var_3)) of + { ( sem_RowTyExpr_3) | True -> + ( _lhsOtyGam,_lhsOtyRow,sem_RowTyExpr_3) }) }) }) }) }) }))) + in sem_RowTyExpr_Var_2)) of + { ( sem_RowTyExpr_2) | True -> + ( _lhsOgUniq,_lhsOpositionalFldNmL,sem_RowTyExpr_2) }) }) }) })))) + in sem_RowTyExpr_Var_1)) of + { ( sem_RowTyExpr_1) | True -> + ( _lhsOrange,sem_RowTyExpr_1) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs @@ -0,0 +1,3438 @@ + + + +module UHC.Light.Compiler.EH.MainAG_TyExpr where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- TyExpr ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + tyGam : TyGam + synthesized attribute: + ty : Ty + visit 3: + inherited attribute: + knPolCtx : Polarity + synthesized attribute: + polVarL : [Polarity] + visit 4: + inherited attribute: + polGam : PolGam + chained attribute: + polVarMp : VarMp + synthesized attribute: + mbStrictness : Maybe Strictness + visit 5: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 6: + chained attribute: + kiVarMp : VarMp + synthesized attributes: + gathTyVarPolGam : PolGam + ki : Ty + pol : Polarity + tyVarWildMp : TyVarWildMp + visit 7: + inherited attribute: + clGam : ClGam + synthesized attribute: + evTy : Ty + visit 8: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + appArgPPL : [PP_Doc] + appFunNm : HsName + appFunPP : PP_Doc + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + tyWildL : TyL + alternatives: + alternative Con: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup226 : _ + intra range : {Range} + visit 2: + local ty : {Ty} + intra _tup226 : _ + intra range : {Range} + visit 3: + intra _tup226 : _ + intra ty : {Ty} + intra range : {Range} + visit 4: + local lUniq_17_fitsIn_pol : {UID} + local _tup222 : _ + local pgi_ : {PolGamInfo} + local polFromEnv : _ + local foPol : {FIOut} + intra _tup226 : _ + intra ty : {Ty} + intra range : {Range} + visit 5: + intra foPol : {FIOut} + intra ty : {Ty} + intra _tup222 : _ + intra range : {Range} + visit 6: + local _tup225 : _ + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra foPol : {FIOut} + intra ty : {Ty} + intra _tup222 : _ + intra range : {Range} + visit 7: + intra ty : {Ty} + intra _tup225 : _ + intra _tup222 : _ + intra foPol : {FIOut} + intra range : {Range} + visit 8: + local pp : _ + local nmErrs2 : {ErrL} + local _tup224 : _ + local nmErrs : {ErrL} + local nmPolErrs : {ErrL} + local gathMentrelFilterMp : _ + intra _tup225 : _ + intra _tup222 : _ + intra foPol : {FIOut} + intra range : {Range} + alternative App: + child hsrange : {Range} + child func : TyExpr + child arg : TyExpr + visit 0: + local range : {Range} + visit 1: + local _tup228 : _ + intra range : {Range} + visit 2: + local ty : {Ty} + intra _tup228 : _ + intra range : {Range} + visit 3: + intra _tup228 : _ + intra range : {Range} + visit 4: + local lUniq_17_polArg : {UID} + local polArgVar : {Ty} + local knFuncPol : _ + intra _tup228 : _ + intra range : {Range} + visit 5: + intra _tup228 : _ + intra range : {Range} + visit 6: + local lUniq : {UID} + local knResKi : _ + local ki : {Ty} + local lUniq2 : {UID} + local knFunKi : {Ty} + local fo_ : {FIOut} + intra _tup228 : _ + intra range : {Range} + visit 7: + local evTy : _ + intra fo_ : {FIOut} + intra range : {Range} + visit 8: + local _tup227 : _ + local pp : _ + intra fo_ : {FIOut} + intra range : {Range} + alternative AppTop: + child hsrange : {Range} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 1: + intra range : {Range} + visit 2: + intra range : {Range} + visit 3: + intra range : {Range} + visit 4: + intra range : {Range} + visit 5: + intra range : {Range} + visit 6: + intra range : {Range} + visit 7: + intra range : {Range} + visit 8: + local pp : _ + intra range : {Range} + alternative Parens: + child hsrange : {Range} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 8: + local pp : _ + alternative Ann: + child hsrange : {Range} + child ann : TyExprAnn + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 2: + local ty : {Ty} + visit 8: + local pp : _ + alternative Wild: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 1: + local _tup229 : _ + visit 2: + local lUniq : {UID} + local tyVarId : {UID} + local tvarv : {Ty} + local tgi_ : {TyGamInfo} + local ty : {Ty} + intra _tup229 : _ + visit 3: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 4: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 5: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Mono: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 1: + local _tup230 : _ + visit 2: + local lUniq : {UID} + local tyVarId : {UID} + local tvarv : {Ty} + local tgi_ : {TyGamInfo} + local ty : {Ty} + intra _tup230 : _ + visit 3: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 4: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 5: + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra tvarv : {Ty} + intra tyVarId : {UID} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Var: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup235 : _ + intra range : {Range} + visit 2: + local lUniq : {UID} + local _tup233 : _ + local tgi_ : {TyGamInfo} + local ty : {Ty} + intra _tup235 : _ + intra range : {Range} + visit 3: + intra _tup235 : _ + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + intra range : {Range} + visit 4: + local lUniq_17_fitsIn_pol : {UID} + local _tup231 : _ + local pgi_ : {PolGamInfo} + local polFromEnv : _ + local foPol : {FIOut} + intra _tup235 : _ + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + intra range : {Range} + visit 5: + local lUniq_ki : {UID} + local _tup234 : _ + local tyKiGamNew : _ + intra _tup235 : _ + intra tgi_ : {TyGamInfo} + intra foPol : {FIOut} + intra ty : {Ty} + intra range : {Range} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra _tup234 : _ + intra foPol : {FIOut} + intra ty : {Ty} + intra range : {Range} + visit 7: + intra ty : {Ty} + intra foPol : {FIOut} + intra range : {Range} + visit 8: + local pp : _ + intra foPol : {FIOut} + intra range : {Range} + alternative VarWild: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup239 : _ + visit 2: + local lUniq : {UID} + local _tup237 : _ + local tgi_ : {TyGamInfo} + local ty : {Ty} + intra _tup239 : _ + visit 3: + intra _tup239 : _ + intra tgi_ : {TyGamInfo} + intra lUniq : {UID} + intra ty : {Ty} + visit 4: + intra _tup239 : _ + intra tgi_ : {TyGamInfo} + intra lUniq : {UID} + intra ty : {Ty} + visit 5: + local lUniq_ki : {UID} + local _tup238 : _ + local tyKiGamNew : _ + intra _tup239 : _ + intra tgi_ : {TyGamInfo} + intra lUniq : {UID} + intra ty : {Ty} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + local tyVarId : {UID} + intra _tup238 : _ + intra lUniq : {UID} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Quant: + child hsrange : {Range} + child qu : {TyQu} + child tyVar : {HsName} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 1: + local _tup242 : _ + visit 2: + local lUniq_ki : {UID} + local lUniq : {UID} + local _tup241 : _ + local tkgi_ : {TyKiGamInfo} + local tgi_ : {TyGamInfo} + local tv : {UID} + local ty : {Ty} + intra _tup242 : _ + visit 3: + intra tkgi_ : {TyKiGamInfo} + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + visit 4: + intra tkgi_ : {TyKiGamInfo} + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + visit 5: + local tyKiGamNew : _ + intra tkgi_ : {TyKiGamInfo} + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + visit 6: + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Row: + child hsrange : {Range} + child rowTyExpr : RowTyExpr + visit 0: + local range : {Range} + visit 2: + local ty : {Ty} + visit 3: + intra ty : {Ty} + visit 4: + intra ty : {Ty} + visit 5: + intra ty : {Ty} + visit 6: + local ki : {Ty} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Pred: + child hsrange : {Range} + child prExpr : PrExpr + visit 0: + local range : {Range} + visit 8: + local pp : _ + alternative Impls: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 1: + local _tup243 : _ + visit 2: + local lUniq : {UID} + local implsVarId : {UID} + local tgi_ : {TyGamInfo} + local ty : {Ty} + intra _tup243 : _ + visit 3: + intra implsVarId : {UID} + intra ty : {Ty} + visit 4: + intra implsVarId : {UID} + intra ty : {Ty} + visit 5: + intra implsVarId : {UID} + intra ty : {Ty} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra implsVarId : {UID} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative NoImpls: + child hsrange : {Range} + visit 0: + local range : {Range} + visit 2: + local tgi_ : {TyGamInfo} + local ty : {Ty} + visit 3: + intra ty : {Ty} + visit 4: + intra ty : {Ty} + visit 5: + intra ty : {Ty} + visit 6: + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ + alternative Lam: + child hsrange : {Range} + child tyVar : {HsName} + child tyExpr : TyExpr + visit 0: + local range : {Range} + visit 1: + local _tup245 : _ + visit 2: + local lUniq_ki : {UID} + local lUniq : {UID} + local _tup244 : _ + local tgi_ : {TyGamInfo} + local tv : {UID} + local ty : {Ty} + intra _tup245 : _ + visit 3: + intra _tup245 : _ + intra _tup244 : _ + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + visit 4: + local lUniq_17_polRes : {UID} + local lUniq_17_polArg : {UID} + local lUniq_17_fitsIn_pol : {UID} + local polResVar : {Ty} + local polArgVar : {Ty} + local foPol : {FIOut} + intra _tup245 : _ + intra _tup244 : _ + intra tgi_ : {TyGamInfo} + intra ty : {Ty} + visit 5: + local tkgi_ : {TyKiGamInfo} + local tyKiGamNew : _ + intra _tup244 : _ + intra tgi_ : {TyGamInfo} + intra polArgVar : {Ty} + intra ty : {Ty} + visit 6: + local ki : {Ty} + intra tkgi_ : {TyKiGamInfo} + intra polArgVar : {Ty} + intra ty : {Ty} + visit 7: + intra ty : {Ty} + visit 8: + local pp : _ +-} +sem_TyExpr_Con :: Range -> + HsName -> + T_TyExpr + +sem_TyExpr_Con hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Con_1 :: T_TyExpr_1 + sem_TyExpr_Con_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq_17_fitsIn_pol) -> (__cont,lUniq_17_fitsIn_pol)} )) of + { __tup226 | __tup226 `seq` (True) -> + (case (__tup226) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Con_2 :: T_TyExpr_2 + sem_TyExpr_Con_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (Ty_Con nm_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Con_3 :: T_TyExpr_3 + sem_TyExpr_Con_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Con_4 :: T_TyExpr_4 + sem_TyExpr_Con_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (__tup226) of + { (_,_lUniq_17_fitsIn_pol) | _lUniq_17_fitsIn_pol `seq` (True) -> + (case (polGamLookupErr nm_ _lhsIpolGam) of + { __tup222 | __tup222 `seq` (True) -> + (case (__tup222) of + { (_pgi_,_) | _pgi_ `seq` (True) -> + (case (pgiPol _pgi_) of + { _polFromEnv | _polFromEnv `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq_17_fitsIn_pol _lhsIpolVarMp _polFromEnv _lhsIknPolCtx) of + { _foPol | _foPol `seq` (True) -> + (case (foVarMp _foPol `varUpd` _lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Con_5 :: T_TyExpr_5 + sem_TyExpr_Con_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Con_6 :: T_TyExpr_6 + sem_TyExpr_Con_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (tyKiGamLookupByNameErr nm_ _lhsItyKiGam) of + { __tup225 | __tup225 `seq` (True) -> + (case (__tup225) of + { (_tkgi_,_) | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (foTy _foPol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Con_7 :: T_TyExpr_7 + sem_TyExpr_Con_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Con_8 :: T_TyExpr_8 + sem_TyExpr_Con_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (nm_) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppCon nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (__tup225) of + { (_,_nmErrs2) | _nmErrs2 `seq` (True) -> + (case (tyGamLookupErr nm_ _lhsItyGam) of + { __tup224 | __tup224 `seq` (True) -> + (case (__tup224) of + { (_,_nmErrs) | _nmErrs `seq` (True) -> + (case (__tup222) of + { (_,_nmPolErrs) | _nmPolErrs `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [Seq.fromList $ firstNotEmpty [_nmErrs,_nmErrs2,_nmPolErrs], foErrSq _foPol ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Type nm_) of + { _gathMentrelFilterMp | _gathMentrelFilterMp `seq` (True) -> + (case (_gathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Con_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Con_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Con_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }))) + in sem_TyExpr_Con_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Con_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Con_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }))) + in sem_TyExpr_Con_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_Con_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_App :: Range -> + T_TyExpr -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_App hsrange_ func_ arg_ | hsrange_ `seq` (func_ `seq` (arg_ `seq` (True))) = + (case (arg_) of + { ( _argIrange,arg_1) | True -> + (case (func_) of + { ( _funcIrange,func_1) | True -> + (case (rangeUnions [hsrange_, _funcIrange , _argIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_App_1 :: T_TyExpr_1 + sem_TyExpr_App_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq2) -> case nextUnique __cont of { (__cont, lUniq_17_polArg) -> (__cont,lUniq,lUniq2,lUniq_17_polArg)}}} )) of + { __tup228 | __tup228 `seq` (True) -> + (case (__tup228) of + { (_funcOgUniq,_,_,_) | _funcOgUniq `seq` (True) -> + (case (func_1 _funcOgUniq) of + { ( _funcIgUniq,func_2) | True -> + (case (_funcIgUniq) of + { _argOgUniq | _argOgUniq `seq` (True) -> + (case (arg_1 _argOgUniq) of + { ( _argIgUniq,arg_2) | True -> + (case (_argIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_App_2 :: T_TyExpr_2 + sem_TyExpr_App_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _funcOtyGam | _funcOtyGam `seq` (True) -> + (case (func_2 _funcOtyGam) of + { ( _funcIty,_funcItyGam,func_3) | True -> + (case (_funcItyGam) of + { _argOtyGam | _argOtyGam `seq` (True) -> + (case (arg_2 _argOtyGam) of + { ( _argIty,_argItyGam,arg_3) | True -> + (case (Ty_App _funcIty _argIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_argItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_App_3 :: T_TyExpr_3 + sem_TyExpr_App_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_App_4 :: T_TyExpr_4 + sem_TyExpr_App_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _funcOpolVarMp | _funcOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _funcOpolGam | _funcOpolGam `seq` (True) -> + (case (__tup228) of + { (_,_,_,_lUniq_17_polArg) | _lUniq_17_polArg `seq` (True) -> + (case (mkPolVar _lUniq_17_polArg) of + { _polArgVar | _polArgVar `seq` (True) -> + (case ([_polArgVar] `appArr` _lhsIknPolCtx) of + { _knFuncPol | _knFuncPol `seq` (True) -> + (case (_knFuncPol) of + { _funcOknPolCtx | _funcOknPolCtx `seq` (True) -> + (case (func_3 _funcOknPolCtx) of + { ( _funcIpolVarL,func_4) | True -> + (case (func_4 _funcOpolGam _funcOpolVarMp) of + { ( _funcImbStrictness,_funcIpolVarMp,func_5) | True -> + (case (_funcIpolVarMp) of + { _argOpolVarMp | _argOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _argOpolGam | _argOpolGam `seq` (True) -> + (case (_polArgVar) of + { _argOknPolCtx | _argOknPolCtx `seq` (True) -> + (case (arg_3 _argOknPolCtx) of + { ( _argIpolVarL,arg_4) | True -> + (case (arg_4 _argOpolGam _argOpolVarMp) of + { ( _argImbStrictness,_argIpolVarMp,arg_5) | True -> + (case (_argIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_App_5 :: T_TyExpr_5 + sem_TyExpr_App_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _funcOtyKiGam | _funcOtyKiGam `seq` (True) -> + (case (func_5 _funcOtyKiGam) of + { ( _funcIintlTyKiGam,_funcItyKiGam,func_6) | True -> + (case (_funcItyKiGam) of + { _argOtyKiGam | _argOtyKiGam `seq` (True) -> + (case (arg_5 _argOtyKiGam) of + { ( _argIintlTyKiGam,_argItyKiGam,arg_6) | True -> + (case (_funcIintlTyKiGam `gamUnion` _argIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_argItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_App_6 :: T_TyExpr_6 + sem_TyExpr_App_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _funcOkiVarMp | _funcOkiVarMp `seq` (True) -> + (case (func_6 _funcOkiVarMp) of + { ( _funcIgathTyVarPolGam,_funcIki,_funcIkiVarMp,_funcIpol,_funcItyVarWildMp,func_7) | True -> + (case (_funcIkiVarMp) of + { _argOkiVarMp | _argOkiVarMp `seq` (True) -> + (case (arg_6 _argOkiVarMp) of + { ( _argIgathTyVarPolGam,_argIki,_argIkiVarMp,_argIpol,_argItyVarWildMp,arg_7) | True -> + (case (_funcIgathTyVarPolGam `gamUnion` _argIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (__tup228) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (mkNewTyVar _lUniq) of + { _knResKi | _knResKi `seq` (True) -> + (case (_knResKi) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (__tup228) of + { (_,_,_lUniq2,_) | _lUniq2 `seq` (True) -> + (case ([_argIki] `appArr` _knResKi) of + { _knFunKi | _knFunKi `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq2 _argIkiVarMp _funcIki _knFunKi) of + { _fo_ | _fo_ `seq` (True) -> + (case (foVarMp _fo_ `varUpd` _argIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_funcItyVarWildMp `Map.union` _argItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_App_7 :: T_TyExpr_7 + sem_TyExpr_App_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _argOclGam | _argOclGam `seq` (True) -> + (case (_lhsIclGam) of + { _funcOclGam | _funcOclGam `seq` (True) -> + (case (arg_7 _argOclGam) of + { ( _argIevTy,arg_8) | True -> + (case (func_7 _funcOclGam) of + { ( _funcIevTy,func_8) | True -> + (case (Ty_App _funcIevTy _argIevTy) of + { _evTy | _evTy `seq` (True) -> + (case (_evTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_App_8 :: T_TyExpr_8 + sem_TyExpr_App_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _argOvalTyGlobFreeTvarS | _argOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _argOtyTyTySigFreeTvarS | _argOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _argOtyTyGlobFreeTvarS | _argOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _argOtyKiGlobFreeTvarS | _argOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _argOsysfEnv | _argOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _argOmoduleNm | _argOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _argOkiGam | _argOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _argOfinTyVarMp | _argOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _argOfinTyKiGam | _argOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> + (case (arg_8 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOkiGam _argOmoduleNm _argOopts _argOsysfEnv _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argItyWildL) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _funcOvalTyGlobFreeTvarS | _funcOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _funcOtyTyTySigFreeTvarS | _funcOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _funcOtyTyGlobFreeTvarS | _funcOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _funcOtyKiGlobFreeTvarS | _funcOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _funcOsysfEnv | _funcOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm | _funcOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _funcOkiGam | _funcOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _funcOfinTyVarMp | _funcOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _funcOfinTyKiGam | _funcOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _funcOfinKiVarMp | _funcOfinKiVarMp `seq` (True) -> + (case (func_8 _funcOfinKiVarMp _funcOfinTyKiGam _funcOfinTyVarMp _funcOkiGam _funcOmoduleNm _funcOopts _funcOsysfEnv _funcOtyKiGlobFreeTvarS _funcOtyTyGlobFreeTvarS _funcOtyTyTySigFreeTvarS _funcOvalTyGlobFreeTvarS) of + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIclMissNmS,_funcIclNmS,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp,_funcItyWildL) | True -> + (case (_funcIallErrSq `Seq.union` _argIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (mkExtAppPP (_funcIappFunNm,_funcIappFunPP,_funcIappArgPPL) + (_argIappFunNm,_argIappFunPP,_argIappArgPPL,_argIpp)) of + { __tup227 | __tup227 `seq` (True) -> + (case (__tup227) of + { (_,_lhsOappArgPPL) | _lhsOappArgPPL `seq` (True) -> + (case (_funcIappFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (__tup227) of + { (_lhsOappFunPP,_) | _lhsOappFunPP `seq` (True) -> + (case (_funcIclMissNmS `Set.union` _argIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_funcIclNmS `Set.union` _argIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_funcIpp >#< _argIpp) of + { _pp | _pp `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [ _funcIerrSq, _argIerrSq + , foErrSq _fo_ + ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_funcIgathMentrelFilterMp `mentrelFilterMpUnion` _argIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_funcItyWildL ++ _argItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_App_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }) }) }) }) }) }))) + in sem_TyExpr_App_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_App_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }) }) }))) + in sem_TyExpr_App_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))) + in sem_TyExpr_App_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_App_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }) }))) + in sem_TyExpr_App_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }) }) }) }))) + in sem_TyExpr_App_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) }) + +sem_TyExpr_AppTop :: Range -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_AppTop hsrange_ tyExpr_ | hsrange_ `seq` (tyExpr_ `seq` (True)) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_AppTop_1 :: T_TyExpr_1 + sem_TyExpr_AppTop_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_AppTop_2 :: T_TyExpr_2 + sem_TyExpr_AppTop_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (_tyExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_AppTop_3 :: T_TyExpr_3 + sem_TyExpr_AppTop_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_AppTop_4 :: T_TyExpr_4 + sem_TyExpr_AppTop_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_AppTop_5 :: T_TyExpr_5 + sem_TyExpr_AppTop_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_AppTop_6 :: T_TyExpr_6 + sem_TyExpr_AppTop_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_tyExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprIpol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_AppTop_7 :: T_TyExpr_7 + sem_TyExpr_AppTop_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_tyExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_AppTop_8 :: T_TyExpr_8 + sem_TyExpr_AppTop_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppAppTop (_tyExprIappFunNm,_tyExprIappFunPP) + _tyExprIappArgPPL _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [_tyExprIerrSq]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_AppTop_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) + in sem_TyExpr_AppTop_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_AppTop_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }))) + in sem_TyExpr_AppTop_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_AppTop_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_AppTop_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }))) + in sem_TyExpr_AppTop_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }))) + in sem_TyExpr_AppTop_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Parens :: Range -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_Parens hsrange_ tyExpr_ | hsrange_ `seq` (tyExpr_ `seq` (True)) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Parens_1 :: T_TyExpr_1 + sem_TyExpr_Parens_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Parens_2 :: T_TyExpr_2 + sem_TyExpr_Parens_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (_tyExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Parens_3 :: T_TyExpr_3 + sem_TyExpr_Parens_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Parens_4 :: T_TyExpr_4 + sem_TyExpr_Parens_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Parens_5 :: T_TyExpr_5 + sem_TyExpr_Parens_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Parens_6 :: T_TyExpr_6 + sem_TyExpr_Parens_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_tyExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprIpol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Parens_7 :: T_TyExpr_7 + sem_TyExpr_Parens_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_tyExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Parens_8 :: T_TyExpr_8 + sem_TyExpr_Parens_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (ppParens _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Parens_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) + in sem_TyExpr_Parens_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Parens_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }))) + in sem_TyExpr_Parens_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Parens_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Parens_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }))) + in sem_TyExpr_Parens_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }))) + in sem_TyExpr_Parens_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Ann :: Range -> + T_TyExprAnn -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_Ann hsrange_ ann_ tyExpr_ | hsrange_ `seq` (ann_ `seq` (tyExpr_ `seq` (True))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Ann_1 :: T_TyExpr_1 + sem_TyExpr_Ann_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _tyExprOgUniq | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Ann_2 :: T_TyExpr_2 + sem_TyExpr_Ann_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (ann_) of + { ( _annIann,_annIisEmpty,_annImbStrictness,_annIpp) | True -> + (case (if _annIisEmpty + then _tyExprIty + else Ty_Ann _annIann _tyExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Ann_3 :: T_TyExpr_3 + sem_TyExpr_Ann_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Ann_4 :: T_TyExpr_4 + sem_TyExpr_Ann_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_annImbStrictness <|> _tyExprImbStrictness) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Ann_5 :: T_TyExpr_5 + sem_TyExpr_Ann_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (_tyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Ann_6 :: T_TyExpr_6 + sem_TyExpr_Ann_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_tyExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprIpol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Ann_7 :: T_TyExpr_7 + sem_TyExpr_Ann_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_tyExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Ann_8 :: T_TyExpr_8 + sem_TyExpr_Ann_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_annIpp >#< _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Ann_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) + in sem_TyExpr_Ann_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Ann_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }))) + in sem_TyExpr_Ann_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Ann_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Ann_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }))) + in sem_TyExpr_Ann_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }))) + in sem_TyExpr_Ann_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Wild :: Range -> + T_TyExpr + +sem_TyExpr_Wild hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Wild_1 :: T_TyExpr_1 + sem_TyExpr_Wild_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup229 | __tup229 `seq` (True) -> + (case (__tup229) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Wild_2 :: T_TyExpr_2 + sem_TyExpr_Wild_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup229) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (_lUniq) of + { _tyVarId | _tyVarId `seq` (True) -> + (case (mkNewTyVar _tyVarId) of + { _tvarv | _tvarv `seq` (True) -> + (case (mkTGI _tvarv) of + { _tgi_ | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Wild_3 :: T_TyExpr_3 + sem_TyExpr_Wild_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Wild_4 :: T_TyExpr_4 + sem_TyExpr_Wild_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Wild_5 :: T_TyExpr_5 + sem_TyExpr_Wild_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Wild_6 :: T_TyExpr_6 + sem_TyExpr_Wild_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (TyKiGamInfo _tvarv) of + { _tkgi_ | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.singleton _tyVarId TyVarWild_NoQuantTyExpr_YesQuantLetBinding) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Wild_7 :: T_TyExpr_7 + sem_TyExpr_Wild_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Wild_8 :: T_TyExpr_8 + sem_TyExpr_Wild_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp "...") of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Wild_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Wild_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Wild_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }))) + in sem_TyExpr_Wild_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) })))) + in sem_TyExpr_Wild_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Wild_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Wild_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_Wild_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_Mono :: Range -> + T_TyExpr + +sem_TyExpr_Mono hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Mono_1 :: T_TyExpr_1 + sem_TyExpr_Mono_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup230 | __tup230 `seq` (True) -> + (case (__tup230) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Mono_2 :: T_TyExpr_2 + sem_TyExpr_Mono_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup230) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (_lUniq) of + { _tyVarId | _tyVarId `seq` (True) -> + (case (mkNewTyVar _tyVarId) of + { _tvarv | _tvarv `seq` (True) -> + (case (mkTGI (Ty_Ann TyAnn_Mono _tvarv)) of + { _tgi_ | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Mono_3 :: T_TyExpr_3 + sem_TyExpr_Mono_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Mono_4 :: T_TyExpr_4 + sem_TyExpr_Mono_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Mono_5 :: T_TyExpr_5 + sem_TyExpr_Mono_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Mono_6 :: T_TyExpr_6 + sem_TyExpr_Mono_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (TyKiGamInfo _tvarv) of + { _tkgi_ | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.singleton _tyVarId TyVarWild_NoQuantTyExpr_NoQuantLetBinding) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Mono_7 :: T_TyExpr_7 + sem_TyExpr_Mono_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Mono_8 :: T_TyExpr_8 + sem_TyExpr_Mono_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp "%...") of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Mono_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Mono_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Mono_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }))) + in sem_TyExpr_Mono_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) })))) + in sem_TyExpr_Mono_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Mono_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Mono_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_Mono_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_Var :: Range -> + HsName -> + T_TyExpr + +sem_TyExpr_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Var_1 :: T_TyExpr_1 + sem_TyExpr_Var_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_17_fitsIn_pol) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_17_fitsIn_pol,lUniq_ki)}}} )) of + { __tup235 | __tup235 `seq` (True) -> + (case (__tup235) of + { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Var_2 :: T_TyExpr_2 + sem_TyExpr_Var_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup235) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (tyGamLookupOrAdd _lUniq nm_ _lhsItyGam _lhsItyGam) of + { __tup233 | __tup233 `seq` (True) -> + (case (__tup233) of + { (_tgi_,_) | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (__tup233) of + { (_,_lhsOtyGam) | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Var_3 :: T_TyExpr_3 + sem_TyExpr_Var_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([_lhsIknPolCtx]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Var_4 :: T_TyExpr_4 + sem_TyExpr_Var_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (__tup235) of + { (_,_,_lUniq_17_fitsIn_pol,_) | _lUniq_17_fitsIn_pol `seq` (True) -> + (case (polGamLookupErr nm_ _lhsIpolGam) of + { __tup231 | __tup231 `seq` (True) -> + (case (__tup231) of + { (_pgi_,_) | _pgi_ `seq` (True) -> + (case (pgiPol _pgi_) of + { _polFromEnv | _polFromEnv `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq_17_fitsIn_pol _lhsIpolVarMp _polFromEnv _lhsIknPolCtx) of + { _foPol | _foPol `seq` (True) -> + (case (foVarMp _foPol `varUpd` _lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Var_5 :: T_TyExpr_5 + sem_TyExpr_Var_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup235) of + { (_,_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (tyKiGamLookupOrAdd _lUniq_ki (tgiTy _tgi_) _lhsItyKiGam) of + { __tup234 | __tup234 `seq` (True) -> + (case (__tup234) of + { (_,_,_tyKiGamNew) | _tyKiGamNew `seq` (True) -> + (case (_tyKiGamNew) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (__tup234) of + { (_,_lhsOtyKiGam,_) | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Var_6 :: T_TyExpr_6 + sem_TyExpr_Var_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (gamSingleton nm_ (mkPGI _lhsIknPolCtx)) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (__tup234) of + { (_tkgi_,_,_) | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (foTy _foPol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Var_7 :: T_TyExpr_7 + sem_TyExpr_Var_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Var_8 :: T_TyExpr_8 + sem_TyExpr_Var_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (rngLift _range mkNestErr' _pp [foErrSq _foPol ]) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Var_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Var_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Var_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }) }))) + in sem_TyExpr_Var_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Var_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Var_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }))) + in sem_TyExpr_Var_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_Var_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_VarWild :: Range -> + HsName -> + T_TyExpr + +sem_TyExpr_VarWild hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_VarWild_1 :: T_TyExpr_1 + sem_TyExpr_VarWild_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_ki)}} )) of + { __tup239 | __tup239 `seq` (True) -> + (case (__tup239) of + { (_lhsOgUniq,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_VarWild_2 :: T_TyExpr_2 + sem_TyExpr_VarWild_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup239) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (tyGamLookupOrAdd _lUniq nm_ _lhsItyGam _lhsItyGam) of + { __tup237 | __tup237 `seq` (True) -> + (case (__tup237) of + { (_tgi_,_) | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (__tup237) of + { (_,_lhsOtyGam) | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_VarWild_3 :: T_TyExpr_3 + sem_TyExpr_VarWild_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_VarWild_4 :: T_TyExpr_4 + sem_TyExpr_VarWild_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_VarWild_5 :: T_TyExpr_5 + sem_TyExpr_VarWild_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup239) of + { (_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (tyKiGamLookupOrAdd _lUniq_ki (tgiTy _tgi_) _lhsItyKiGam) of + { __tup238 | __tup238 `seq` (True) -> + (case (__tup238) of + { (_,_,_tyKiGamNew) | _tyKiGamNew `seq` (True) -> + (case (_tyKiGamNew) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (__tup238) of + { (_,_lhsOtyKiGam,_) | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_VarWild_6 :: T_TyExpr_6 + sem_TyExpr_VarWild_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (__tup238) of + { (_tkgi_,_,_) | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_lUniq) of + { _tyVarId | _tyVarId `seq` (True) -> + (case (Map.singleton _tyVarId TyVarWild_NoQuantTyExpr_YesQuantLetBinding) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_VarWild_7 :: T_TyExpr_7 + sem_TyExpr_VarWild_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_VarWild_8 :: T_TyExpr_8 + sem_TyExpr_VarWild_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ("%" >|< pp nm_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_VarWild_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_VarWild_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_VarWild_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }) }))) + in sem_TyExpr_VarWild_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) })))) + in sem_TyExpr_VarWild_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_VarWild_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }))) + in sem_TyExpr_VarWild_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_VarWild_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_Quant :: Range -> + TyQu -> + HsName -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_Quant hsrange_ qu_ tyVar_ tyExpr_ | hsrange_ `seq` (qu_ `seq` (tyVar_ `seq` (tyExpr_ `seq` (True)))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Quant_1 :: T_TyExpr_1 + sem_TyExpr_Quant_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_ki)}} )) of + { __tup242 | __tup242 `seq` (True) -> + (case (__tup242) of + { (_tyExprOgUniq,_,_) | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Quant_2 :: T_TyExpr_2 + sem_TyExpr_Quant_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup242) of + { (_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (__tup242) of + { (_,_lUniq,_) | _lUniq `seq` (True) -> + (case (let t = mkTyVar _lUniq + in (_lUniq,mkTGI t,TyKiGamInfo (mkNewTyVar _lUniq_ki))) of + { __tup241 | __tup241 `seq` (True) -> + (case (__tup241) of + { (_,_,_tkgi_) | _tkgi_ `seq` (True) -> + (case (__tup241) of + { (_,_tgi_,_) | _tgi_ `seq` (True) -> + (case (__tup241) of + { (_tv,_,_) | _tv `seq` (True) -> + (case (tvGathFlowIn (tyVar_ `gamSingleton` _tgi_) _lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (Ty_TBind qu_ _tv + (tkgiKi _tkgi_) + _tyExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (tvGathFlowOut _lhsItyGam _tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Quant_3 :: T_TyExpr_3 + sem_TyExpr_Quant_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Quant_4 :: T_TyExpr_4 + sem_TyExpr_Quant_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Quant_5 :: T_TyExpr_5 + sem_TyExpr_Quant_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (tgiTy _tgi_ `tyKiGamSingleton` _tkgi_) of + { _tyKiGamNew | _tyKiGamNew `seq` (True) -> + (case (tvGathFlowIn _tyKiGamNew _lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (gamUnions [_tyKiGamNew,_tyExprIintlTyKiGam]) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (tvGathFlowOut _lhsItyKiGam _tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Quant_6 :: T_TyExpr_6 + sem_TyExpr_Quant_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_tyExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_tyExprIpol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Quant_7 :: T_TyExpr_7 + sem_TyExpr_Quant_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Quant_8 :: T_TyExpr_8 + sem_TyExpr_Quant_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (showTyQu qu_ >#< tyVar_ >#< "." >#< _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Quant_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Quant_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Quant_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }) }))) + in sem_TyExpr_Quant_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Quant_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Quant_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Quant_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }) }))) + in sem_TyExpr_Quant_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Row :: Range -> + T_RowTyExpr -> + T_TyExpr + +sem_TyExpr_Row hsrange_ rowTyExpr_ | hsrange_ `seq` (rowTyExpr_ `seq` (True)) = + (case (rowTyExpr_) of + { ( _rowTyExprIrange,rowTyExpr_1) | True -> + (case (rangeUnions [hsrange_, _rowTyExprIrange + , _rowTyExprIrange + ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Row_1 :: T_TyExpr_1 + sem_TyExpr_Row_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _rowTyExprOgUniq | _rowTyExprOgUniq `seq` (True) -> + (case (positionalFldNames) of + { _rowTyExprOpositionalFldNmL | _rowTyExprOpositionalFldNmL `seq` (True) -> + (case (rowTyExpr_1 _rowTyExprOgUniq _rowTyExprOpositionalFldNmL) of + { ( _rowTyExprIgUniq,_rowTyExprIpositionalFldNmL,rowTyExpr_2) | True -> + (case (_rowTyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Row_2 :: T_TyExpr_2 + sem_TyExpr_Row_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _rowTyExprOtyGam | _rowTyExprOtyGam `seq` (True) -> + (case (rowTyExpr_2 _rowTyExprOtyGam) of + { ( _rowTyExprItyGam,_rowTyExprItyRow,rowTyExpr_3) | True -> + (case (_rowTyExprItyRow) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_rowTyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Row_3 :: T_TyExpr_3 + sem_TyExpr_Row_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Row_4 :: T_TyExpr_4 + sem_TyExpr_Row_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _rowTyExprOpolVarMp | _rowTyExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _rowTyExprOpolGam | _rowTyExprOpolGam `seq` (True) -> + (case (_lhsIknPolCtx) of + { _rowTyExprOknPolCtx | _rowTyExprOknPolCtx `seq` (True) -> + (case (rowTyExpr_3 _rowTyExprOknPolCtx _rowTyExprOpolGam _rowTyExprOpolVarMp) of + { ( _rowTyExprIpolVarMp,rowTyExpr_4) | True -> + (case (_rowTyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Row_5 :: T_TyExpr_5 + sem_TyExpr_Row_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _rowTyExprOtyKiGam | _rowTyExprOtyKiGam `seq` (True) -> + (case (rowTyExpr_4 _rowTyExprOtyKiGam) of + { ( _rowTyExprIintlTyKiGam,_rowTyExprItyKiGam,rowTyExpr_5) | True -> + (case (_rowTyExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_rowTyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Row_6 :: T_TyExpr_6 + sem_TyExpr_Row_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (kiRow) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _rowTyExprOkiVarMp | _rowTyExprOkiVarMp `seq` (True) -> + (case (rowTyExpr_5 _rowTyExprOkiVarMp) of + { ( _rowTyExprIkiVarMp,_rowTyExprItyVarWildMp,rowTyExpr_6) | True -> + (case (_rowTyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_rowTyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Row_7 :: T_TyExpr_7 + sem_TyExpr_Row_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Row_8 :: T_TyExpr_8 + sem_TyExpr_Row_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _rowTyExprOvalTyGlobFreeTvarS | _rowTyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _rowTyExprOtyTyTySigFreeTvarS | _rowTyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _rowTyExprOtyTyGlobFreeTvarS | _rowTyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _rowTyExprOtyKiGlobFreeTvarS | _rowTyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _rowTyExprOsysfEnv | _rowTyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _rowTyExprOopts | _rowTyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _rowTyExprOmoduleNm | _rowTyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _rowTyExprOkiGam | _rowTyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _rowTyExprOfinTyVarMp | _rowTyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _rowTyExprOfinTyKiGam | _rowTyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _rowTyExprOfinKiVarMp | _rowTyExprOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> + (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL) | True -> + (case (_rowTyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (reverse _rowTyExprIppL) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (_rowTyExprIextNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (_rowTyExprIpp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_rowTyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_rowTyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_rowTyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_rowTyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (ppAppTop (hsnRow,mkPPAppFun hsnRow _rowTyExprIpp) + (reverse _rowTyExprIppL) _rowTyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Row_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Row_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Row_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }))) + in sem_TyExpr_Row_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) })))) + in sem_TyExpr_Row_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Row_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }))) + in sem_TyExpr_Row_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }) }))) + in sem_TyExpr_Row_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Pred :: Range -> + T_PrExpr -> + T_TyExpr + +sem_TyExpr_Pred hsrange_ prExpr_ | hsrange_ `seq` (prExpr_ `seq` (True)) = + (case (prExpr_) of + { ( _prExprIrange,prExpr_1) | True -> + (case (rangeUnions [hsrange_, _prExprIrange , _prExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Pred_1 :: T_TyExpr_1 + sem_TyExpr_Pred_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _prExprOgUniq | _prExprOgUniq `seq` (True) -> + (case (prExpr_1 _prExprOgUniq) of + { ( _prExprIgUniq,prExpr_2) | True -> + (case (_prExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Pred_2 :: T_TyExpr_2 + sem_TyExpr_Pred_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _prExprOtyGam | _prExprOtyGam `seq` (True) -> + (case (prExpr_2 _prExprOtyGam) of + { ( _prExprIprTy,_prExprIty,_prExprItyGam,prExpr_3) | True -> + (case (_prExprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_prExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Pred_3 :: T_TyExpr_3 + sem_TyExpr_Pred_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case (_lhsIknPolCtx) of + { _prExprOknPolCtx | _prExprOknPolCtx `seq` (True) -> + (case (prExpr_3 _prExprOknPolCtx) of + { ( _prExprIpolVarL,prExpr_4) | True -> + (case (_prExprIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Pred_4 :: T_TyExpr_4 + sem_TyExpr_Pred_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _prExprOpolVarMp | _prExprOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _prExprOpolGam | _prExprOpolGam `seq` (True) -> + (case (prExpr_4 _prExprOpolGam _prExprOpolVarMp) of + { ( _prExprIpolVarMp,prExpr_5) | True -> + (case (_prExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Pred_5 :: T_TyExpr_5 + sem_TyExpr_Pred_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _prExprOtyKiGam | _prExprOtyKiGam `seq` (True) -> + (case (prExpr_5 _prExprOtyKiGam) of + { ( _prExprIintlTyKiGam,_prExprItyKiGam,prExpr_6) | True -> + (case (_prExprIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_prExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Pred_6 :: T_TyExpr_6 + sem_TyExpr_Pred_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _prExprOkiVarMp | _prExprOkiVarMp `seq` (True) -> + (case (prExpr_6 _prExprOkiVarMp) of + { ( _prExprIgathTyVarPolGam,_prExprIki,_prExprIkiVarMp,_prExprItyVarWildMp,prExpr_7) | True -> + (case (_prExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_prExprIki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_prExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_prExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Pred_7 :: T_TyExpr_7 + sem_TyExpr_Pred_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_lhsIclGam) of + { _prExprOclGam | _prExprOclGam `seq` (True) -> + (case (prExpr_7 _prExprOclGam) of + { ( _prExprIevTy,prExpr_8) | True -> + (case (_prExprIevTy) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Pred_8 :: T_TyExpr_8 + sem_TyExpr_Pred_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _prExprOvalTyGlobFreeTvarS | _prExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _prExprOtyTyTySigFreeTvarS | _prExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _prExprOtyTyGlobFreeTvarS | _prExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _prExprOtyKiGlobFreeTvarS | _prExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _prExprOsysfEnv | _prExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _prExprOopts | _prExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _prExprOmoduleNm | _prExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _prExprOkiGam | _prExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _prExprOfinTyVarMp | _prExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _prExprOfinTyKiGam | _prExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _prExprOfinKiVarMp | _prExprOfinKiVarMp `seq` (True) -> + (case (prExpr_8 _prExprOfinKiVarMp _prExprOfinTyKiGam _prExprOfinTyVarMp _prExprOkiGam _prExprOmoduleNm _prExprOopts _prExprOsysfEnv _prExprOtyKiGlobFreeTvarS _prExprOtyTyGlobFreeTvarS _prExprOtyTyTySigFreeTvarS _prExprOvalTyGlobFreeTvarS) of + { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIpr) | True -> + (case (_prExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (hsnOImpl >#< _prExprIpp >#< hsnCImpl) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_prExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_prExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_prExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_prExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Pred_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) + in sem_TyExpr_Pred_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Pred_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }))) + in sem_TyExpr_Pred_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) })))) + in sem_TyExpr_Pred_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }) }) }))) + in sem_TyExpr_Pred_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }))) + in sem_TyExpr_Pred_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }))) + in sem_TyExpr_Pred_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + +sem_TyExpr_Impls :: Range -> + T_TyExpr + +sem_TyExpr_Impls hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Impls_1 :: T_TyExpr_1 + sem_TyExpr_Impls_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} )) of + { __tup243 | __tup243 `seq` (True) -> + (case (__tup243) of + { (_lhsOgUniq,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Impls_2 :: T_TyExpr_2 + sem_TyExpr_Impls_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup243) of + { (_,_lUniq) | _lUniq `seq` (True) -> + (case (_lUniq) of + { _implsVarId | _implsVarId `seq` (True) -> + (case (mkTGI (Ty_Impls (Impls_Tail _implsVarId []))) of + { _tgi_ | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Impls_3 :: T_TyExpr_3 + sem_TyExpr_Impls_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Impls_4 :: T_TyExpr_4 + sem_TyExpr_Impls_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Impls_5 :: T_TyExpr_5 + sem_TyExpr_Impls_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Impls_6 :: T_TyExpr_6 + sem_TyExpr_Impls_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (TyKiGamInfo kiStar) of + { _tkgi_ | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.singleton _implsVarId TyVarWild_NoQuantTyExpr_YesQuantLetBinding) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Impls_7 :: T_TyExpr_7 + sem_TyExpr_Impls_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Impls_8 :: T_TyExpr_8 + sem_TyExpr_Impls_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (hsnOImpl >#< "..." >#< hsnCImpl) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Impls_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Impls_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Impls_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }))) + in sem_TyExpr_Impls_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) })))) + in sem_TyExpr_Impls_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Impls_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }))) + in sem_TyExpr_Impls_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }))) + in sem_TyExpr_Impls_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_NoImpls :: Range -> + T_TyExpr + +sem_TyExpr_NoImpls hsrange_ | hsrange_ `seq` (True) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_1 :: T_TyExpr_1 + sem_TyExpr_NoImpls_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_2 :: T_TyExpr_2 + sem_TyExpr_NoImpls_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (mkTGI (Ty_Impls Impls_Nil)) of + { _tgi_ | _tgi_ `seq` (True) -> + (case (tgiTy _tgi_) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_3 :: T_TyExpr_3 + sem_TyExpr_NoImpls_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_4 :: T_TyExpr_4 + sem_TyExpr_NoImpls_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_5 :: T_TyExpr_5 + sem_TyExpr_NoImpls_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_6 :: T_TyExpr_6 + sem_TyExpr_NoImpls_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (TyKiGamInfo kiStar) of + { _tkgi_ | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_lhsIknPolCtx) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_7 :: T_TyExpr_7 + sem_TyExpr_NoImpls_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_NoImpls_8 :: T_TyExpr_8 + sem_TyExpr_NoImpls_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case (hsnOImpl >#< "_" >#< hsnCImpl) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_NoImpls_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_NoImpls_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }))) + in sem_TyExpr_NoImpls_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }))) + in sem_TyExpr_NoImpls_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) })))) + in sem_TyExpr_NoImpls_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_NoImpls_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }))) + in sem_TyExpr_NoImpls_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }))) + in sem_TyExpr_NoImpls_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) + +sem_TyExpr_Lam :: Range -> + HsName -> + T_TyExpr -> + T_TyExpr + +sem_TyExpr_Lam hsrange_ tyVar_ tyExpr_ | hsrange_ `seq` (tyVar_ `seq` (tyExpr_ `seq` (True))) = + (case (tyExpr_) of + { ( _tyExprIrange,tyExpr_1) | True -> + (case (rangeUnions [hsrange_, _tyExprIrange , _tyExprIrange]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExpr_Lam_1 :: T_TyExpr_1 + sem_TyExpr_Lam_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_17_fitsIn_pol) -> case nextUnique __cont of { (__cont, lUniq_17_polArg) -> case nextUnique __cont of { (__cont, lUniq_17_polRes) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_17_fitsIn_pol,lUniq_17_polArg,lUniq_17_polRes,lUniq_ki)}}}}} )) of + { __tup245 | __tup245 `seq` (True) -> + (case (__tup245) of + { (_tyExprOgUniq,_,_,_,_,_) | _tyExprOgUniq `seq` (True) -> + (case (tyExpr_1 _tyExprOgUniq) of + { ( _tyExprIgUniq,tyExpr_2) | True -> + (case (_tyExprIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExpr_Lam_2 :: T_TyExpr_2 + sem_TyExpr_Lam_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup245) of + { (_,_,_,_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (__tup245) of + { (_,_lUniq,_,_,_,_) | _lUniq `seq` (True) -> + (case (let t = mkTyVar _lUniq + in (_lUniq,mkTGI t,TyKiGamInfo (mkNewTyVar _lUniq_ki))) of + { __tup244 | __tup244 `seq` (True) -> + (case (__tup244) of + { (_,_tgi_,_) | _tgi_ `seq` (True) -> + (case (tvGathFlowIn (tyVar_ `gamSingleton` _tgi_) _lhsItyGam) of + { _tyExprOtyGam | _tyExprOtyGam `seq` (True) -> + (case (__tup244) of + { (_tv,_,_) | _tv `seq` (True) -> + (case (tyExpr_2 _tyExprOtyGam) of + { ( _tyExprIty,_tyExprItyGam,tyExpr_3) | True -> + (case (mkTyLam [_tv] _tyExprIty) of + { _ty | _ty `seq` (True) -> + (case (_ty) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (tvGathFlowOut _lhsItyGam _tyExprItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyExpr_Lam_3 :: T_TyExpr_3 + sem_TyExpr_Lam_3 = + (\ _lhsIknPolCtx -> + _lhsIknPolCtx `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case ((let sem_TyExpr_Lam_4 :: T_TyExpr_4 + sem_TyExpr_Lam_4 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (__tup245) of + { (_,_,_,_,_lUniq_17_polRes,_) | _lUniq_17_polRes `seq` (True) -> + (case (__tup245) of + { (_,_,_,_lUniq_17_polArg,_,_) | _lUniq_17_polArg `seq` (True) -> + (case (__tup245) of + { (_,_,_lUniq_17_fitsIn_pol,_,_,_) | _lUniq_17_fitsIn_pol `seq` (True) -> + (case (mkPolVar _lUniq_17_polRes) of + { _polResVar | _polResVar `seq` (True) -> + (case (mkPolVar _lUniq_17_polArg) of + { _polArgVar | _polArgVar `seq` (True) -> + (case (fitsIn weakFIOpts defaultFIEnv _lUniq_17_fitsIn_pol _lhsIpolVarMp ([_polArgVar] `appArr` _polResVar) _lhsIknPolCtx) of + { _foPol | _foPol `seq` (True) -> + (case (foVarMp _foPol `varUpd` _lhsIpolVarMp) of + { _tyExprOpolVarMp | _tyExprOpolVarMp `seq` (True) -> + (case (gamAdd tyVar_ (mkPGI _polArgVar) _lhsIpolGam) of + { _tyExprOpolGam | _tyExprOpolGam `seq` (True) -> + (case (_polResVar) of + { _tyExprOknPolCtx | _tyExprOknPolCtx `seq` (True) -> + (case (tyExpr_3 _tyExprOknPolCtx) of + { ( _tyExprIpolVarL,tyExpr_4) | True -> + (case (tyExpr_4 _tyExprOpolGam _tyExprOpolVarMp) of + { ( _tyExprImbStrictness,_tyExprIpolVarMp,tyExpr_5) | True -> + (case (_tyExprIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExpr_Lam_5 :: T_TyExpr_5 + sem_TyExpr_Lam_5 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup244) of + { (_,_,_tkgi_) | _tkgi_ `seq` (True) -> + (case (tgiTy _tgi_ `tyKiGamSingleton` _tkgi_) of + { _tyKiGamNew | _tyKiGamNew `seq` (True) -> + (case (tvGathFlowIn _tyKiGamNew _lhsItyKiGam) of + { _tyExprOtyKiGam | _tyExprOtyKiGam `seq` (True) -> + (case (tyExpr_5 _tyExprOtyKiGam) of + { ( _tyExprIintlTyKiGam,_tyExprItyKiGam,tyExpr_6) | True -> + (case (gamUnions [_tyKiGamNew,_tyExprIintlTyKiGam]) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (tvGathFlowOut _lhsItyKiGam _tyExprItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExpr_Lam_6 :: T_TyExpr_6 + sem_TyExpr_Lam_6 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _tyExprOkiVarMp | _tyExprOkiVarMp `seq` (True) -> + (case (tyExpr_6 _tyExprOkiVarMp) of + { ( _tyExprIgathTyVarPolGam,_tyExprIki,_tyExprIkiVarMp,_tyExprIpol,_tyExprItyVarWildMp,tyExpr_7) | True -> + (case (_tyExprIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case ([tkgiKi _tkgi_] `appArr` _tyExprIki) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case (_tyExprIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case ([_polArgVar] `appArr` _tyExprIpol) of + { _lhsOpol | _lhsOpol `seq` (True) -> + (case (_tyExprItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExpr_Lam_7 :: T_TyExpr_7 + sem_TyExpr_Lam_7 = + (\ _lhsIclGam -> + _lhsIclGam `seq` + ((case (_ty) of + { _lhsOevTy | _lhsOevTy `seq` (True) -> + (case ((let sem_TyExpr_Lam_8 :: T_TyExpr_8 + sem_TyExpr_Lam_8 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIclGam) of + { _tyExprOclGam | _tyExprOclGam `seq` (True) -> + (case (tyExpr_7 _tyExprOclGam) of + { ( _tyExprIevTy,tyExpr_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _tyExprOvalTyGlobFreeTvarS | _tyExprOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tyExprOtyTyTySigFreeTvarS | _tyExprOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tyExprOtyTyGlobFreeTvarS | _tyExprOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tyExprOtyKiGlobFreeTvarS | _tyExprOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tyExprOsysfEnv | _tyExprOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tyExprOopts | _tyExprOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tyExprOmoduleNm | _tyExprOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _tyExprOkiGam | _tyExprOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tyExprOfinTyVarMp | _tyExprOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tyExprOfinTyKiGam | _tyExprOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> + (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItyWildL) | True -> + (case (_tyExprIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case ([]) of + { _lhsOappArgPPL | _lhsOappArgPPL `seq` (True) -> + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ("\\" >|< tyVar_ >#< "->" >#< _tyExprIpp) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOappFunPP | _lhsOappFunPP `seq` (True) -> + (case (_tyExprIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_tyExprIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_tyExprIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_tyExprIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + in sem_TyExpr_Lam_8)) of + { ( sem_TyExpr_8) | True -> + ( _lhsOevTy,sem_TyExpr_8) }) }))) + in sem_TyExpr_Lam_7)) of + { ( sem_TyExpr_7) | True -> + ( _lhsOgathTyVarPolGam,_lhsOki,_lhsOkiVarMp,_lhsOpol,_lhsOtyVarWildMp,sem_TyExpr_7) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Lam_6)) of + { ( sem_TyExpr_6) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExpr_6) }) }) }) }) }) }) }))) + in sem_TyExpr_Lam_5)) of + { ( sem_TyExpr_5) | True -> + ( _lhsOmbStrictness,_lhsOpolVarMp,sem_TyExpr_5) }) }) }) }) }) }) }) }) }) }) }) }) }) })))) + in sem_TyExpr_Lam_4)) of + { ( sem_TyExpr_4) | True -> + ( _lhsOpolVarL,sem_TyExpr_4) }) }))) + in sem_TyExpr_Lam_3)) of + { ( sem_TyExpr_3) | True -> + ( _lhsOty,_lhsOtyGam,sem_TyExpr_3) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyExpr_Lam_2)) of + { ( sem_TyExpr_2) | True -> + ( _lhsOgUniq,sem_TyExpr_2) }) }) }) }) }))) + in sem_TyExpr_Lam_1)) of + { ( sem_TyExpr_1) | True -> + ( _lhsOrange,sem_TyExpr_1) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs @@ -0,0 +1,130 @@ + + + +module UHC.Light.Compiler.EH.MainAG_TyExprAnn where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- TyExprAnn --------------------------------------------------- +{- + visit 0: + synthesized attributes: + ann : TyAnn + isEmpty : Bool + mbStrictness : Maybe Strictness + pp : PP_Doc + alternatives: + alternative Empty: + visit 0: + local pp : _ + alternative Strictness: + child strictness : {Strictness} + visit 0: + local pp : _ +-} +sem_TyExprAnn_Empty :: T_TyExprAnn + +sem_TyExprAnn_Empty = + (case (TyAnn_Empty) of + { _lhsOann | _lhsOann `seq` (True) -> + (case (True) of + { _lhsOisEmpty | _lhsOisEmpty `seq` (True) -> + (case (Nothing) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case (empty) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOann,_lhsOisEmpty,_lhsOmbStrictness,_lhsOpp) }) }) }) }) }) + +sem_TyExprAnn_Strictness :: Strictness -> + T_TyExprAnn + +sem_TyExprAnn_Strictness strictness_ | strictness_ `seq` (True) = + (case (TyAnn_Strictness strictness_) of + { _lhsOann | _lhsOann `seq` (True) -> + (case (False) of + { _lhsOisEmpty | _lhsOisEmpty `seq` (True) -> + (case (Just strictness_) of + { _lhsOmbStrictness | _lhsOmbStrictness `seq` (True) -> + (case ("@" >|< show strictness_) of + { _pp | _pp `seq` (True) -> + (case (_pp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOann,_lhsOisEmpty,_lhsOmbStrictness,_lhsOpp) }) }) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs @@ -0,0 +1,486 @@ + + + +module UHC.Light.Compiler.EH.MainAG_TyExprs where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- TyExprs ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + tyGam : TyGam + synthesized attributes: + polVarL : [Polarity] + tyL : TyL + visit 3: + inherited attribute: + polGam : PolGam + chained attribute: + polVarMp : VarMp + visit 4: + chained attribute: + tyKiGam : TyKiGam + synthesized attribute: + intlTyKiGam : TyKiGam + visit 5: + chained attribute: + kiVarMp : VarMp + synthesized attributes: + gathTyVarPolGam : PolGam + kiL : TyL + tyVarWildMp : TyVarWildMp + visit 6: + inherited attributes: + clGam : ClGam + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + kiGam : KiGam + knPolCtx : Polarity + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + clMissNmS : HsNameS + clNmS : HsNameS + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : TyExpr + child tl : TyExprs + visit 1: + local _tup246 : _ + visit 2: + local lUniq_17_polCtx : {UID} + local polCtxVar : {Polarity} + intra _tup246 : _ + alternative Nil: +-} +sem_TyExprs_Cons :: T_TyExpr -> + T_TyExprs -> + T_TyExprs + +sem_TyExprs_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExprs_Cons_1 :: T_TyExprs_1 + sem_TyExprs_Cons_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq_17_polCtx) -> (__cont,lUniq_17_polCtx)} )) of + { __tup246 | __tup246 `seq` (True) -> + (case (__tup246) of + { (_hdOgUniq,_) | _hdOgUniq `seq` (True) -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExprs_Cons_2 :: T_TyExprs_2 + sem_TyExprs_Cons_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (hd_2 _hdOtyGam) of + { ( _hdIty,_hdItyGam,hd_3) | True -> + (case (_hdItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (__tup246) of + { (_,_lUniq_17_polCtx) | _lUniq_17_polCtx `seq` (True) -> + (case (mkPolVar _lUniq_17_polCtx) of + { _polCtxVar | _polCtxVar `seq` (True) -> + (case (_polCtxVar) of + { _hdOknPolCtx | _hdOknPolCtx `seq` (True) -> + (case (tl_2 _tlOtyGam) of + { ( _tlIpolVarL,_tlItyGam,_tlItyL,tl_3) | True -> + (case (hd_3 _hdOknPolCtx) of + { ( _hdIpolVarL,hd_4) | True -> + (case (_hdIpolVarL ++ _tlIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case (_tlItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case (_hdIty : _tlItyL) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case ((let sem_TyExprs_Cons_3 :: T_TyExprs_3 + sem_TyExprs_Cons_3 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _hdOpolVarMp | _hdOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _hdOpolGam | _hdOpolGam `seq` (True) -> + (case (hd_4 _hdOpolGam _hdOpolVarMp) of + { ( _hdImbStrictness,_hdIpolVarMp,hd_5) | True -> + (case (_hdIpolVarMp) of + { _tlOpolVarMp | _tlOpolVarMp `seq` (True) -> + (case (_lhsIpolGam) of + { _tlOpolGam | _tlOpolGam `seq` (True) -> + (case (tl_3 _tlOpolGam _tlOpolVarMp) of + { ( _tlIpolVarMp,tl_4) | True -> + (case (_tlIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExprs_Cons_4 :: T_TyExprs_4 + sem_TyExprs_Cons_4 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (hd_5 _hdOtyKiGam) of + { ( _hdIintlTyKiGam,_hdItyKiGam,hd_6) | True -> + (case (_hdItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (tl_4 _tlOtyKiGam) of + { ( _tlIintlTyKiGam,_tlItyKiGam,tl_5) | True -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_tlItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExprs_Cons_5 :: T_TyExprs_5 + sem_TyExprs_Cons_5 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (_lhsIkiVarMp) of + { _hdOkiVarMp | _hdOkiVarMp `seq` (True) -> + (case (hd_6 _hdOkiVarMp) of + { ( _hdIgathTyVarPolGam,_hdIki,_hdIkiVarMp,_hdIpol,_hdItyVarWildMp,hd_7) | True -> + (case (_hdIkiVarMp) of + { _tlOkiVarMp | _tlOkiVarMp `seq` (True) -> + (case (tl_5 _tlOkiVarMp) of + { ( _tlIgathTyVarPolGam,_tlIkiL,_tlIkiVarMp,_tlItyVarWildMp,tl_6) | True -> + (case (_hdIgathTyVarPolGam `gamUnion` _tlIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_hdIki : _tlIkiL) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_tlIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (_hdItyVarWildMp `Map.union` _tlItyVarWildMp) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExprs_Cons_6 :: T_TyExprs_6 + sem_TyExprs_Cons_6 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsIknPolCtx + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsIknPolCtx `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIknPolCtx) of + { _tlOknPolCtx | _tlOknPolCtx `seq` (True) -> + (case (_lhsIkiGam) of + { _tlOkiGam | _tlOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (_lhsIclGam) of + { _tlOclGam | _tlOclGam `seq` (True) -> + (case (tl_6 _tlOclGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOkiGam _tlOknPolCtx _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIpp,_tlIppL) | True -> + (case (_lhsIclGam) of + { _hdOclGam | _hdOclGam `seq` (True) -> + (case (hd_7 _hdOclGam) of + { ( _hdIevTy,hd_8) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIkiGam) of + { _hdOkiGam | _hdOkiGam `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (hd_8 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOkiGam _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIappArgPPL,_hdIappFunNm,_hdIappFunPP,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdItyWildL) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIclMissNmS `Set.union` _tlIclMissNmS) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (_hdIclNmS `Set.union` _tlIclNmS) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) + in sem_TyExprs_Cons_6)) of + { ( sem_TyExprs_6) | True -> + ( _lhsOgathTyVarPolGam,_lhsOkiL,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_TyExprs_6) }) }) }) }) }) }) }) }) }))) + in sem_TyExprs_Cons_5)) of + { ( sem_TyExprs_5) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExprs_5) }) }) }) }) }) }) }))) + in sem_TyExprs_Cons_4)) of + { ( sem_TyExprs_4) | True -> + ( _lhsOpolVarMp,sem_TyExprs_4) }) }) }) }) }) }) }) })))) + in sem_TyExprs_Cons_3)) of + { ( sem_TyExprs_3) | True -> + ( _lhsOpolVarL,_lhsOtyGam,_lhsOtyL,sem_TyExprs_3) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyExprs_Cons_2)) of + { ( sem_TyExprs_2) | True -> + ( _lhsOgUniq,sem_TyExprs_2) }) }) }) }) }) }) }))) + in sem_TyExprs_Cons_1)) of + { ( sem_TyExprs_1) | True -> + ( _lhsOrange,sem_TyExprs_1) }) }) }) }) + +sem_TyExprs_Nil :: T_TyExprs + +sem_TyExprs_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyExprs_Nil_1 :: T_TyExprs_1 + sem_TyExprs_Nil_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyExprs_Nil_2 :: T_TyExprs_2 + sem_TyExprs_Nil_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ([]) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case ((let sem_TyExprs_Nil_3 :: T_TyExprs_3 + sem_TyExprs_Nil_3 = + (\ _lhsIpolGam + _lhsIpolVarMp -> + _lhsIpolGam `seq` + (_lhsIpolVarMp `seq` + ((case (_lhsIpolVarMp) of + { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> + (case ((let sem_TyExprs_Nil_4 :: T_TyExprs_4 + sem_TyExprs_Nil_4 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyExprs_Nil_5 :: T_TyExprs_5 + sem_TyExprs_Nil_5 = + (\ _lhsIkiVarMp -> + _lhsIkiVarMp `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case ([]) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_lhsIkiVarMp) of + { _lhsOkiVarMp | _lhsOkiVarMp `seq` (True) -> + (case (Map.empty) of + { _lhsOtyVarWildMp | _lhsOtyVarWildMp `seq` (True) -> + (case ((let sem_TyExprs_Nil_6 :: T_TyExprs_6 + sem_TyExprs_Nil_6 = + (\ _lhsIclGam + _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsIkiGam + _lhsIknPolCtx + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIclGam `seq` + (_lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsIkiGam `seq` + (_lhsIknPolCtx `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Set.empty) of + { _lhsOclMissNmS | _lhsOclMissNmS `seq` (True) -> + (case (Set.empty) of + { _lhsOclNmS | _lhsOclNmS `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }))))))))))))))) + in sem_TyExprs_Nil_6)) of + { ( sem_TyExprs_6) | True -> + ( _lhsOgathTyVarPolGam,_lhsOkiL,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_TyExprs_6) }) }) }) }) }))) + in sem_TyExprs_Nil_5)) of + { ( sem_TyExprs_5) | True -> + ( _lhsOintlTyKiGam,_lhsOtyKiGam,sem_TyExprs_5) }) }) }))) + in sem_TyExprs_Nil_4)) of + { ( sem_TyExprs_4) | True -> + ( _lhsOpolVarMp,sem_TyExprs_4) }) })))) + in sem_TyExprs_Nil_3)) of + { ( sem_TyExprs_3) | True -> + ( _lhsOpolVarL,_lhsOtyGam,_lhsOtyL,sem_TyExprs_3) }) }) }) }))) + in sem_TyExprs_Nil_2)) of + { ( sem_TyExprs_2) | True -> + ( _lhsOgUniq,sem_TyExprs_2) }) }))) + in sem_TyExprs_Nil_1)) of + { ( sem_TyExprs_1) | True -> + ( _lhsOrange,sem_TyExprs_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs b/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs @@ -0,0 +1,249 @@ + + + +module UHC.Light.Compiler.EH.MainAG_TyVar where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- TyVar ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + tyGam : TyGam + visit 3: + chained attribute: + tyKiGam : TyKiGam + synthesized attributes: + gathTyVarPolGam : PolGam + intlTyKiGam : TyKiGam + ki : Ty + polVarL : [Polarity] + ty : Ty + visit 4: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + nm : HsName + pp : PP_Doc + alternatives: + alternative Var: + child hsrange : {Range} + child nm : {HsName} + visit 0: + local range : {Range} + visit 1: + local _tup250 : _ + visit 2: + local lUniq : {UID} + local _tup248 : _ + intra _tup250 : _ + visit 3: + local lUniq_17_pol : {UID} + local polVar : _ + local lUniq_ki : {UID} + local tgi_ : {TyGamInfo} + local _tup249 : _ + local tyKiGamNew : _ + local tkgi_ : {TyKiGamInfo} + local ki : {Ty} + intra _tup250 : _ + intra _tup248 : _ +-} +sem_TyVar_Var :: Range -> + HsName -> + T_TyVar + +sem_TyVar_Var hsrange_ nm_ | hsrange_ `seq` (nm_ `seq` (True)) = + (case (hsrange_) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyVar_Var_1 :: T_TyVar_1 + sem_TyVar_Var_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> case nextUnique __cont of { (__cont, lUniq_17_pol) -> case nextUnique __cont of { (__cont, lUniq_ki) -> (__cont,lUniq,lUniq_17_pol,lUniq_ki)}}} )) of + { __tup250 | __tup250 `seq` (True) -> + (case (__tup250) of + { (_lhsOgUniq,_,_,_) | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyVar_Var_2 :: T_TyVar_2 + sem_TyVar_Var_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (__tup250) of + { (_,_lUniq,_,_) | _lUniq `seq` (True) -> + (case (tyGamLookupOrAdd _lUniq nm_ (gamTop _lhsItyGam) _lhsItyGam) of + { __tup248 | __tup248 `seq` (True) -> + (case (__tup248) of + { (_,_lhsOtyGam) | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyVar_Var_3 :: T_TyVar_3 + sem_TyVar_Var_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (__tup250) of + { (_,_,_lUniq_17_pol,_) | _lUniq_17_pol `seq` (True) -> + (case (mkPolVar _lUniq_17_pol) of + { _polVar | _polVar `seq` (True) -> + (case (gamSingleton nm_ (mkPGI _polVar)) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (__tup250) of + { (_,_,_,_lUniq_ki) | _lUniq_ki `seq` (True) -> + (case (__tup248) of + { (_tgi_,_) | _tgi_ `seq` (True) -> + (case (tyKiGamLookupOrAdd _lUniq_ki (tgiTy _tgi_) _lhsItyKiGam) of + { __tup249 | __tup249 `seq` (True) -> + (case (__tup249) of + { (_,_,_tyKiGamNew) | _tyKiGamNew `seq` (True) -> + (case (_tyKiGamNew) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (__tup249) of + { (_tkgi_,_,_) | _tkgi_ `seq` (True) -> + (case (tkgiKi _tkgi_) of + { _ki | _ki `seq` (True) -> + (case (_ki) of + { _lhsOki | _lhsOki `seq` (True) -> + (case ([_polVar]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case (tgiTy _tgi_) of + { _lhsOty | _lhsOty `seq` (True) -> + (case (__tup249) of + { (_,_lhsOtyKiGam,_) | _lhsOtyKiGam `seq` (True) -> + (case ((let sem_TyVar_Var_4 :: T_TyVar_4 + sem_TyVar_Var_4 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (nm_) of + { _lhsOnm | _lhsOnm `seq` (True) -> + (case (pp nm_) of + { _lhsOpp | _lhsOpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnm,_lhsOpp) }) }) }) }) })))))))))))) + in sem_TyVar_Var_4)) of + { ( sem_TyVar_4) | True -> + ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOki,_lhsOpolVarL,_lhsOty,_lhsOtyKiGam,sem_TyVar_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyVar_Var_3)) of + { ( sem_TyVar_3) | True -> + ( _lhsOtyGam,sem_TyVar_3) }) }) }) }))) + in sem_TyVar_Var_2)) of + { ( sem_TyVar_2) | True -> + ( _lhsOgUniq,sem_TyVar_2) }) }) }))) + in sem_TyVar_Var_1)) of + { ( sem_TyVar_1) | True -> + ( _lhsOrange,sem_TyVar_1) }) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs b/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs @@ -0,0 +1,363 @@ + + + +module UHC.Light.Compiler.EH.MainAG_TyVars where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + +import UHC.Light.Compiler.EH.MainAG_common + +-- TyVars ------------------------------------------------------ +{- + visit 0: + synthesized attribute: + range : Range + visit 1: + chained attribute: + gUniq : UID + visit 2: + chained attribute: + tyGam : TyGam + visit 3: + chained attribute: + tyKiGam : TyKiGam + synthesized attributes: + gathTyVarPolGam : PolGam + intlTyKiGam : TyKiGam + kiL : TyL + polVarL : [Polarity] + tyL : TyL + visit 4: + inherited attributes: + finKiVarMp : VarMp + finTyKiGam : TyKiGam + finTyVarMp : VarMp + moduleNm : HsName + opts : EHCOpts + sysfEnv : ToSysfEnv + tyKiGlobFreeTvarS : TyVarIdS + tyTyGlobFreeTvarS : TyVarIdS + tyTyTySigFreeTvarS : TyVarIdS + valTyGlobFreeTvarS : TyVarIdS + synthesized attributes: + allErrSq : ErrSq + errSq : ErrSq + gathMentrelFilterMp : ModEntRelFilterMp + nmL : [HsName] + pp : PP_Doc + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : TyVar + child tl : TyVars + alternative Nil: +-} +sem_TyVars_Cons :: T_TyVar -> + T_TyVars -> + T_TyVars + +sem_TyVars_Cons hd_ tl_ | hd_ `seq` (tl_ `seq` (True)) = + (case (tl_) of + { ( _tlIrange,tl_1) | True -> + (case (hd_) of + { ( _hdIrange,hd_1) | True -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyVars_Cons_1 :: T_TyVars_1 + sem_TyVars_Cons_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _hdOgUniq | _hdOgUniq `seq` (True) -> + (case (hd_1 _hdOgUniq) of + { ( _hdIgUniq,hd_2) | True -> + (case (_hdIgUniq) of + { _tlOgUniq | _tlOgUniq `seq` (True) -> + (case (tl_1 _tlOgUniq) of + { ( _tlIgUniq,tl_2) | True -> + (case (_tlIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyVars_Cons_2 :: T_TyVars_2 + sem_TyVars_Cons_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _hdOtyGam | _hdOtyGam `seq` (True) -> + (case (hd_2 _hdOtyGam) of + { ( _hdItyGam,hd_3) | True -> + (case (_hdItyGam) of + { _tlOtyGam | _tlOtyGam `seq` (True) -> + (case (tl_2 _tlOtyGam) of + { ( _tlItyGam,tl_3) | True -> + (case (_tlItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyVars_Cons_3 :: T_TyVars_3 + sem_TyVars_Cons_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (_lhsItyKiGam) of + { _hdOtyKiGam | _hdOtyKiGam `seq` (True) -> + (case (hd_3 _hdOtyKiGam) of + { ( _hdIgathTyVarPolGam,_hdIintlTyKiGam,_hdIki,_hdIpolVarL,_hdIty,_hdItyKiGam,hd_4) | True -> + (case (_hdItyKiGam) of + { _tlOtyKiGam | _tlOtyKiGam `seq` (True) -> + (case (tl_3 _tlOtyKiGam) of + { ( _tlIgathTyVarPolGam,_tlIintlTyKiGam,_tlIkiL,_tlIpolVarL,_tlItyKiGam,_tlItyL,tl_4) | True -> + (case (_hdIgathTyVarPolGam `gamUnion` _tlIgathTyVarPolGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (_hdIintlTyKiGam `gamUnion` _tlIintlTyKiGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case (_hdIki : _tlIkiL) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case (_hdIpolVarL ++ _tlIpolVarL) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case (_tlItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case (_hdIty : _tlItyL) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case ((let sem_TyVars_Cons_4 :: T_TyVars_4 + sem_TyVars_Cons_4 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (_lhsIvalTyGlobFreeTvarS) of + { _tlOvalTyGlobFreeTvarS | _tlOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _tlOtyTyTySigFreeTvarS | _tlOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _tlOtyTyGlobFreeTvarS | _tlOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _tlOtyKiGlobFreeTvarS | _tlOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _tlOsysfEnv | _tlOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm | _tlOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _tlOfinTyVarMp | _tlOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _tlOfinTyKiGam | _tlOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> + (case (tl_4 _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of + { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlInmL,_tlIpp,_tlIppL) | True -> + (case (_lhsIvalTyGlobFreeTvarS) of + { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyTyTySigFreeTvarS) of + { _hdOtyTyTySigFreeTvarS | _hdOtyTyTySigFreeTvarS `seq` (True) -> + (case (_lhsItyTyGlobFreeTvarS) of + { _hdOtyTyGlobFreeTvarS | _hdOtyTyGlobFreeTvarS `seq` (True) -> + (case (_lhsItyKiGlobFreeTvarS) of + { _hdOtyKiGlobFreeTvarS | _hdOtyKiGlobFreeTvarS `seq` (True) -> + (case (_lhsIsysfEnv) of + { _hdOsysfEnv | _hdOsysfEnv `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> + (case (_lhsIfinTyVarMp) of + { _hdOfinTyVarMp | _hdOfinTyVarMp `seq` (True) -> + (case (_lhsIfinTyKiGam) of + { _hdOfinTyKiGam | _hdOfinTyKiGam `seq` (True) -> + (case (_lhsIfinKiVarMp) of + { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> + (case (hd_4 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of + { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdInm,_hdIpp) | True -> + (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (_hdIerrSq `Seq.union` _tlIerrSq) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (_hdIgathMentrelFilterMp `mentrelFilterMpUnion` _tlIgathMentrelFilterMp) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case (_hdInm : _tlInmL) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + in sem_TyVars_Cons_4)) of + { ( sem_TyVars_4) | True -> + ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOkiL,_lhsOpolVarL,_lhsOtyKiGam,_lhsOtyL,sem_TyVars_4) }) }) }) }) }) }) }) }) }) }) }))) + in sem_TyVars_Cons_3)) of + { ( sem_TyVars_3) | True -> + ( _lhsOtyGam,sem_TyVars_3) }) }) }) }) }) }))) + in sem_TyVars_Cons_2)) of + { ( sem_TyVars_2) | True -> + ( _lhsOgUniq,sem_TyVars_2) }) }) }) }) }) }))) + in sem_TyVars_Cons_1)) of + { ( sem_TyVars_1) | True -> + ( _lhsOrange,sem_TyVars_1) }) }) }) }) + +sem_TyVars_Nil :: T_TyVars + +sem_TyVars_Nil = + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case ((let sem_TyVars_Nil_1 :: T_TyVars_1 + sem_TyVars_Nil_1 = + (\ _lhsIgUniq -> + _lhsIgUniq `seq` + ((case (_lhsIgUniq) of + { _lhsOgUniq | _lhsOgUniq `seq` (True) -> + (case ((let sem_TyVars_Nil_2 :: T_TyVars_2 + sem_TyVars_Nil_2 = + (\ _lhsItyGam -> + _lhsItyGam `seq` + ((case (_lhsItyGam) of + { _lhsOtyGam | _lhsOtyGam `seq` (True) -> + (case ((let sem_TyVars_Nil_3 :: T_TyVars_3 + sem_TyVars_Nil_3 = + (\ _lhsItyKiGam -> + _lhsItyKiGam `seq` + ((case (emptyGam) of + { _lhsOgathTyVarPolGam | _lhsOgathTyVarPolGam `seq` (True) -> + (case (emptyGam) of + { _lhsOintlTyKiGam | _lhsOintlTyKiGam `seq` (True) -> + (case ([]) of + { _lhsOkiL | _lhsOkiL `seq` (True) -> + (case ([]) of + { _lhsOpolVarL | _lhsOpolVarL `seq` (True) -> + (case (_lhsItyKiGam) of + { _lhsOtyKiGam | _lhsOtyKiGam `seq` (True) -> + (case ([]) of + { _lhsOtyL | _lhsOtyL `seq` (True) -> + (case ((let sem_TyVars_Nil_4 :: T_TyVars_4 + sem_TyVars_Nil_4 = + (\ _lhsIfinKiVarMp + _lhsIfinTyKiGam + _lhsIfinTyVarMp + _lhsImoduleNm + _lhsIopts + _lhsIsysfEnv + _lhsItyKiGlobFreeTvarS + _lhsItyTyGlobFreeTvarS + _lhsItyTyTySigFreeTvarS + _lhsIvalTyGlobFreeTvarS -> + _lhsIfinKiVarMp `seq` + (_lhsIfinTyKiGam `seq` + (_lhsIfinTyVarMp `seq` + (_lhsImoduleNm `seq` + (_lhsIopts `seq` + (_lhsIsysfEnv `seq` + (_lhsItyKiGlobFreeTvarS `seq` + (_lhsItyTyGlobFreeTvarS `seq` + (_lhsItyTyTySigFreeTvarS `seq` + (_lhsIvalTyGlobFreeTvarS `seq` + ((case (Seq.empty) of + { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> + (case (Seq.empty) of + { _lhsOerrSq | _lhsOerrSq `seq` (True) -> + (case (Map.empty) of + { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> + (case ([]) of + { _lhsOnmL | _lhsOnmL `seq` (True) -> + (case (empty) of + { _lhsOpp | _lhsOpp `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppL) }) }) }) }) }) })))))))))))) + in sem_TyVars_Nil_4)) of + { ( sem_TyVars_4) | True -> + ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOkiL,_lhsOpolVarL,_lhsOtyKiGam,_lhsOtyL,sem_TyVars_4) }) }) }) }) }) }) }))) + in sem_TyVars_Nil_3)) of + { ( sem_TyVars_3) | True -> + ( _lhsOtyGam,sem_TyVars_3) }) }))) + in sem_TyVars_Nil_2)) of + { ( sem_TyVars_2) | True -> + ( _lhsOgUniq,sem_TyVars_2) }) }))) + in sem_TyVars_Nil_1)) of + { ( sem_TyVars_1) | True -> + ( _lhsOrange,sem_TyVars_1) }) }) + diff --git a/src/UHC/Light/Compiler/EH/MainAG_common.hs b/src/UHC/Light/Compiler/EH/MainAG_common.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/MainAG_common.hs @@ -0,0 +1,2314 @@ + + +module UHC.Light.Compiler.EH.MainAG_common where + +import Data.Char +import Data.List as List +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FIEnv2 +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Set (Set) +import Data.Map (Map) +import UHC.Light.Compiler.Ty.Trf.FreshVar +import UHC.Light.Compiler.Ty.Ftv +import UHC.Util.Utils (groupSortOn) +import Control.Applicative ((<|>)) +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.FFI +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Foreign.Extract +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.CodeGen.RefGenerator +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Light.Compiler.FinalEnv +import UHC.Light.Compiler.Core.Subst +import Control.Monad.State +import UHC.Light.Compiler.Ty.Utils2 +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Pred.RedGraph (redPruneReductionsUntil) +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.EvidenceToCore +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty.Trf.BetaReduce (tyBetaRedFull) +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.CodeGen.BuiltinPrims +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Pretty +import UHC.Light.Compiler.Deriving +import UHC.Light.Compiler.Generics +import UHC.Light.Compiler.VarMp.Utils + + + +-- | The info for generics about datatypes, required higher in the syntax tree +type GenerDataInfo + = ( ( HsName -- orig type name + , [TyVarId] -- data type args + , Ty -- kind of type, without kiVarMap yet applied + ) + , [( CTag -- orig con tag + , FldTyL -- field types, with possible label + )] + , PredScope + , Int -- max kind arity over which genericity abstracts, currently \in {0,1} + ) + +-- | what kind of instance should be generated +data GenerInstKind + = GenerInstKind_Datatype + | GenerInstKind_Selector + | GenerInstKind_Constructor HsName -- for a type + | GenerInstKind_Representable Int -- remaining arity + Proj -- projection info + deriving (Show) + +-- | Info for generics, for generating data instances +type GenerDataInstInfo + = ( HsName -- original name of type, data + , HsName -- instance name + , HsName -- class name + , GenerInstKind -- what kind of instance + , Pred -- the predicate + ) + +-- | Info for generics, for generating repr instances, in particular projection descriptors +type GenerTySynProjInfo + = ( HsName -- original name of datatype + , [TyVarId] -- data type args + , PredScope -- predicate scope + , [( HsName -- representation type name + , Ty -- type synonym itself, i.e. the type lambda + , Proj -- projection descriptor + , Int -- the arity of remaining type args + )] + ) + + + +mkGenerThing + :: thing + -> (thing -> thing) + -> (thing -> thing -> thing) + -> [thing] + -> thing +mkGenerThing zero one two things + = mkSub things + where mkSub [ ] = zero + mkSub [s] = one s + mkSub ss = two (mkSub ss1) (mkSub ss2) + where (ss1,ss2) = splitAt (length ss `div` 2) ss + + + +mkGenerRepresentableTypeSynTyProj + :: EHCOpts + -> Int -- the arity of to be supplied type paramaters + -> [HsName] -- all type names defined in this binding group (i.e. let) + -> (HsName -> Int-> Bool) -- name of type has Representable? + -> HsName -- type name + -> [TyVarId] -- type args + -- -> ([Ty],Ty) -- kind, already split up in args + res + -> [(CTag,HsName,FldTyL)] -- tags, constructor type names, with type args + -> ( Ty -- type + , Proj -- intermediate description of projection + ) +mkGenerRepresentableTypeSynTyProj + opts remArity allTyNmL isRepresentable + tyNm tvarArgL + -- (kiArgL,kiRes) + conNmArgsL + = mkTop $ mkSm [ mkAlt tg c (mkPr [ mkLblArg p | p <- ps ]) | (tg,c,ps) <- conNmArgsL ] + where lamArity = length tvarArgL - remArity + (lamTvarArgL,remTvarArgL) + = splitAt lamArity tvarArgL + mkC f = appCon $ ehcOptBuiltin opts f + mkC2 f i = appCon $ ehcOptBuiltin2 opts f i + mkSub (u,pu) (f,pf) + = mkGenerThing (mkC u,pu) id (\(x,px) (y,py) -> (appTopApp [mkC f, x, y], pf px py)) + mkPr = mkSub (ehbnGenerDataUnit1, Proj_U1 ) (ehbnGenerDataProd, Proj_Prod ) + mkSm = mkSub (ehbnGenerDataVoid1, Proj_Void ) (ehbnGenerDataSum , \x y -> Proj_L1 x `Proj_Sum` Proj_R1 y) + mkLblArg (mbLbl,t) + = ( appTopApp [ mkC ehbnGenerDataMetaS1, sel, t' ], Proj_M1_S1 p ) + where (t',p) = mkArg t + sel = maybe (mkC ehbnGenerDataNoSelector) (appCon) mbLbl + mkArg t = (appTopApp funarg, proj) + where (funarg,proj) + | isJust mbVar = case elemIndex tvar remTvarArgL of -- TBD: check for kind *, check for one of tvarArgL + Just i -> ([ mkC ehbnGenerDataPar1 ], Proj_Par1 [t] (i+1)) + _ -> ([ mkC ehbnGenerDataPar0, t ], Proj_K1 [t] ) + | remArity > 0 && {- isJust mbCon && -} length args > 0 && isRepr + = case (initlast remTvarArgL, initlast args) of + (Just (_,tv), Just (firstargs,lastarg)) | maybe False (tv==) $ tyMbVar lastarg + -> ([ mkC ehbnGenerDataRec1, appTopApp (fun : firstargs) ], Proj_Rec1 [t] remArity) + (_, Just (firstargs,lastarg)) | not $ Set.null $ varFreeSet lastarg + -> ( [ mkC ehbnGenerDataComp1, fmapTy, lastarg' ] + , Proj_Comp1 [t] fmapTy lastproj + ) + where (lastarg',lastproj) = mkArg lastarg + fmapTy = appTopApp (fun : firstargs) + _ -> dflt + | otherwise = dflt + where mbVar @(~(Just tvar )) = tyMbVar t + funArgs @( (fun,args) ) = appUnApp t + isRepr = maybe (isJust $ tyMbVar fun) (\con -> isRepresentable con remArity) $ tyMbCon fun + dflt = ([ mkC ehbnGenerDataRec0, t ], Proj_K1 [t]) + mkAlt tg c (t,p) = (appTopApp [mkC2 ehbnGenerDataMetaCN 1, appCon c, t], Proj_M1 $ Proj_Con tg p) + mkTop (t,p) = ( mkTyLam lamTvarArgL (appTopApp [ mkC2 ehbnGenerDataMetaDN 1, appCon tyNm, t ]) + , Proj $ Proj_M1 p + ) + -- eqLastTvar = maybe (const False) (\(_,v) -> maybe False (v==) . tyMbVar) $ initlast tvarArgL + -- isRec t = not (null as) || tyConNm f `elem` allTyNmL + -- where (f,as) = appUnApp t + +mkGenerRepresentableTypeSynonymKi :: TyKiGam -> HsName -> Ty +mkGenerRepresentableTypeSynonymKi tyKiGam tyNm + = maybe (appDbg $ "Generics.mkGenerRepresentableTypeSynonymKi: " ++ show tyNm) (addStar . tkgiKi) $ tyKiGamLookupByName tyNm tyKiGam + where addStar ki = appArr (as ++ [kiStar]) r + where (as,r) = appUnArr ki + +-- TBD: sort out additional pol param at end, just like for kinds +mkGenerRepresentableTypeSynonymPol :: PolGam -> HsName -> Ty +mkGenerRepresentableTypeSynonymPol polGam tyNm = maybe (appDbg $ "Generics.mkGenerRepresentableTypeSynonymPol: " ++ show tyNm) pgiPol $ polGamLookup tyNm polGam + + + +type GenerForFitsIn + = ( HsName -- field name + , HsName -- default value name + , Ty -- field type + , Ty -- default value type + ) + + + +-- | determine the orphans given a modulenm, of a nm +orphanNmS :: HsName -> HsName -> Set.Set HsName +orphanNmS moduleNm nm + = case hsnQualifier nm of + Just m | m /= moduleNm -> Set.singleton m + _ -> Set.empty + + + +gathMentrelFilterMpFromSimplifyResult :: HsName -> SimplifyResult p RedHowAnnotation g m -> ModEntRelFilterMp +gathMentrelFilterMpFromSimplifyResult moduleNm simpRes + = mentrelFilterMpUnions + [ mentrelFilterMpSingleton [moduleNm] IdOcc_Val nm + | (Reduction {cnstrInfo=RedHow_ByInstance nm _ _}) <- chrSolveStateDoneConstraints $ simpresSolveState simpRes + ] + + + +polGamLookupOrAdd :: UID -> HsName -> PolGam -> PolGam -> (PolGamInfo,PolGam) +polGamLookupOrAdd uniq nm polGamLkup polGam + = case polGamLookup nm polGamLkup of + Nothing -> let t = mkPolVar uniq + pgi = mkPGI t + in (pgi,gamAdd nm pgi polGam) + Just pgi -> (pgi,polGam) + + + +-- | behavior configuration of simplify +data SimplifyHow + = SimplifyHow_Canonicalize -- canonicalize predicates + deriving Eq + + + +data SimplifyState + = SimplifyState + { simpToProveHereCnstrMp :: !CHRPredOccCnstrMp -- new constraints to prove + , simpAllCnstrMp :: !CHRPredOccCnstrMp -- all constraints to prove, including previous + , simpRemCnstrTraceMp :: !CHRPredOccCnstrTraceMp -- remaining to be proven, as Assume's + , simpRemOccL :: ![CHRIntermediateUntilAssume] -- same, but only occurrences (as list), with original trace mp split up per pred + , simpCannotCnstrTraceMp :: !CHRPredOccCnstrTraceMp -- cannot be proven + , simpVarMp :: !VarMp -- additional substitution + , simpEvidMp :: !CHRPredOccEvidMp -- map from constraint/pred occurrence to evidence + , simpEnv :: !FIIn + , simpRes :: !(SimplifyResult CHRPredOcc RedHowAnnotation Guard VarMp) -- simplification work done at a previous call + , simpErrs :: ![Err] -- errors + } + +emptySimplifyState :: SimplifyState +emptySimplifyState = SimplifyState Map.empty Map.empty Map.empty [] Map.empty emptyVarMp Map.empty (emptyFI :: FIIn) emptySimplifyResult [] + +simplify' + :: [SimplifyHow] + -> ScopedPredStore -- available CHR rules + -> ClassDefaultGam -- environment/gam for defaulting + -> Heuristic CHRPredOcc RedHowAnnotation -- graph reduction heuristic + -> ([CHRIntermediateUntilAssume] -> ([CHRIntermediateUntilAssume],[CHRIntermediateUntilAssume])) -- partition into ambiguous predicates (and others), for defaulting + -> CHRPredOccCnstrMp -- constraints already proven a previous call + -> State SimplifyState () +simplify' simplifyHow chrStore clDfGam heur partitionUnresolved2AmbigAndOthers toProveHereCnstrMpPrev + = do { s <- get + + ; let -- unique seeds + (_,u1,u2,u3) = mkNewLevUID3 $ fiUniq origEnv + + -- remember for later + origEnv = simpEnv s + + -- canonicalize predicate occurrences (expand type signatures, record fields in same order) + ; when (SimplifyHow_Canonicalize `elem` simplifyHow) + (do { s <- get + ; let (pr,mp) + = Map.foldrWithKey (\p c (cm,m) + -> let (p',m') = canon s p + in (Map.insertWith (++) p' c cm, m' `varUpd` m) + ) + (Map.empty,emptyVarMp :: VarMp) (simpToProveHereCnstrMp s) + ; put (s {simpToProveHereCnstrMp = pr, simpVarMp = mp `varUpd` simpVarMp s}) + }) + + -- adapt env to inhibit bindings for variables freely occurring in predicates, these are fixed (apart from improving substitutions, when resolving defaulting) + ; modify (\s -> let e = simpEnv s + o = fiFIOpts e + in s {simpEnv = e {fiFIOpts = o {fioDontBind = fixedFtv (simpToProveHereCnstrMp s), fioBindCategs = TyVarCateg_Meta : fioBindCategs o}}} + ) + + -- get base result, for backtracking to when restarting for defaulting + ; s <- get + ; let prevSimplifyRes = simpRes s + + -- 1st simplification run + ; (cannotResCnstrTraceMp,chrSolveAssumablePrOccL) <- fullSimp u1 toProveHereCnstrMpPrev prevSimplifyRes + ; modify (\s -> s {simpCannotCnstrTraceMp = cannotResCnstrTraceMp, simpRemOccL = chrSolveAssumablePrOccL}) + + -- defaulting is done here very crudely, find defaulting candidates, apply the improving substitution, and restart. TBD: this is a hack, do this better, probably when improving subst are done right. + ; s <- get + ; let (chrSolveAmbigPrOccL,chrSolveAssumablePrOccL) + = partitionUnresolved2AmbigAndOthers (simpRemOccL s) + ; when ( -- Debug.tr "chrSolveAmbigPrOccL" (ppCommas (simpRemOccL s) >-< ppCommas chrSolveAmbigPrOccL >-< ppCommas chrSolveAssumablePrOccL) $ + not (null chrSolveAmbigPrOccL)) + (do { let (dfltPrOccL,dfltTyVarMp) = foldr cmb ([],emptyVarMp) chrSolveAmbigPrOccL + where cmb :: (CHRPredOcc,x) -> ([CHRPredOcc],VarMp) -> ([CHRPredOcc],VarMp) + cmb (o,_) r@(os,m) = maybe r (\m' -> (o:os,m' `varUpd` m)) $ clDfGamLookupDefault (origEnv {fiVarMp = m `varUpd` fiVarMp (simpEnv s)}) (cpoPr o) clDfGam + ; when ( -- Debug.tr "dfltPrOccL" (ppCommas (simpRemOccL s) >-< ppCommas dfltPrOccL >-< dfltTyVarMp) $ + not (null dfltPrOccL)) + -- when a match is found, apply the substitution and kick off proving again + (do { modify (\s -> s {simpToProveHereCnstrMp = dfltTyVarMp `varUpd` simpToProveHereCnstrMp s, simpVarMp = dfltTyVarMp `varUpd` simpVarMp s}) + ; (cannotResCnstrTraceMp,chrSolveAssumablePrOccL) <- fullSimp u1 toProveHereCnstrMpPrev prevSimplifyRes + ; modify (\s -> s {simpCannotCnstrTraceMp = cannotResCnstrTraceMp, simpRemOccL = chrSolveAssumablePrOccL}) + }) + }) + + -- (possibly) 2nd simplification run, to deal with unproven constraints which can be assumed or defaulted + ; s <- get + ; if not (null (simpRemOccL s)) + then -- if not all could be proven, assumptions have to be made: clean up, prove again with additional assumptions + do { s <- get + ; let -- remember for later use + chrSimplifyResult = simpRes s + + -- prune the redgraph, remove that which depends on unresolved predicates + redGraphPruned + = redPruneReductionsUntil (map fst (simpRemOccL s)) + (let m = Set.map cnstrPred $ Map.keysSet (simpToProveHereCnstrMp s) in \p -> Set.member p m) + (simpresRedGraph chrSimplifyResult) + + ; modify (\s -> s {simpRes = chrSimplifyResult {simpresRedGraph = redGraphPruned, simpresRedGraphs = ("simplify pruned",redGraphPruned) : simpresRedGraphs chrSimplifyResult}}) + + -- (2nd time) RedGraph to Evidence etc + ; (_,chrSolveAssumablePrOccL) <- basicSimpRedGraph (simpAllCnstrMp s) + ; modify (\s -> s {simpRemOccL = chrSolveAssumablePrOccL}) + + -- convert to Assume constraints + ; s <- get + ; let (chrSolveRemCnstrTraceMp,chrSolveEvidMp) + = patchUnresolvedWithAssumption ((simpEnv s) {fiUniq = u3}) (simpRemOccL s) (simpresRedGraph chrSimplifyResult) (simpEvidMp s) + ; modify (\s -> s {simpRemCnstrTraceMp = chrSolveRemCnstrTraceMp, simpEvidMp = chrSolveEvidMp}) + } + else modify (\s -> s {simpRemCnstrTraceMp = Map.empty, simpRemOccL = []}) + + ; return () + } + where {- + canon s (Prove p) = (Prove $ p {cpoPr = p'}, m) + where (p',m) = predCanonic (simpEnv s) $ cpoPr p + canon s c = (c, emptyVarMp) + -} + canon s c + = case cnstrReducablePart c of + Just (_,p,mkc) -> (mkc $ p {cpoPr = p'}, m) + where (p',m) = predCanonic (emptyTyBetaRedEnv {tbredFI=simpEnv s}) $ cpoPr p + _ -> (c, emptyVarMp) + + -- basic simplification of reduction graph + basicSimpRedGraph chrSolveAllCnstrMp + = do { s <- get + ; let -- RedGraph to Evidence + ((chrSolveRemCnstrTraceMp,chrSolveEvidMp,errs),chrSimplifyResult2) + = chrSimplifyRedGraphToEvidence heur chrSolveAllCnstrMp (simpRes s) + + -- split unresolved into those who can be resolved by assuming them (via qualified types) and the others + (chrSolveAssumablePrOccL,cannotResCnstrTraceMp) + = partitionUnresolved2AssumableAndOthers chrSolveRemCnstrTraceMp + -- TBD: propagation of unresolved traces for error reporting + -- cannotResCnstrMp = cnstrTraceMpElimTrace cannotResCnstrTraceMp + -- chrSolveRemCnstrMp = cnstrTraceMpElimTrace chrSolveRemCnstrTraceMp + + ; put (s {simpRemCnstrTraceMp = chrSolveRemCnstrTraceMp, simpEvidMp = chrSolveEvidMp, simpErrs = errs, simpRes = chrSimplifyResult2}) + ; return (cannotResCnstrTraceMp,chrSolveAssumablePrOccL) + } + + -- full simplification + fullSimp u toProveHereCnstrMpPrev chrSimplifyResult + = do { s <- get + ; let -- simplification, to RedGraph + (chrSolveAllCnstrMp,chrSimplifyResult1) + = chrSimplifySolveToRedGraph ((simpEnv s) {fiUniq = u}) chrStore toProveHereCnstrMpPrev (simpToProveHereCnstrMp s) chrSimplifyResult + + ; put (s {simpRes = chrSimplifyResult1, simpAllCnstrMp = chrSolveAllCnstrMp}) + + -- RedGraph to Evidence etc + ; basicSimpRedGraph chrSolveAllCnstrMp + } + + + +simplify + :: [SimplifyHow] -- config + -> FIIn -- environment + -> ScopedPredStore -- available CHR rules + -> ClassDefaultGam -- environment/gam for defaulting + -> Heuristic CHRPredOcc RedHowAnnotation -- graph reduction heuristic + -> ([CHRIntermediateUntilAssume] -> ([CHRIntermediateUntilAssume],[CHRIntermediateUntilAssume])) -- partition into ambiguous predicates (and others), for defaulting + -> CHRPredOccCnstrMp -- constraints already proven a previous call + -> CHRPredOccCnstrMp -- constraints to prove + -> SimplifyResult CHRPredOcc RedHowAnnotation Guard VarMp -- simplification work done at a previous call + -> ( CHRPredOccCnstrMp -- canonicalized to be proven constraints + , CHRPredOccCnstrTraceMp -- remaining to be proven, as Assume's + , CHRPredOccCnstrTraceMp -- cannot be proven + , VarMp -- additional substitution found during proving & simplification + , [Err] -- errors + , SimplifyResult CHRPredOcc RedHowAnnotation Guard VarMp -- simplification work, for a next call + , CHRPredOccEvidMp -- map from constraint/pred occurrence to evidence + , EvidKeyToCBindMap -- map from occurrence to binding, globally + , PredScopeToCBindMap -- map from predscope to binding, per predscope opening/intro + , EvidKeyToCExprMap -- map from occurrence to expr + additional nesting info, for debug only + ) +simplify simplifyHow env chrStore clDfGam heur partitionUnresolved2AmbigAndOthers toProveHereCnstrMpPrev toProveHereCnstrMp prevRes + = {- Debug.tr "simplify" + ( (if toProveHereCnstrMpCanon == toProveHereCnstrMpCanon' then empty else pp "toProveHereCnstrMpCanon wrong") + >-< (if canonVarMp == canonVarMp' then empty else pp "canonVarMp wrong") + >-< (if cannotResCnstrMp1 == cannotResCnstrMp1' then empty else pp "cannotResCnstrMp1 wrong") + >-< (if chrSolveRemCnstrMp3 == chrSolveRemCnstrMp3' then empty else pp "chrSolveRemCnstrMp3 wrong" >-< show chrSolveRemCnstrMp3 >-< show chrSolveRemCnstrMp3') + -- >-< (if chrSolveAssumablePrOccL3 == chrSolveAssumablePrOccL3' then empty else pp "chrSolveAssumablePrOccL3 wrong" >-< ppCommas chrSolveAssumablePrOccL3 >-< ppCommas chrSolveAssumablePrOccL3') + ) $ + -} + ( toProveHereCnstrMpCanon + , chrSolveRemCnstrMp3, cannotResCnstrTraceMp + , canonVarMp + , firstNotEmpty + [ chrSolveErrs2 + , overlapErrs + ] + , chrSimplifyResult4 + { simpresRemPredL = map fst chrSolveAssumablePrOccL3 + } + , chrSolveEvidMp2 + , chrSolveEvidBindMp, chrSolveScopeBindMp + , chrSolveEvidCoreMp -- for debug only + ) + where s = execState (simplify' simplifyHow chrStore clDfGam heur partitionUnresolved2AmbigAndOthers toProveHereCnstrMpPrev) + (emptySimplifyState {simpEnv = env {fiUniq = u1}, simpToProveHereCnstrMp = toProveHereCnstrMp, simpRes = prevRes}) + env' = simpEnv s + chrSimplifyResult4 = simpRes s + chrSolveAssumablePrOccL3 = simpRemOccL s + chrSolveRemCnstrMp3 = simpRemCnstrTraceMp s + chrSolveEvidMp2 = simpEvidMp s + chrSolveErrs2 = simpErrs s + toProveHereCnstrMpCanon = simpToProveHereCnstrMp s + canonVarMp = simpVarMp s + cannotResCnstrTraceMp = simpCannotCnstrTraceMp s + + -- some unique seeds + (_,u1,u2,u3) = mkNewLevUID3 $ fiUniq env + + -- (1) compute code (Core) for dictionaries/witness, (2) get the overlapping instances + (chrSolveEvidCoreMp,overlapEvids) + = evidMpToCore (env' {fiUniq = u3}) chrSolveEvidMp2 + + -- get the bindings which must be introduced + (chrSolveEvidBindMp,chrSolveScopeBindMp) + = evidKeyCoreMpToBinds env' chrSolveEvidCoreMp + + -- overlapping errors; 20120209: is empty, detection done earlier + -- overlapErrs = if null overlapEvids then [] else [rngLift range Err_OverlapPreds [ (cpoPr $ overlapevidPredOcc a,map pp $ overlapevidInfos a) | a <- overlapEvids]] + overlapErrs = [] + -- TyCore variant + range = feRange $ fiEnv env + -- debugging info + -- dbgp = ppParensCommas $ Map.keys toProveHereCnstrMpCanon + -- dbg m= id -- Debug.tr m dbgp + + + + +fixedFtv mp = varFreeSet $ map cnstrPred $ Map.keys mp + +debugInfo chrSimplifyResult + = (s,rg,chrSolveStateDoneConstraints s,chrSolveStateTrace s,redAlts,redTrees,simpresRemPredL chrSimplifyResult) + where s = simpresSolveState chrSimplifyResult + rg = simpresRedGraph chrSimplifyResult + redAlts = simpresRedAlts chrSimplifyResult + redTrees = simpresRedTrees chrSimplifyResult + + + + +mkScopeBindings :: Bool -> PredScope -> PredScopeToCBindMap -> ([CBind],PredScopeToCBindMap) +mkScopeBindings alsoOuter sc mp + = (concatMap f scs,foldr Map.delete mp scs) + where f sc = Map.findWithDefault [] sc mp + scs = [sc] ++ (if alsoOuter then pscpParents sc else []) + + + +mkAssumeBindings :: [UID] -> EvidKeyToCBindMap -> [CBind] +mkAssumeBindings ids mp + = concat [ maybe [] id $ Map.lookup i mp | i <- ids ] + + + +type ScopeGam = Gam HsName PredScope + + + +tyPrLToSupNmL :: TyL -> [HsName] +tyPrLToSupNmL = zipWith (\i p -> hsnUniqifyInt HsNameUniqifier_SuperClass i (tyPredNm p)) [1..] + + + +-- | given the name of an instance, return names of intermediate dictionaries being constructed +mkInstanceBuildNms :: HsName -> (HsName,HsName) +mkInstanceBuildNms dictNm + = ( hsnUniqify HsNameUniqifier_ResultDict dictNm -- the computed result, being returned in the end + , hsnUniqify HsNameUniqifier_SelfDict dictNm -- the default, partially built dictionary, given as argument + ) + + + +-- | Get info about datatype and class for which derivation is done, looking up in various environments +derivGetDataTyInfo :: HsName -> HsName -> TyGam -> TyKiGam -> DataGam -> (TyGamInfo,TyKiGamInfo,DataGamInfo,TyKiGamInfo,[Err]) +derivGetDataTyInfo clNm tyNm tyGam tyKiGam dataGam + = (tgi,tkgi,dgi,ctkgi,firstNotEmpty [errs123,errs4]) + where + (tgi, tkgi, dgi, errs123) + -- special case to detect records/tuples + | hsnIsRec tyNm = ( emptyTGI, emptyTKGI + , emptyDataGamInfo {dgiVariant = DataGamInfoVariant_Rec} + , [] + ) + | otherwise = let (tgi, errs1) = tyGamLookupErr tyNm tyGam -- lookup for type + (dgi, errs3) = dataGamLookupErr tyNm dataGam -- lookup for structure info + (tkgi,errs2) = tyKiGamLookupByNameErr tyNm tyKiGam -- lookup for kind signature + in (tgi, tkgi, dgi, firstNotEmpty [errs1,errs2,errs3]) + (ctkgi,errs4) = tyKiGamLookupByNameErr (hsnClass2Kind clNm) tyKiGam -- lookup for class kind signature + + + +-- | make pred from kind and tvar +mkDerivPredFromKi :: UID -> Int -> Ty -> Ty -> Ty -> Maybe (Ty,UID) +mkDerivPredFromKi uniq derivArity predTyCon ki tv + = case appUnArr ki of + (as,_) -- (as,Ty_Con n) | n == hsnKindStar -- ???? is this restriction indeed necessary? + -> Just (mkTyPr $ Pred_Class $ predTyCon `appTopApp1` appTopApp (tv : map mkTyVar u1s),u') + where (u',u1) = mkNewLevUID uniq + u1s = mkNewUIDL arity u1 + arity = length as - derivArity + -- _ -> Nothing + + + + +-- | make context from the kinds of the datatype args and the actual datatype args +mkDerivPredContext :: UID -> Int -> Ty -> [Ty] -> [Ty] -> Maybe ([Ty],UID) +mkDerivPredContext uniq derivArity predTyCon dataTyKiL dataTyArgL + = foldr (\(k,t) cxu + -> do (cx,u) <- cxu + (cx',u') <- mkDerivPredFromKi u derivArity predTyCon k t + return (cx' : cx, u') + ) + (Just ([],uniq)) + (zip dataTyKiL dataTyArgL) + + + +mkWeaveExpr :: EHCOpts -> UID -> VarMp -> CSubst -> (CExpr->CExpr) -> CExpr -> [Coe] -> [Coe] -> (CExpr,CSubst) +mkWeaveExpr opts uniq finTyVarMp csubst postmk expr lCoeL rCoeL + = (postmk e, s1 `cSubstApp` s2) + where (_,u1,u2) = mkNewLevUID2 uniq + (ww,s1) = coeWipeWeaveAsSubst2 opts u1 finTyVarMp csubst lCoeL rCoeL + (e ,s2) = coeEvalOnAsSubst u2 ww expr + + + +-- | Make bindings for constructors, given various bits of info +mkDataConCBindL :: EHCOpts -> ToSysfEnv -> CTag -> Ty -> [DataConFldAnnInfo] -> HsName -> Bool -> [CBind] +mkDataConCBindL opts sysfEnv ctag ty annL conNm isNewtype + | isNewtype + = [ acoreBind1Ty conNm cty ({- TBD: see TyCore: cast -} acoreExprUnThunk $ acoreVar $ ehcOptBuiltin opts ehbnId) + ] + | otherwise + = [ acoreBind1Ty conNm cty + $ wrap + $ acoreLamTy (zip nms $ map mkt $ appUnArrArgs ty) + $ foldr (.) id mkStrict + $ acoreApp tup + $ map acoreVar nms' + ] + where arity | isNewtype = 1 + | otherwise = ctagArity ctag + nms = (map (\i -> hsnFromString ("x" ++ show i)) [1 .. arity]) + (nms',mkStrict) = (nms, replicate arity id) + mkt = SysF.ty2TyC opts sysfEnv + cty = mkt ty + wrap = id + tup = CExpr_Tup ctag + + + +-- | Generate all bindings given functions to generate individual bindings. +mkDataBinds + :: (Bool -> DataGamInfo -> [bind]) -- construct ty bind + -> (Bool -> DataTagInfo -> [bind]) -- construct val bind + -> DataGam + -> ( [bind] -- ty bind + , [bind] -- val bind + ) +mkDataBinds mkTy mkCon dataGam + = ( concat + [ mkTy (dgiIsNewtype dgi) dgi | dgi <- gamElts dataGam ] + , concat + [ concat + [ mkCon (dgiIsNewtype dgi) dti + | dti <- Map.elems constrMp + ] + | dgi@(DataGamInfo + { dgiConstrTagMp = constrMp + }) <- gamElts dataGam + ] + ) + + + +fsL2PatOffsetL :: EHCOpts -> FieldSplitL -> AssocL RPatFld (Maybe Int) +fsL2PatOffsetL opts l = [ (RPatFld_Fld n oe n p,Just oi) | (o,(foff,p)) <- zip [0..] l, let (oi,oe) = foffMkOff opts foff o, let n = foffLabel foff ] + + + +mkLetCBodyBindL :: Bool -> CBindCateg -> [(CBindCateg,CBindL)] -> [(CBindCateg,CBindL)] -> [(CBindCateg,CBindL)] -> CExpr -> ([(CBindCateg,CBindL)],CExpr) +mkLetCBodyBindL isStrict howToBind locBindL locOthBindL bodyBindL body + = if isStrict + then (locOthBindL,foldr (\(c,b) e -> acoreLet c b e) body (merge $ locBindL ++ bodyBindL)) + else (merge $ locOthBindL ++ locBindL ++ bodyBindL, body) + where merge (cb1@(c1,b1) : tl) + = case merge tl of + (c2,b2) : tl' | c1 == c2 && c1 == CBindCateg_Rec + -> (c1,b1++b2) : tl' + tl' -> cb1 : tl' + merge [] = [] + + + +cdictOffset :: HsName -> Ty -> Int +cdictOffset n r = tyRecOffset n $ r + + + +-- | Make the various names required for instance building +mkInstanceNames + :: EHCOpts + -> ToSysfEnv + -> HsName + -> Ty + -> ( AssocL HsName (Ty,CTy) + , [HsName] + , [HsName] + , [CExpr] + ) +mkInstanceNames + opts sysfEnv dictNm instanceRecTy + = ([(n,(t,SysF.ty2TyC opts sysfEnv t)) | (n,t) <- instanceFieldL],memberNames,memberNewNames,memberNewVars) + where instanceFieldL = rowCanonOrder $ snd $ tyRecExts instanceRecTy + memberNames = assocLKeys instanceFieldL + memberNewNames = [ hsnUniqifyStr HsNameUniqifier_DictField (show n) dictNm | n <- memberNames ] + memberNewVars = map acoreVar memberNewNames + + + +-- | Make a dictionary corresponding to an instance declaration +mkNormalInstance + :: EHCOpts + -> ToSysfEnv -- environmental info for SysF stuff + -> ClGamInfo -- info about the class + -> DataGam -- env/gamma for datas + -> CTag -- tag of the dictionary (as data type) + -> (HsName,HsName,HsName) -- various names for the dictionary under construction at various stages of construction, also used externally + -> CTy -- instance dict as data type + -> Ty -- instance dict as record + -> ( [HsName] -- names of super class fields + , [HsName] -- names of super class dicts, given as arg + , [HsName] -- names of context class dicts, given as arg + ) + -> [CBind] -- bindings for decls of the instance + -> ([CBind] -- bindings for decls related context reduction, both Assume & Prove + ,[CBind] -- bindings for super class related context reduction, only Prove + ,[CBind] -- bindings for super + ctxt class related context reduction, only Assume + ) + -> ( CExpr -- the instance + , CMetaVal -- the meta info about the instance + ) +mkNormalInstance + opts sysfEnv clgi dataGam dictTag + (dictNm,_,dictBuildNm) + instanceTy instanceRecTy + (superFldNmL,superNmL,contextNmL) + declsCBindL + (chrDeclsCBindL,chrSuperProveCBindL,chrSuperCtxtAssumeCBindL) + = ( bind4 + , CMetaVal_DictInstance (TrackVarApply (ctagTyNm dictTag) [] : TrackVarApply dfltNm [] : instanceAndSuperTracks ) + ) + where dfltNm = clgiDfltDictNm clgi + rsltNm = dictBuildNm + rsltNmStrict = hsnUniqifyEval rsltNm + dfltNmStrict = hsnUniqifyEval dfltNm + + dfltVar = acoreVar dfltNm + rsltVar = acoreVar rsltNm + rsltVarStrict= acoreVar rsltNmStrict + dfltVarStrict= acoreVar dfltNmStrict + + (instanceFieldL,memberNames,memberNewNames,memberNewVars) + = mkInstanceNames opts sysfEnv dictNm instanceRecTy + mkSetFlds = mkInstanceSetFlds opts dataGam dictTag instanceFieldL instanceRecTy + + + -- mkCTy = SysF.ty2TyC opts sysfEnv + + instanceBindingPairs= [ (nm,v) + | CBind_Bind nm asps <- declsCBindL, CBound_Bind _ v <- asps + ] + instanceMbBodies = map (flip lookup instanceBindingPairs) memberNames + instanceMbNewNames = let f _ Nothing = Nothing + f n (Just e) = Just n + in zipWith f memberNewNames instanceMbBodies + instanceMbNames = let f _ Nothing = Nothing + f n (Just _) = Just n + in zipWith f memberNames instanceMbNewNames + instanceNameMapping = [ (nm, CMetaVal_Val, v) + | (Just nm,v) <- zip instanceMbNames memberNewVars + ] + instanceNewBindings = [ acoreBind1MetaTy nm CMetaVal_Val (acoreTyErr $ "EH.ToCore.mkNormalInstance.instanceNewBindings: " ++ show nm) v + | (nm,Just v) <- zip memberNewNames instanceMbBodies + ] + + superNewVars = map acoreVar superNmL + superNameMapping = zip3 superFldNmL + (repeat CMetaVal_Dict) + superNewVars + + superNameMapping2 = zip superFldNmL + superNmL + superPairs = map getBindLeftAndRightVar chrSuperProveCBindL + + doubleLookup :: HsName -> Maybe HsName + doubleLookup nm = do { nm2 <- lookup nm superNameMapping2 + -- ; nm3 <- lookup nm2 superPairs + ; return nm2 -- nm3 + } + + superMbNewNames = map doubleLookup memberNames + + instanceAndSuperMbNewNames = let f (Just x) _ = Just x + f _ (Just y) = Just y + f _ _ = Nothing + in zipWith f instanceMbNewNames superMbNewNames + + instanceAndSuperTracks = map mbNameToTrack instanceAndSuperMbNewNames + + instanceCHRBindings = chrSuperCtxtAssumeCBindL ++ chrSuperProveCBindL ++ chrDeclsCBindL + + dict1 = acore1App dfltVar rsltVar + bind1 = acoreBind1MetaTy dfltNmStrict CMetaVal_Dict instanceTy dict1 + + dict2 = acoreLetBase (acoreBindcategStrict) [bind1] (mkSetFlds (superNameMapping ++ instanceNameMapping) dfltVarStrict) + bind2 = acoreBind1MetaTy rsltNmStrict (CMetaVal_Track TrackSelf) instanceTy dict2 + + dict3 = acoreLetBase (acoreBindcategPlain) [bind2] rsltVarStrict + bind3 = acoreBind1MetaTy rsltNm (CMetaVal_Track TrackSelf) instanceTy dict3 + + dict4 = acoreLetRec ([bind3] ++ instanceNewBindings ++ instanceCHRBindings) rsltVar + bind4 = acoreLamTy (acoreTyErrLift "EH.ToCore.mkNormalInstance.dict4" contextArguments) dict4 + + -- The above generates the following Core code as dict4: + -- + -- letrec reslt = let rsltStrict = let! dfltStrict = dflt rslt + -- in case defltStrict of + -- (Dict-C _1 _2 _3 _4) -> (Dict-C _1 inst2 _3 inst4) -- in this example, field 2 and 4 are defined in the isntance, 1 and 3 are taken from the defaultdefinitions + -- in rsltStrict + -- inst2 = ... + -- inst4 = ... + -- in reslt + + contextArguments = contextNmL + + + +-- Make a dictionary for a normal instance, the default-definitions of a class, or for a derived instance +mkInstanceCBindL + :: EHCOpts + -> ToSysfEnv -- environmental info for SysF stuff + -> ClGamInfo -- info about the class + -> TyKiGam -- env/gamma for ki of ty's + -> DataGam -- env/gamma for datas + -> InstVariant -- what kind of instance + -> CTag -- tag of the dictionary (as data type) + -> (HsName,HsName,HsName) -- various names for the dictionary under construction at various stages of construction, also used externally + -> Ty -- instance dict as data type + -> Ty -- instance dict as record + -> ( [HsName] -- names of super class fields + , [HsName] -- names of super class dicts, given as arg + , [HsName] -- names of context class dicts, given as arg + ) + -> [CBind] -- bindings for decls of the instance + -> ([CBind] -- bindings for decls related context reduction, both Assume & Prove + ,[CBind] -- bindings for super class related context reduction, only Prove + ,[CBind] -- bindings for super + ctxt class related context reduction, only Assume + ) + -> [CBind] +mkInstanceCBindL + opts sysfEnv clgi tyKiGam dataGam instVariant dictTag + nms@(dictNm,dictSelfNm,dictBuildNm) + instanceTy + instanceRecTy + nmLs@(superFldNmL,superNmL,contextNmL) + declsCBindL + chrBindLs@(chrDeclsCBindL,chrSuperProveCBindL,chrSuperCtxtAssumeCBindL) + = [acoreBind1MetaTy dictNm generatedMeta instanceCTy generatedDictionary] + where (generatedDictionary, generatedMeta) + = case instVariant of + InstNormal -> mkNormalD declsCBindL + InstDefault -> mkDefaultD declsCBindL + InstDeriving _ -> mkNormalD declsCBindL + rsltNm = dictBuildNm + rsltVar = acoreVar rsltNm + + instanceCTy = SysF.ty2TyC opts sysfEnv instanceTy + + mkNormalD instanceBindings + = mkNormalInstance + opts sysfEnv clgi dataGam dictTag nms instanceCTy instanceRecTy nmLs + instanceBindings chrBindLs + + -- Make a dictionary corresponding to (the default definitions in a) class definition + mkDefaultD defaultBindings + = let selfNm = dictSelfNm + + (instanceFieldL,memberNames,memberNewNames,memberNewVars) + = mkInstanceNames opts sysfEnv dictNm instanceRecTy + + lookupMeta n = if n `elem` superFldNmL then CMetaVal_Dict else CMetaVal_Val + + defaultBindingPairs = [ (nm,v) + | CBind_Bind nm asps <- defaultBindings, CBound_Bind _ v <- asps + ] + defaultMbBodies = map (flip lookup defaultBindingPairs) memberNames + defaultMetas = map lookupMeta memberNames + defaultBodies = map (maybe (acoreBuiltinUndefined opts) id) defaultMbBodies + defaultMbNewNames = let f _ Nothing = Nothing + f n (Just _) = Just n + in zipWith f memberNewNames defaultMbBodies + defaultTracks = map mbNameToTrack defaultMbNewNames + + defaultNewBindings = zipWith3 (\n m b -> acoreBind1MetaTy n m (acoreTyErr $ "EH.ToCore.mkInstanceCBindL.defaultNewBindings: " ++ show n) b) + memberNewNames + defaultMetas + defaultBodies + defaultCHRBindings = chrDeclsCBindL + + dict5 = acoreTagTupTy dictTag (acoreTyErr "EH.ToCore.mkInstanceCBindL.dict5") memberNewVars -- acoreApp (CExpr_Tup dictTag) memberNewVars + bind5 = acoreBind1MetaTy rsltNm CMetaVal_Dict (acoreTyErr $ "EH.ToCore.mkInstanceCBindL.bind5: " ++ show rsltNm) dict5 + + dict6 = acoreLetRec ([bind5] ++ defaultNewBindings ++ defaultCHRBindings) rsltVar + bind6 = acoreLam1Ty selfNm (acoreTyErr $ "EH.ToCore.mkInstanceCBindL.bind6: " ++ show selfNm) dict6 + + in ( bind6 + , CMetaVal_DictClass defaultTracks + ) + + + +mkInstanceSetFlds :: EHCOpts -> DataGam -> CTag -> AssocL HsName (Ty,CTy) -> Ty -> [(HsName,CMetaVal,CExpr)] -> CExpr -> CExpr +mkInstanceSetFlds opts dataGam dictTag instanceFieldL instanceRecTy + = if ehcCfgClassViaRec opts + then mkSetFldsRec + else mkSetFldsData + where off n = cdictOffset n instanceRecTy + off' n = tyExtsOffset n instanceFieldL + mkSetFldsRec ts d0 + = foldl (\d (n,_,v) -> mkSet d n v) d0 ts + where mkSet d n v = CExpr_TupUpd d dictTag n (acoreInt opts $ off n) v + + mkSetFldsData ts d0 + = acoreSatSelsCaseMetaTy env Nothing CMetaVal_Dict d0 dictTag nmLblOffL Nothing sel + where env = (emptyRCEEnv opts) {rceDataGam = dataGam} + fullListWithTrivialValues = [ (o, (o, t, acoreVar n)) + | (n,t,o) <- nmLblOffL + ] + sparseListWithInterestingValues = [ (o, maybe (acoreTyErr $ "mkInstanceSetFlds.sparseListWithInterestingValues: " ++ show n) snd mbt, v) + | (n,m,v) <- ts, let ((o,_),mbt) = off' n + ] + arity = ctagArity dictTag + ns = take arity hsnLclSupply + nmLblOffL :: [(HsName,CTy,Int)] + nmLblOffL = zipWith3 (\n (_,(_,t)) o -> (n,t,o)) ns instanceFieldL [0..] + sel = acoreTagTupTy dictTag (acoreTyErr "mkInstanceSetFlds.sel") -- acoreApp (CExpr_Tup dictTag) + (map (\(_,_,v) -> v) + $ listSaturateWith 0 + (arity-1) + (\(o,_,_) -> o) + fullListWithTrivialValues + sparseListWithInterestingValues + ) + + + +getBindRightVar :: CBind -> Maybe HsName + +getBindRightVar (CBind_Bind _ [CBound_Bind _ v]) = acoreExprMbVar v +getBindRightVar _ = Nothing + + +getBindLeftAndRightVar :: CBind -> (HsName,HsName) + +getBindLeftAndRightVar (CBind_Bind nm1 [CBound_Bind _ (CExpr_Var ref2)]) = (nm1, acbrefNm ref2) +getBindLeftAndRightVar _ = error "getBindLeftAndRightVar: not a bind" + +mbNameToTrack Nothing = TrackNone +mbNameToTrack (Just nm) = TrackVarApply nm [] + + + + +mkInstanceDerivingFldBind :: EHCOpts -> RCEEnv -> DataGam -> UID -> DataGamInfo -> Ty -> HsName -> CTag -> [[PredOcc]] -> [PredOcc] -> DerivClsFld -> CBind +mkInstanceDerivingFldBind opts rceEnv dataGam uniq derivDataDGI derivHdDataTy dictBuildNm ctag derivAltsPrOcc derivExtraPrOcc + = mkf + where rsltNm = dictBuildNm + rsltVar = acoreVar rsltNm + + mkf :: DerivClsFld -> CBind + mkf dcf + = acoreBind1Ty (dcfNm dcf) (acoreTyErr $ "EH.ToCore.mkInstanceDerivingFldBind.mkf.dcfNm: " ++ show (dcfNm dcf)) + (if fArity == 0 + then acoreLamTy (acoreTyErrLift "EH.ToCore.mkInstanceDerivingFldBind.mkf.A" $ dcfInitialArgL dcf) + $ dcfNoArgSubsCExpr dcf rceEnv + [ (dti,mkcSubs dti (repeat []) altPrOccL) | (dti,altPrOccL) <- zip dtis derivAltsPrOcc ] + nrOfAlts rsltVar extraCxL (dcfInitialArgL dcf) + else acoreLamTy (acoreTyErrLift "EH.ToCore.mkInstanceDerivingFldBind.mkf.B" $ dcfInitialArgL dcf ++ take fArity nsA) + (dcfWrapCase dcf opts derivDataDGI nrOfAlts n1 (dcfInitialArgL dcf) + $ acoreStrictSatCaseTy rceEnv (Just (hsnUniqifyEval n1,(acoreTyErr $ "EH.ToCore.mkInstanceDerivingFldBind.mkf.n1: " ++ show n1))) n1v + [ CAlt_Alt (dcfMkCPat dcf altInx ctag (ctagArity ctag) (Just $ n1subs ctag)) + (mkc splDTI altInx (fArity - 1) n1s [n1subs ctag] altPrOccL) + | (ctag,altPrOccL) <- zip (map dtiCTag dtis) derivAltsPrOcc + , let splDTI@(dtisLT,_,_) = splitDTIs ctag dtis + altInx = length dtisLT + ] + ) ) + where n1v = acoreVar n1 + nsA@(n1:n1s) = hsnLclSupplyWith (mkHNm "x") + dtis = panicJust "Decl.Instance.Deriving.dataGamDTIsOfTy" $ dataGamDTIsOfTy derivHdDataTy dataGam + nrOfAlts = length dtis + splitDTIs t ts -- in (lt,eq,gt), according to list ordering + = (l,e,g) + where (l,(e:g)) = span ((/= t) . dtiCTag) ts + fArity = (length $ appUnArrArgs $ dcfTy dcf) - dcfNrOmitTailArg dcf - length (dcfInitialArgL dcf) - 1 {- dictionary -} + n1subs t = nsubs t n1 + nsubs t n = take (ctagArity t) $ hsnLclSupplyWith n + extraCxL = [ acoreNmHolePred (poPoi prOcc) | prOcc <- derivExtraPrOcc ] + mkcSubs dti nmFldLL altPrOccL + = [ acoreApp + (acoreVar (dcfNm dcf)) + ([acoreNmHolePred (poPoi prOcc)] + ++ (dcfInitialSubArgL dcf dti ++ map acoreVar nmFldL)) + | (nmFldL,prOcc) <- zip nmFldLL altPrOccL + ] + mkc tg@(dtisLT,dti,dtisGT) altInx arity nms nmFldLL altPrOccL + = case nms of + (n:ns) | arity > 0 + -> acoreStrictSatCaseTy rceEnv (Just (hsnUniqifyEval n,(acoreTyErr $ "EH.ToCore.mkInstanceDerivingFldBind.mkf.mkc.n: " ++ show n))) (acoreVar n) + ( [ mka (dtiCTag dti) tsubs (mkc tg altInx (arity - 1) ns (nmFldLL ++ [tsubs]) altPrOccL) ] + ++ [ mka t (nsubs t n) (dcfAllTagLtCExpr dcf) | t <- map dtiCTag dtisLT ] + ++ [ mka t (nsubs t n) (dcfAllTagGtCExpr dcf) | t <- map dtiCTag dtisGT ] + ) + where tsubs = nsubs (dtiCTag dti) n + mka ctag nsubs e = CAlt_Alt (dcfMkCPat dcf altInx ctag (ctagArity ctag) (Just nsubs)) e + _ -> dcfFoldSubsCExpr dcf uniq rceEnv dti (altInx, nrOfAlts) (dcfInitialArgL dcf) + $ mkcSubs dti (transpose nmFldLL) altPrOccL + + + +mkDataGenerBinds + :: -- (AbstractCore e m b bcat mbind t) => + EHCOpts + -> ToSysfEnv + -> RCEEnv + -> ClGam -- env/gamma for class + -> TyKiGam -- env/gamma for ki of ty's + -> DataGam -- env/gamma for datas + -> UID -- uniq + -> [GenerDataInstInfo] -- inst infos + -> ([CBind],[Err]) +mkDataGenerBinds + opts sysfEnv rceEnv clGam tyKiGam dataGam + uniq instInfoL + = (concat instBinds, concat errs) + where (instBinds,errs) = unzip $ map mk instInfoL + mk (orignm,dictNm,clNm,instKind,pr) + = ( mkInstanceCBindL opts sysfEnv clgi tyKiGam dataGam InstNormal (clgiDictTag clgi) (dictNm,dictSelfNm,dictBuildNm) (pred2DataTy pr) recTy ([],[],[]) + binds ([],[],[]) + , foErrL evFO + ) + where (_,u1,u2) = mkNewLevUID2 uniq + clgi = panicJust ("mkDataGenerBinds.clGam: " ++ show dictNm ++ ": " ++ show clNm) $ gamLookup clNm clGam + + -- derived names required for building + (dictSelfNm,dictBuildNm) = mkInstanceBuildNms dictNm + + -- match predicate to get the record type describing fields of dictionary + evFO = fitPredToEvid' u1 emptyVarMp (mkTyPr pr) (Left clgi) + recTy = foVarMp evFO `varUpd` foTy evFO + + -- the bindings for datatypes acting as labels + binds = case instKind of + GenerInstKind_Representable remArity proj + -> [ acoreBind1 (ehcOptBuiltin2 opts ehbnGenerClassRepresentableNFldFrom remArity) (projFrom opts rceEnv proj) + , acoreBind1 (ehcOptBuiltin2 opts ehbnGenerClassRepresentableNFldTo remArity) (projTo opts rceEnv proj) + ] + + GenerInstKind_Datatype + -> [ mkBindStr ehbnGenerClassDatatypeFldName $ hsnQualified orignm + , mkBindStr ehbnGenerClassDatatypeFldModule $ maybe hsnUnknown id $ hsnQualifier orignm + ] + + GenerInstKind_Selector + -> [ mkBindStr ehbnGenerClassSelectorFldName $ hsnQualified orignm + ] + + GenerInstKind_Constructor tyNm + -> [ mkBindStr ehbnGenerClassConstructorFldName $ hsnQualified orignm ] + ++ (if Map.null (dtiFldMp dti) then [] else [mkBind ehbnGenerClassConstructorFldIsRec $ acoreVar $ biNm ehbnBoolTrue]) + ++ (if isNothing mbInfix + then [] + else [mkBind ehbnGenerClassConstructorFldFixity + $ acoreApp (acoreVar $ biNm ehbnGenerDataFixityAltInfix) + $ [ acoreVar (biNm (case fixity of + Fixity_Infix -> ehbnGenerDataAssociativityAltNot + Fixity_Infixr -> ehbnGenerDataAssociativityAltRight + Fixity_Infixl -> ehbnGenerDataAssociativityAltLeft + ) ) + , acoreInt opts prio + ] + ] + ) + where dgi = panicJust ("mkDataGenerBinds.dataGam: " ++ show tyNm) $ dataGamLookup tyNm dataGam + dti = panicJust ("mkDataGenerBinds.dgiConstrTagMp: " ++ show orignm) $ Map.lookup orignm $ dgiConstrTagMp dgi + mbInfix@(~(Just (prio,fixity))) = dtiMbFixityPrio dti + + -- _ -> [] + + -- get a builtin name + biNm = ehcOptBuiltin opts + + -- utils for bindings + argNm = mkHNm "x" + mkBindx a f x = acoreBind1 (biNm f) (acoreLamTy (acoreTyErrLift "mkDataGenerBinds.mkBindx" [a]) x) + mkBind = mkBindx argNm + mkBindStr f n = mkBind f $ acoreBuiltinString opts $ show n + + + +infixr 2 >###< -- same as >-< + +(>###<) :: PP_Doc -> PP_Doc -> PP_Doc +l >###< r = l >-< indent 2 r + + + +checkClNms :: Range -> HsNameS -> [Err] +checkClNms r s = if Set.null s then [] else [mkErr_NamesNotIntrod r "class" (Set.toList s)] + + + +mkRangedPred :: RangeMp -> Pred -> (Pred,[Range]) +mkRangedPred rm pr = (pr,Map.findWithDefault [] pr rm) + + + +mkPrvErr :: RangeMp -> Range -> CHRPredOccCnstrTraceMp -> [Err] +mkPrvErr rm r m + = if Map.null m + then [] + else [Err_NotProvenPreds r [ (mkRangedPred rm pr, vlist $ map pp t) | (c,((_,t):_)) <- Map.toList m, let pr = cpoPr (cnstrPred c) ]] + + + +gamErrToL :: Range -> Gam HsName ErrL -> ErrL +gamErrToL r = concat . map (\(n,e) -> mkNestErr r (pp n) e) . gamToAssocL + + + +ppErrsSq :: ErrSq -> PP_Doc +ppErrsSq = ppErrs . Seq.toList + + + +tyGamLookupOrAdd :: UID -> HsName -> TyGam -> TyGam -> (TyGamInfo,TyGam) +tyGamLookupOrAdd uniq nm tyGamLkup tyGam + = case tyGamLookup nm tyGamLkup of + Nothing -> let t = mkNewTyVar uniq + tgi = mkTGI t + in (tgi,gamAdd nm tgi tyGam) + Just tgi -> (tgi,tyGam) + + + +tyKiGamLookupOrAdd :: UID -> Ty -> TyKiGam -> (TyKiGamInfo,TyKiGam,TyKiGam) +tyKiGamLookupOrAdd uniq t tyKiGam + = case tyKiGamLookup t tyKiGam of + Nothing -> (tkgi, newg `gamUnion` tyKiGam, newg) + where tkgi = TyKiGamInfo (mkNewTyVar uniq) -- t + newg = tyKiGamSingleton t tkgi + Just tkgi -> (tkgi,tyKiGam,emptyGam) + + + +tvGathFlowOut :: Ord k => Gam k v -> Gam k v -> Gam k v +tvGathFlowOut lhsG insideG + = lhsG' + where (l,g) = gamPop insideG + lhsG' = gamAddGam l lhsG + +tvGathFlowIn :: Ord k => Gam k v -> Gam k v -> Gam k v +tvGathFlowIn newG lhsG = gamPushNew (gamPushGam newG lhsG) + + + +type DoFit = FIOpts -> VarMp -> FIOut + + + +mkFreshAppImTy :: UID -> (Ty -> Ty) -> (Ty,Ty,Ty) +mkFreshAppImTy u mkr + = (im,rt,[im] `appArr` rt) + where [i,r] = mkNewUIDL 2 u + im = mkImplsVar i + rt = mkr $ mkTyVar r + + + +mkFreshLamImTy :: UID -> (Ty,Ty,Ty,Ty) +mkFreshLamImTy u + = (im,at,rt,[im,at] `appArr` rt) + where [i,a,r] = mkNewUIDL 3 u + im = mkImplsVar i + at = mkTyVar a + rt = mkTyVar r + + + +dfCheck :: UID -> FIOpts -> FIEnv -> HsName -> ValGam -> VarMp -> Ty -> (Ty,Ty,Ty,FIOut,[Err]) +dfCheck uniq fiOpts fe fldNm valGam knTyVarMp knTy + = (gTy,knDataTy,knFldTy,fo,nmErrs) + where (gTy,nmErrs) = valGamLookupTy (hsnFldUpd fldNm) valGam + (_,u1,u2) = mkNewLevUID2 uniq + (knFldTy,knDataTy,knFldUpdTy) + = (e,df,v `appArr` knTy) + where v@[e,df] = mkNewTyVarL 2 u1 + fo = fitsIn fiOpts fe u2 knTyVarMp gTy knFldUpdTy + + + +-- | Construct a function which does quantification given some fixed environmental info +mkDoValGamQuantify + :: TyKiGam -> VarMp -> TyVarIdS -> ValGam + -> (Bool -> VarMp -> [PredOcc] -> (ValGam, VarMp, (VarMp, TQOGam))) +mkDoValGamQuantify valQuTyKiGam quTvKiVarMp noLetQuantTyVarIdS valGam_l_ + = \doQuant tyVarMp prOccL -> valGamQuantifyWithVarMp doQuant valQuTyKiGam quTvKiVarMp tyVarMp noLetQuantTyVarIdS prOccL valGam_l_ + + + +-- | split a list of predicates into non-ambiguous & ambiguous, using quantifications results tqoGam, +-- which (a.o.) administers which predicates could be merged for quantification, those not are then ambiguous +doPredAmbigSplit :: (x -> PredOcc) -> TQOGam -> [x] -> ([x],[x]) +doPredAmbigSplit get tqoGam prOccL + = partition (\o -> poPoi (get o) `Set.member` assumedByQuant) prOccL + where assumedByQuant = Set.unions $ map tmpoInsPrIdSet $ gamElts tqoGam + +-- | Split predicates according to whether the predicate combining part of quantification can be done +mkDoPredAmbigSplitForSimplify :: (Bool -> vm -> [PredOcc] -> (dum1,dum2,(dum3,TQOGam))) -> vm -> [(CHRPredOcc, x)] -> ([(CHRPredOcc, x)],[(CHRPredOcc, x)]) +mkDoPredAmbigSplitForSimplify doValGamQuantify tyVarMpDeclsL01 + = \chrPrOccL + -> let us = mkNewLevUIDL (length chrPrOccL) uidStart + -- couple with arbitrary id's to make quantify & split work + prOccL = zipWith (\u (o,_) -> cpo2PredOcc (mkPrId u) o) us chrPrOccL + (_,_, (_,tqoGam)) = doValGamQuantify False tyVarMpDeclsL01 prOccL + (namb,amb) = doPredAmbigSplit fst tqoGam $ zip prOccL chrPrOccL + in (map snd amb, map snd namb) + + + +type RangeMp = Map.Map Pred [Range] + +cnstrMpToRangeMp :: CHRPredOccCnstrMp -> RangeMp +cnstrMpToRangeMp m = Map.unionsWith (++) [ Map.singleton (cpoPr p) [cpoRange p] | (Prove p) <- Map.keys m ] + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +data ExprCtxt + = ExprCtxt_Top | ExprCtxt_Lam | ExprCtxt_Internal + deriving Eq + +-- AGItf ------------------------------------------------------- + +-- semantic domain +type T_AGItf = ScopedPredStore -> + ClassDefaultGam -> + ClGam -> + DataGam -> + UID -> + IdQualGam -> + Bool -> + KiGam -> + HsName -> + EHCOpts -> + PolGam -> + TyGam -> + TyKiGam -> + ValGam -> + ( ErrSq,CModule,UID,ScopedPredStore,ClassDefaultGam,ClGam,DataGam,(Seq.Seq (HsName,IdOccKind)),KiGam,LamMp,ModEntRelFilterMp,PolGam,TyGam,TyKiGam,ValGam,(Maybe (Set.Set HsName)),PP_Doc,PP_Doc) + +-- CaseAlt ----------------------------------------------------- + +-- semantic domain +type T_CaseAlt = ( Range,T_CaseAlt_1) +type T_CaseAlt_1 = UID -> + ( UID,T_CaseAlt_2) +type T_CaseAlt_2 = KiGam -> + Int -> + Int -> + ( Int,T_CaseAlt_3) +type T_CaseAlt_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,T_CaseAlt_4) +type T_CaseAlt_4 = ClGam -> + DataGam -> + VarMp -> + TyKiGam -> + TyVarIdS -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_CaseAlt_5) +type T_CaseAlt_5 = Ty -> + VarMp -> + ValGam -> + ( VarMp,T_CaseAlt_6) +type T_CaseAlt_6 = ScopedPredStore -> + ClassDefaultGam -> + FIOpts -> + Ty -> + VarMp -> + TyVarIdS -> + VarMp -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,VarMp,T_CaseAlt_7) +type T_CaseAlt_7 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,RAlt,RAlt,Ty) + +-- CaseAlts ---------------------------------------------------- + +-- semantic domain +type T_CaseAlts = ( Range,T_CaseAlts_1) +type T_CaseAlts_1 = UID -> + ( UID,T_CaseAlts_2) +type T_CaseAlts_2 = KiGam -> + Int -> + Int -> + ( Int,T_CaseAlts_3) +type T_CaseAlts_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,T_CaseAlts_4) +type T_CaseAlts_4 = ClGam -> + DataGam -> + VarMp -> + TyKiGam -> + TyVarIdS -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_CaseAlts_5) +type T_CaseAlts_5 = Ty -> + Ty -> + VarMp -> + ValGam -> + ( VarMp,Ty,T_CaseAlts_6) +type T_CaseAlts_6 = ScopedPredStore -> + ClassDefaultGam -> + FIOpts -> + VarMp -> + TyVarIdS -> + VarMp -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,VarMp,T_CaseAlts_7) +type T_CaseAlts_7 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,([PP_Doc]),([RAlt]),([RAlt])) + +-- DataConstr -------------------------------------------------- + +-- semantic domain +type T_DataConstr = ( Range,T_DataConstr_1) +type T_DataConstr_1 = UID -> + ( UID,T_DataConstr_2) +type T_DataConstr_2 = Ty -> + Polarity -> + PolGam -> + VarMp -> + TyGam -> + ( (AssocL HsName Ty),Int,VarMp,T_DataConstr_3) +type T_DataConstr_3 = Ty -> + VarMp -> + Int -> + TyKiGam -> + HsName -> + ( Ty,([HsName]),DataConstrTagMp,TyKiGam,VarMp,T_DataConstr_4) +type T_DataConstr_4 = TyKiGam -> + VarMp -> + ValGam -> + VarMp -> + ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,VarMp,ValGam,T_DataConstr_5) +type T_DataConstr_5 = EvidKeyToCBindMap -> + PredScopeToCBindMap -> + ScopedPredStore -> + ClassDefaultGam -> + ClGam -> + VarMp -> + VarMp -> + Bool -> + KiGam -> + Int -> + HsName -> + EHCOpts -> + PredScope -> + RangeMp -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ValGam -> + TyVarIdS -> + ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,CBindL,CBindL) + +-- DataConstrs ------------------------------------------------- + +-- semantic domain +type T_DataConstrs = ( Range,T_DataConstrs_1) +type T_DataConstrs_1 = UID -> + ( UID,T_DataConstrs_2) +type T_DataConstrs_2 = Ty -> + Polarity -> + PolGam -> + VarMp -> + TyGam -> + ( (AssocL HsName Ty),Int,VarMp,T_DataConstrs_3) +type T_DataConstrs_3 = Ty -> + VarMp -> + Int -> + TyKiGam -> + HsName -> + ( Ty,([HsName]),DataConstrTagMp,TyKiGam,VarMp,T_DataConstrs_4) +type T_DataConstrs_4 = TyKiGam -> + VarMp -> + ValGam -> + VarMp -> + ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,VarMp,ValGam,T_DataConstrs_5) +type T_DataConstrs_5 = EvidKeyToCBindMap -> + PredScopeToCBindMap -> + ScopedPredStore -> + ClassDefaultGam -> + ClGam -> + VarMp -> + VarMp -> + Bool -> + KiGam -> + Int -> + HsName -> + EHCOpts -> + PredScope -> + RangeMp -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ValGam -> + TyVarIdS -> + ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,([PP_Doc]),CBindL,CBindL) + +-- DataField --------------------------------------------------- + +-- semantic domain +type T_DataField = ( Range,T_DataField_1) +type T_DataField_1 = UID -> + ( UID,T_DataField_2) +type T_DataField_2 = Polarity -> + PolGam -> + VarMp -> + TyGam -> + ( ([DataConFldAnnInfo]),FldTyL,VarMp,TyGam,T_DataField_3) +type T_DataField_3 = TyKiGam -> + ( TyKiGam,TyKiGam,T_DataField_4) +type T_DataField_4 = Ty -> + VarMp -> + ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,TyL,VarMp,T_DataField_5) +type T_DataField_5 = EvidKeyToCBindMap -> + PredScopeToCBindMap -> + ScopedPredStore -> + ClassDefaultGam -> + ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + Int -> + HsName -> + EHCOpts -> + VarMp -> + PredScope -> + RangeMp -> + ToSysfEnv -> + VarMp -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc) + +-- DataFieldExpr ----------------------------------------------- + +-- semantic domain +type T_DataFieldExpr = ( Range,T_DataFieldExpr_1) +type T_DataFieldExpr_1 = UID -> + ( UID,T_DataFieldExpr_2) +type T_DataFieldExpr_2 = KiGam -> + Int -> + Int -> + ( Int,T_DataFieldExpr_3) +type T_DataFieldExpr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,T_DataFieldExpr_4) +type T_DataFieldExpr_4 = ClGam -> + VarMp -> + TyKiGam -> + DataGam -> + TyVarIdS -> + ( DataGam,T_DataFieldExpr_5) +type T_DataFieldExpr_5 = DataGam -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_DataFieldExpr_6) +type T_DataFieldExpr_6 = ScopedPredStore -> + ClassDefaultGam -> + FIOpts -> + VarMp -> + TyVarIdS -> + VarMp -> + ValGam -> + TyVarIdS -> + ( ([HsName]),(Maybe HsName),Ty,VarMp,T_DataFieldExpr_7) +type T_DataFieldExpr_7 = FIOpts -> + Ty -> + VarMp -> + ( CHRPredOccCnstrMp,RangeMp,TyVarIdS,Ty,VarMp,T_DataFieldExpr_8) +type T_DataFieldExpr_8 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + DataGamInfo -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,CSubst,CBindL,CExpr,ErrSq,(FieldUpdateL (DataTagInfo -> Int -> CExpr)),ModEntRelFilterMp,VarMp,(Maybe DataTagInfo),PP_Doc,([PP_Doc])) + +-- DataFieldPatExpr -------------------------------------------- + +-- semantic domain +type T_DataFieldPatExpr = ( Range,T_DataFieldPatExpr_1) +type T_DataFieldPatExpr_1 = UID -> + ( UID,T_DataFieldPatExpr_2) +type T_DataFieldPatExpr_2 = KiGam -> + Int -> + Int -> + ( Int,T_DataFieldPatExpr_3) +type T_DataFieldPatExpr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,TyGam,TyKiGam,T_DataFieldPatExpr_4) +type T_DataFieldPatExpr_4 = ClGam -> + DataGam -> + VarMp -> + TyKiGam -> + TyVarIdS -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_DataFieldPatExpr_5) +type T_DataFieldPatExpr_5 = FIOpts -> + Ty -> + VarMp -> + ValGam -> + ValGam -> + ( VarMp,ValGam,T_DataFieldPatExpr_6) +type T_DataFieldPatExpr_6 = ScopedPredStore -> + ClassDefaultGam -> + VarMp -> + TyVarIdS -> + VarMp -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_DataFieldPatExpr_7) +type T_DataFieldPatExpr_7 = CSubst -> + HsName -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + VarMp -> + ( ErrSq,CSubst,DataTagInfo,ErrSq,([HsName]),FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,([PP_Doc]),CBindL) + +-- DataFields -------------------------------------------------- + +-- semantic domain +type T_DataFields = ( Range,T_DataFields_1) +type T_DataFields_1 = UID -> + ( UID,T_DataFields_2) +type T_DataFields_2 = Polarity -> + PolGam -> + VarMp -> + TyGam -> + ( ([DataConFldAnnInfo]),FldTyL,VarMp,TyGam,T_DataFields_3) +type T_DataFields_3 = TyKiGam -> + ( TyKiGam,TyKiGam,T_DataFields_4) +type T_DataFields_4 = Ty -> + VarMp -> + ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,TyL,VarMp,T_DataFields_5) +type T_DataFields_5 = EvidKeyToCBindMap -> + PredScopeToCBindMap -> + ScopedPredStore -> + ClassDefaultGam -> + ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + Int -> + HsName -> + EHCOpts -> + VarMp -> + PredScope -> + RangeMp -> + ToSysfEnv -> + VarMp -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc,([PP_Doc])) + +-- Decl -------------------------------------------------------- + +-- semantic domain +type T_Decl = ( Range,T_Decl_1) +type T_Decl_1 = UID -> + TyGam -> + ( UID,TyGam,Bool,T_Decl_2) +type T_Decl_2 = KiGam -> + ( TyKiGam,T_Decl_3) +type T_Decl_3 = Int -> + Int -> + ( Int,T_Decl_4) +type T_Decl_4 = TyGam -> + TyKiGam -> + ( TyGam,T_Decl_5) +type T_Decl_5 = TyKiGam -> + TyGam -> + VarMp -> + ( TyKiGam,VarMp,T_Decl_6) +type T_Decl_6 = VarMp -> + PolGam -> + TyKiGam -> + ( VarMp,PolGam,T_Decl_7) +type T_Decl_7 = VarMp -> + (Maybe Polarity) -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyVarIdS -> + ( ([GenerDataInfo]),VarMp,VarMp,T_Decl_8) +type T_Decl_8 = ClGam -> + ( ClGam,T_Decl_9) +type T_Decl_9 = VarMp -> + TyKiGam -> + ClGam -> + TyVarIdS -> + ( ClGam,T_Decl_10) +type T_Decl_10 = ClGam -> + DataGam -> + ( DataGam,DataGam,ValGam,VarMp,T_Decl_11) +type T_Decl_11 = DataGam -> + ( (Seq.FastSeq (CHRClassDecl Pred RedHowAnnotation)),(Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),ClassDefaultGam,T_Decl_12) +type T_Decl_12 = VarMp -> + ValGam -> + VarMp -> + ValGam -> + VarMp -> + ( VarMp,ValGam,T_Decl_13) +type T_Decl_13 = ScopedPredStore -> + ClassDefaultGam -> + TyVarIdS -> + VarMp -> + ValGam -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decl_14) +type T_Decl_14 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + Bool -> + TyGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,CBindL,CBindL) + +-- Decls ------------------------------------------------------- + +-- semantic domain +type T_Decls = ( Range,T_Decls_1) +type T_Decls_1 = UID -> + TyGam -> + ( UID,TyGam,Bool,T_Decls_2) +type T_Decls_2 = KiGam -> + ( TyKiGam,T_Decls_3) +type T_Decls_3 = Int -> + Int -> + ( Int,T_Decls_4) +type T_Decls_4 = TyGam -> + TyKiGam -> + ( TyGam,T_Decls_5) +type T_Decls_5 = TyKiGam -> + TyGam -> + VarMp -> + ( TyKiGam,VarMp,T_Decls_6) +type T_Decls_6 = VarMp -> + PolGam -> + TyKiGam -> + ( VarMp,PolGam,T_Decls_7) +type T_Decls_7 = VarMp -> + (Maybe Polarity) -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyVarIdS -> + ( ([GenerDataInfo]),VarMp,VarMp,T_Decls_8) +type T_Decls_8 = ClGam -> + ( ClGam,T_Decls_9) +type T_Decls_9 = VarMp -> + TyKiGam -> + ClGam -> + TyVarIdS -> + ( ClGam,T_Decls_10) +type T_Decls_10 = ClGam -> + DataGam -> + ( DataGam,DataGam,ValGam,VarMp,T_Decls_11) +type T_Decls_11 = DataGam -> + ( (Seq.FastSeq (CHRClassDecl Pred RedHowAnnotation)),(Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),ClassDefaultGam,T_Decls_12) +type T_Decls_12 = VarMp -> + ValGam -> + VarMp -> + ValGam -> + VarMp -> + ( VarMp,ValGam,T_Decls_13) +type T_Decls_13 = ScopedPredStore -> + ClassDefaultGam -> + TyVarIdS -> + VarMp -> + ValGam -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decls_14) +type T_Decls_14 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + Bool -> + TyGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,CBindL,CBindL) + +-- Expr -------------------------------------------------------- + +-- semantic domain +type T_Expr = ( Range,T_Expr_1) +type T_Expr_1 = UID -> + ( UID,Bool,T_Expr_2) +type T_Expr_2 = Bool -> + KiGam -> + Int -> + Int -> + ( Int,T_Expr_3) +type T_Expr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,T_Expr_4) +type T_Expr_4 = ClGam -> + VarMp -> + TyKiGam -> + DataGam -> + TyVarIdS -> + ( DataGam,T_Expr_5) +type T_Expr_5 = DataGam -> + ( (Seq.FastSeq (CHRClassDecl Pred RedHowAnnotation)),FIIn,(Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),ClassDefaultGam,T_Expr_6) +type T_Expr_6 = ScopedPredStore -> + ClassDefaultGam -> + FIOpts -> + Ty -> + VarMp -> + TyVarIdS -> + VarMp -> + ValGam -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,ValGam,TyVarIdS,Ty,VarMp,T_Expr_7) +type T_Expr_7 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + ExprCtxt -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,([Coe]),([PP_Doc]),CExpr,HsName,PP_Doc,([(CBindCateg,CBindL)]),CSubst,UIDS,CExpr,ErrSq,([(CBindCateg,CBindL)]),(FieldUpdateL CExpr),ClGam,(Seq.Seq (HsName,IdOccKind)),KiGam,LamMp,ModEntRelFilterMp,PolGam,VarMp,TyGam,TyKiGam,Bool,([PP_Doc]),PP_Doc,CExpr,([(CBindCateg,CBindL)]),([(CBindCateg,CBindL)]),(Set.Set HsName),PP_Doc) + +-- ExprAnn ----------------------------------------------------- + +-- semantic domain +type T_ExprAnn = ( PP_Doc) + +-- FuncDep ----------------------------------------------------- + +-- semantic domain +type T_FuncDep = UID -> + ( UID,T_FuncDep_1) +type T_FuncDep_1 = TyGam -> + ( TyGam,T_FuncDep_2) +type T_FuncDep_2 = TyKiGam -> + ( TyKiGam,T_FuncDep_3) +type T_FuncDep_3 = TyL -> + VarMp -> + TyKiGam -> + VarMp -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,Range) + +-- FuncDeps ---------------------------------------------------- + +-- semantic domain +type T_FuncDeps = UID -> + ( UID,T_FuncDeps_1) +type T_FuncDeps_1 = TyGam -> + ( TyGam,T_FuncDeps_2) +type T_FuncDeps_2 = TyKiGam -> + ( TyKiGam,T_FuncDeps_3) +type T_FuncDeps_3 = TyL -> + VarMp -> + TyKiGam -> + VarMp -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,([PP_Doc]),Range) + +-- KiExpr ------------------------------------------------------ + +-- semantic domain +type T_KiExpr = ( Range,T_KiExpr_1) +type T_KiExpr_1 = UID -> + ( UID,T_KiExpr_2) +type T_KiExpr_2 = KiGam -> + ( Ty,KiGam,T_KiExpr_3) +type T_KiExpr_3 = VarMp -> + TyKiGam -> + VarMp -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,([PP_Doc]),HsName,PP_Doc,ErrSq,ModEntRelFilterMp,PP_Doc) + +-- KiExprAnn --------------------------------------------------- + +-- semantic domain +type T_KiExprAnn = ( PP_Doc) + +-- MbTyExpr ---------------------------------------------------- + +-- semantic domain +type T_MbTyExpr = ( Range,T_MbTyExpr_1) +type T_MbTyExpr_1 = UID -> + ( UID,T_MbTyExpr_2) +type T_MbTyExpr_2 = Polarity -> + PolGam -> + VarMp -> + TyGam -> + ( VarMp,(Maybe Ty),T_MbTyExpr_3) +type T_MbTyExpr_3 = VarMp -> + TyKiGam -> + ( TyKiGam,VarMp,T_MbTyExpr_4) +type T_MbTyExpr_4 = ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,(Maybe PP_Doc),TyGam,TyKiGam,TyVarWildMp) + +-- PatExpr ----------------------------------------------------- + +-- semantic domain +type T_PatExpr = ( Range,T_PatExpr_1) +type T_PatExpr_1 = UID -> + ( UID,T_PatExpr_2) +type T_PatExpr_2 = KiGam -> + Int -> + Int -> + ( Int,T_PatExpr_3) +type T_PatExpr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,TyGam,TyKiGam,T_PatExpr_4) +type T_PatExpr_4 = ClGam -> + DataGam -> + VarMp -> + TyKiGam -> + TyVarIdS -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),HsName,T_PatExpr_5) +type T_PatExpr_5 = ValGam -> + ( Int,(Maybe HsName),Ty,T_PatExpr_6) +type T_PatExpr_6 = FIOpts -> + Bool -> + Ty -> + TyL -> + VarMp -> + ValGam -> + ( VarMp,ValGam,T_PatExpr_7) +type T_PatExpr_7 = ScopedPredStore -> + ClassDefaultGam -> + VarMp -> + TyVarIdS -> + VarMp -> + TyVarIdS -> + ( RPatNm,CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_PatExpr_8) +type T_PatExpr_8 = CSubst -> + HsName -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + VarMp -> + ( ErrSq,([PP_Doc]),HsName,PP_Doc,CSubst,ErrSq,FieldSplitL,ModEntRelFilterMp,VarMp,Bool,CPatRest,PP_Doc,RPat,CBindL) + +-- PatExprAnn -------------------------------------------------- + +-- semantic domain +type T_PatExprAnn = ( PP_Doc) + +-- PrExpr ------------------------------------------------------ + +-- semantic domain +type T_PrExpr = ( Range,T_PrExpr_1) +type T_PrExpr_1 = UID -> + ( UID,T_PrExpr_2) +type T_PrExpr_2 = TyGam -> + ( Ty,Ty,TyGam,T_PrExpr_3) +type T_PrExpr_3 = Polarity -> + ( ([Polarity]),T_PrExpr_4) +type T_PrExpr_4 = PolGam -> + VarMp -> + ( VarMp,T_PrExpr_5) +type T_PrExpr_5 = TyKiGam -> + ( TyKiGam,TyKiGam,T_PrExpr_6) +type T_PrExpr_6 = VarMp -> + ( PolGam,Ty,VarMp,TyVarWildMp,T_PrExpr_7) +type T_PrExpr_7 = ClGam -> + ( Ty,T_PrExpr_8) +type T_PrExpr_8 = VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,Pred) + +-- PrExprs ----------------------------------------------------- + +-- semantic domain +type T_PrExprs = ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + UID -> + KiGam -> + VarMp -> + Polarity -> + HsName -> + EHCOpts -> + PolGam -> + VarMp -> + ToSysfEnv -> + TyGam -> + TyKiGam -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,HsNameS,HsNameS,ErrSq,UID,ModEntRelFilterMp,TyKiGam,VarMp,VarMp,PP_Doc,([PP_Doc]),([Pred]),Range,TyGam,TyKiGam,TyL,TyVarWildMp) + +-- RecExpr ----------------------------------------------------- + +-- semantic domain +type T_RecExpr = ( Range,T_RecExpr_1) +type T_RecExpr_1 = UID -> + ( UID,T_RecExpr_2) +type T_RecExpr_2 = KiGam -> + Int -> + Int -> + ( Int,T_RecExpr_3) +type T_RecExpr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,T_RecExpr_4) +type T_RecExpr_4 = ClGam -> + VarMp -> + TyKiGam -> + DataGam -> + TyVarIdS -> + ( DataGam,T_RecExpr_5) +type T_RecExpr_5 = DataGam -> + ([HsName]) -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),([HsName]),T_RecExpr_6) +type T_RecExpr_6 = ScopedPredStore -> + ClassDefaultGam -> + FIOpts -> + Ty -> + VarMp -> + TyVarIdS -> + VarMp -> + ValGam -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,TyVarIdS,VarMp,T_RecExpr_7) +type T_RecExpr_7 = CSubst -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + ( ErrSq,CSubst,ErrSq,HsName,(FieldUpdateL CExpr),ModEntRelFilterMp,VarMp,Bool,PP_Doc,([PP_Doc]),CExpr,Ty) + +-- RecPatExpr -------------------------------------------------- + +-- semantic domain +type T_RecPatExpr = ( Range,T_RecPatExpr_1) +type T_RecPatExpr_1 = UID -> + ( UID,T_RecPatExpr_2) +type T_RecPatExpr_2 = KiGam -> + Int -> + Int -> + ( Int,T_RecPatExpr_3) +type T_RecPatExpr_3 = VarMp -> + EHCOpts -> + PolGam -> + VarMp -> + PredScope -> + TyGam -> + TyKiGam -> + TyVarIdS -> + ( VarMp,VarMp,TyGam,TyKiGam,T_RecPatExpr_4) +type T_RecPatExpr_4 = ClGam -> + DataGam -> + VarMp -> + TyKiGam -> + ([HsName]) -> + TyVarIdS -> + ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),Bool,([HsName]),T_RecPatExpr_5) +type T_RecPatExpr_5 = FIOpts -> + Ty -> + Bool -> + VarMp -> + ValGam -> + ValGam -> + ( VarMp,ValGam,T_RecPatExpr_6) +type T_RecPatExpr_6 = ScopedPredStore -> + ClassDefaultGam -> + VarMp -> + TyVarIdS -> + VarMp -> + TyVarIdS -> + ( CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_RecPatExpr_7) +type T_RecPatExpr_7 = CSubst -> + HsName -> + EvidKeyToCBindMap -> + PredScopeToCBindMap -> + VarMp -> + ValGam -> + HsName -> + RangeMp -> + ToSysfEnv -> + VarMp -> + ( ErrSq,CSubst,ErrSq,HsName,FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,([PP_Doc]),CBindL) + +-- RowTyExpr --------------------------------------------------- + +-- semantic domain +type T_RowTyExpr = ( Range,T_RowTyExpr_1) +type T_RowTyExpr_1 = UID -> + ([HsName]) -> + ( UID,([HsName]),T_RowTyExpr_2) +type T_RowTyExpr_2 = TyGam -> + ( TyGam,Ty,T_RowTyExpr_3) +type T_RowTyExpr_3 = Polarity -> + PolGam -> + VarMp -> + ( VarMp,T_RowTyExpr_4) +type T_RowTyExpr_4 = TyKiGam -> + ( TyKiGam,TyKiGam,T_RowTyExpr_5) +type T_RowTyExpr_5 = VarMp -> + ( VarMp,TyVarWildMp,T_RowTyExpr_6) +type T_RowTyExpr_6 = ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,HsNameS,HsNameS,ErrSq,HsName,ModEntRelFilterMp,PP_Doc,([PP_Doc])) + +-- TyExpr ------------------------------------------------------ + +-- semantic domain +type T_TyExpr = ( Range,T_TyExpr_1) +type T_TyExpr_1 = UID -> + ( UID,T_TyExpr_2) +type T_TyExpr_2 = TyGam -> + ( Ty,TyGam,T_TyExpr_3) +type T_TyExpr_3 = Polarity -> + ( ([Polarity]),T_TyExpr_4) +type T_TyExpr_4 = PolGam -> + VarMp -> + ( (Maybe Strictness),VarMp,T_TyExpr_5) +type T_TyExpr_5 = TyKiGam -> + ( TyKiGam,TyKiGam,T_TyExpr_6) +type T_TyExpr_6 = VarMp -> + ( PolGam,Ty,VarMp,Polarity,TyVarWildMp,T_TyExpr_7) +type T_TyExpr_7 = ClGam -> + ( Ty,T_TyExpr_8) +type T_TyExpr_8 = VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,([PP_Doc]),HsName,PP_Doc,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,TyL) + +-- TyExprAnn --------------------------------------------------- + +-- semantic domain +type T_TyExprAnn = ( TyAnn,Bool,(Maybe Strictness),PP_Doc) + +-- TyExprs ----------------------------------------------------- + +-- semantic domain +type T_TyExprs = ( Range,T_TyExprs_1) +type T_TyExprs_1 = UID -> + ( UID,T_TyExprs_2) +type T_TyExprs_2 = TyGam -> + ( ([Polarity]),TyGam,TyL,T_TyExprs_3) +type T_TyExprs_3 = PolGam -> + VarMp -> + ( VarMp,T_TyExprs_4) +type T_TyExprs_4 = TyKiGam -> + ( TyKiGam,TyKiGam,T_TyExprs_5) +type T_TyExprs_5 = VarMp -> + ( PolGam,TyL,VarMp,TyVarWildMp,T_TyExprs_6) +type T_TyExprs_6 = ClGam -> + VarMp -> + TyKiGam -> + VarMp -> + KiGam -> + Polarity -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,([PP_Doc])) + +-- TyVar ------------------------------------------------------- + +-- semantic domain +type T_TyVar = ( Range,T_TyVar_1) +type T_TyVar_1 = UID -> + ( UID,T_TyVar_2) +type T_TyVar_2 = TyGam -> + ( TyGam,T_TyVar_3) +type T_TyVar_3 = TyKiGam -> + ( PolGam,TyKiGam,Ty,([Polarity]),Ty,TyKiGam,T_TyVar_4) +type T_TyVar_4 = VarMp -> + TyKiGam -> + VarMp -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,ModEntRelFilterMp,HsName,PP_Doc) + +-- TyVars ------------------------------------------------------ + +-- semantic domain +type T_TyVars = ( Range,T_TyVars_1) +type T_TyVars_1 = UID -> + ( UID,T_TyVars_2) +type T_TyVars_2 = TyGam -> + ( TyGam,T_TyVars_3) +type T_TyVars_3 = TyKiGam -> + ( PolGam,TyKiGam,TyL,([Polarity]),TyKiGam,TyL,T_TyVars_4) +type T_TyVars_4 = VarMp -> + TyKiGam -> + VarMp -> + HsName -> + EHCOpts -> + ToSysfEnv -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + TyVarIdS -> + ( ErrSq,ErrSq,ModEntRelFilterMp,([HsName]),PP_Doc,([PP_Doc])) + diff --git a/src/UHC/Light/Compiler/EH/Parser.hs b/src/UHC/Light/Compiler/EH/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EH/Parser.hs @@ -0,0 +1,375 @@ +module UHC.Light.Compiler.EH.Parser +( pAGItf ) +where +import System.IO +import UU.Parsing +import UU.Parsing.Offside +import UHC.Util.ParseUtils +import UU.Scanner.GenToken +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.EH +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import UHC.Light.Compiler.Foreign.Parser +import UHC.Light.Compiler.Foreign + + + + +{-# LINE 30 "src/ehc/EH/Parser.chs" #-} +type EHCParser ep = LayoutParser Token ep + +pAGItf :: EHCParser AGItf + +pExpr, pExprApp, pExprBase :: EHCParser Expr +pExprPrefix :: EHCParser (Expr -> Expr) + +pDecls :: EHCParser Decls +pDecl :: EHCParser Decl + +pPatExpr, pPatExprBase :: EHCParser PatExpr + +pTyExpr, pTyExprBase :: EHCParser TyExpr + +pInt :: EHCParser Int +pChr :: EHCParser Char + +pCon :: EHCParser HsName +pVar :: EHCParser HsName + +{-# LINE 52 "src/ehc/EH/Parser.chs" #-} +pTyExprPrefix :: EHCParser (TyExpr -> TyExpr) + +{-# LINE 56 "src/ehc/EH/Parser.chs" #-} +pTyExprApp :: EHCParser TyExpr + +{-# LINE 60 "src/ehc/EH/Parser.chs" #-} +pCaseAlts :: EHCParser CaseAlts +pCaseAlt :: EHCParser CaseAlt + +pDataConstr :: EHCParser DataConstr +pDataConstrs :: EHCParser DataConstrs + +pTyVars :: EHCParser TyVars +pTyVar :: EHCParser TyVar + +{-# LINE 71 "src/ehc/EH/Parser.chs" #-} +pDataLabFields :: EHCParser DataFields +pDataFields :: EHCParser DataFields +pDataLabField :: EHCParser DataField +pDataField :: EHCParser DataField + +{-# LINE 82 "src/ehc/EH/Parser.chs" #-} +pApp :: AppLike a boundmeta => EHCParser a -> EHCParser a +pApp p = appTopApp <$> pList1 p + +{-# LINE 99 "src/ehc/EH/Parser.chs" #-} +pChr = head <$> pChar +pInt = read <$> pInteger +pCon = hsnFromString <$> pConid +pVar = hsnFromString <$> pVarid + +{-# LINE 110 "src/ehc/EH/Parser.chs" #-} +pAGItf = AGItf_AGItf <$> pExpr + +{-# LINE 118 "src/ehc/EH/Parser.chs" #-} +pDecls = foldr (:) [] <$> pBlock pOCurly pSemi pCCurly pDecl +pDecl = mkEH Decl_Val <$> pPatExprBase <* pEQUAL <*> pExpr + <|> mkEH Decl_TySig <$> pVar <* pDCOLON <*> pTyExpr +{-# LINE 123 "src/ehc/EH/Parser.chs" #-} + <|> (\c tvs cons -> mkEH Decl_Data False c tvs cons Nothing) + <$ pDATA <*> pCon <*> pTyVars + <* pEQUAL <*> pDataConstrs +{-# LINE 132 "src/ehc/EH/Parser.chs" #-} + <|> mkEH Decl_KiSig <$> pCon <* pDCOLON <*> pKiExpr +{-# LINE 135 "src/ehc/EH/Parser.chs" #-} + <|> (\(conv,_) saf imp nm sig + -> mkEH Decl_FFI conv saf + ( + (\i -> fst $ parseForeignEnt ForeignDirection_Import conv Nothing i) + (if null imp then show nm else imp)) + nm sig + ) + <$ pFOREIGN <* pIMPORT <*> pFFIWay + <*> (pV ( pSAFE + <|> pUNSAFE + ) `opt` "safe") + <*> (pString `opt` "") + <*> pVar + <* pDCOLON <*> pTyExpr +{-# LINE 155 "src/ehc/EH/Parser.chs" #-} + <|> pDeclClass + <|> pDeclInstance +{-# LINE 159 "src/ehc/EH/Parser.chs" #-} + <|> mkEH Decl_Type <$ pTYPE <*> pCon + <* pEQUAL <*> pTyExpr +{-# LINE 172 "src/ehc/EH/Parser.chs" #-} +pPatExprBase = pVar <**> ( flip (mkEH PatExpr_VarAs) <$ pAT <*> pPatExprBase + <|> pSucceed (mkEH PatExpr_Var) + ) + <|> mkEH PatExpr_Con <$> pCon + <|> mkEH PatExpr_IConst <$> pInt + <|> mkEH PatExpr_CConst <$> pChr +{-# LINE 183 "src/ehc/EH/Parser.chs" #-} + <|> pParenRow True (show hsnORec) (show hsnCRec) "=" Nothing + (mkEH RecPatExpr_Empty,mkEH RecPatExpr_Expr . mkEH PatExpr_Var,mkEH RecPatExpr_Ext,mkEH PatExpr_Rec,mkEH PatExpr_Parens) + pSel pPatExpr + +{-# LINE 189 "src/ehc/EH/Parser.chs" #-} +pPatExpr = pApp pPatExprBase +{-# LINE 192 "src/ehc/EH/Parser.chs" #-} + (mkEH PatExpr_TypeAs <$ pDCOLON <*> pTyExpr) + +{-# LINE 200 "src/ehc/EH/Parser.chs" #-} +pKiExpr, pKiExprBase :: EHCParser KiExpr + +pKiExprBase = mkEH KiExpr_Con <$> (pCon <|> pHNm pSTAR) + <|> mkEH KiExpr_Var <$> pVar + <|> pParens pKiExpr +pKiExpr = pChainr (app1Arr <$ pKeyw hsnArrow) pKiExprBase + +{-# LINE 213 "src/ehc/EH/Parser.chs" #-} +pTyExprBase = mkEH TyExpr_Con <$> pCon +{-# LINE 216 "src/ehc/EH/Parser.chs" #-} + <|> mkEH TyExpr_Wild <$ pTDOT +{-# LINE 219 "src/ehc/EH/Parser.chs" #-} + <|> mkEH TyExpr_Var <$> pVar + <|> mkEH TyExpr_VarWild <$ pPERCENT <*> pVar +{-# LINE 226 "src/ehc/EH/Parser.chs" #-} + <|> pParenRow False (show hsnORow) (show hsnCRow) "::" Nothing + (mkEH RowTyExpr_Empty,semVar,mkEH RowTyExpr_Ext,mkEH TyExpr_Row,id) + pVar pTyExpr + <|> pParenRow True (show hsnORec) (show hsnCRec) "::" Nothing + (mkEH RowTyExpr_Empty,semVar,mkEH RowTyExpr_Ext + ,\r -> appConApp hsnRec [mkEH TyExpr_Row r] + ,mkEH TyExpr_Parens) + pVar pTyExpr + <|> pParenRow False (show hsnOSum) (show hsnCSum) "::" Nothing + (mkEH RowTyExpr_Empty,semVar,mkEH RowTyExpr_Ext + ,\r -> appConApp hsnSum [mkEH TyExpr_Row r] + ,id) + pVar pTyExpr +{-# LINE 244 "src/ehc/EH/Parser.chs" #-} + where semVar = (mkEH RowTyExpr_Var) + +{-# LINE 253 "src/ehc/EH/Parser.chs" #-} +pTyExpr = pTyExprPrefix <*> pTyExpr + <|> pTyExprApp (flip app1Arr <$ pKeyw hsnArrow <*> pTyExpr) + +{-# LINE 258 "src/ehc/EH/Parser.chs" #-} +pTyExprs :: EHCParser TyExprs +pTyExprs = pList pTyExprBase + +{-# LINE 263 "src/ehc/EH/Parser.chs" #-} +pTyExprPrefix = mkEH TyExpr_Quant + <$> (tyQu_Forall <$ pKey "forall" <|> tyQu_Exists <$ pKey "exists") + <*> pVar <* pKey "." +{-# LINE 268 "src/ehc/EH/Parser.chs" #-} + <|> pTyPrExprPrefix +{-# LINE 271 "src/ehc/EH/Parser.chs" #-} + <|> mkEH TyExpr_Lam <$ pLAM <*> pVar <* pRARROW + +{-# LINE 275 "src/ehc/EH/Parser.chs" #-} +pTyPrExprPrefix :: EHCParser (TyExpr -> TyExpr) +pTyPrExprPrefix = app1Arr + <$> pPackImpl + ( pPr <|> pIm + <|> pSucceed (mkEH TyExpr_NoImpls) + ) + <* pKeyw hsnArrow + <|> ( app1Arr <$> (pPrB <|> pIm) + <|> flip (foldr app1Arr) + <$> pParens ((:) <$> pPr <*> (pImO <|> (++) <$> pList1 (pComma *> pPr) <*> pImO)) + ) + <* pKeyw hsnPrArrow + where pPrB = mkEH TyExpr_Pred <$> pPrExprBase + pPr :: EHCParser TyExpr + pPr = mkEH TyExpr_Pred <$> pPrExpr + pIm :: EHCParser TyExpr + pIm = mkEH TyExpr_Impls <$ pKey "..." + pImO = (:[]) <$ pComma <*> pIm `opt` [] + +{-# LINE 299 "src/ehc/EH/Parser.chs" #-} +pTyExprApp = pApp pTyExprBase + +{-# LINE 303 "src/ehc/EH/Parser.chs" #-} +pPackImpl :: IsParser p Token => p v -> p v +pPackImpl = pPacked pOIMPL pCIMPL + +{-# LINE 313 "src/ehc/EH/Parser.chs" #-} +pExprBase = mkEH Expr_IConst <$> pInt + <|> mkEH Expr_CConst <$> pChr + <|> mkEH Expr_Var <$> pVar + <|> mkEH Expr_Con <$> pCon +{-# LINE 322 "src/ehc/EH/Parser.chs" #-} + <|> (\e a -> mkEH Expr_Case e a Nothing Set.empty False) + <$ pKey "case" <*> pExpr <* pKey "of" <*> pCaseAlts +{-# LINE 330 "src/ehc/EH/Parser.chs" #-} + <|> pParenRow True (show hsnORec) (show hsnCRec) "=" (Just (":=",mkEH RecExpr_Upd)) + (mkEH RecExpr_Empty,mkEH RecExpr_Expr . mkEH Expr_Var,mkEH RecExpr_Ext,mkEH Expr_Rec,appPar) + pVar pExpr +{-# LINE 335 "src/ehc/EH/Parser.chs" #-} + <|> mkEH Expr_Undefined <$ pKey "..." +{-# LINE 338 "src/ehc/EH/Parser.chs" #-} + <|> mkEH Expr_DynVar <$> pDynVar + +{-# LINE 343 "src/ehc/EH/Parser.chs" #-} +pExpr = pE (mkEH Expr_TypeAs False <$ pKey "::" <*> pTyExpr) + where pE = pExprPrefix <*> pE + <|> pExprApp + +{-# LINE 352 "src/ehc/EH/Parser.chs" #-} +pExprApp = pE ((\l e -> appTop (foldl (flip ($)) e l)) <$> pList1 pA) +{-# LINE 358 "src/ehc/EH/Parser.chs" #-} + where pA = flip app1App <$> pE <|> pImpred <|> pImpl +{-# LINE 364 "src/ehc/EH/Parser.chs" #-} + pImpred = (flip (mkEH Expr_AppImpred)) <$ pKey "~" <*> pE +{-# LINE 367 "src/ehc/EH/Parser.chs" #-} + pE = pExprBase <**> pExprSelSuffix +{-# LINE 370 "src/ehc/EH/Parser.chs" #-} + pImpl = pPackImpl ((\a p e -> mkEH Expr_AppImpl e p a) <$> pExpr <* pKey "<:" <*> pPrExpr) + +{-# LINE 374 "src/ehc/EH/Parser.chs" #-} +pExprPrefix = mkEH Expr_Let <$ pLET + <*> pMaybe False (const True) pBANG + <*> pDecls <* pIN +{-# LINE 381 "src/ehc/EH/Parser.chs" #-} + <|> (\c t e -> mkEH Expr_Case c + [ mkEH CaseAlt_Pat (mkEH PatExpr_Con hsnTrue) t + , mkEH CaseAlt_Pat (mkEH PatExpr_Con hsnFalse) e + ] + Nothing Set.empty False + ) + <$ pIF <*> pExpr <* pTHEN <*> pExpr <* pELSE +{-# LINE 400 "src/ehc/EH/Parser.chs" #-} + <|> (flip (foldr ($))) + <$ pKey "\\" + <*> pList1 ( mkEH Expr_Lam <$> pPatExprBase + <|> pPackImpl (flip (mkEH Expr_LamImpl) <$> pPatExpr <* pKey "<:" <*> pPrExpr) + ) + <* pKey "->" + +{-# LINE 420 "src/ehc/EH/Parser.chs" #-} +pDataConstr = (\c -> mkEH DataConstr_Constr c Nothing) + <$> pCon <*> (pDataFields <|> pCurly pDataLabFields) + <*> pSucceed Nothing +{-# LINE 437 "src/ehc/EH/Parser.chs" #-} +pDataConstrs = pListSep (pKey "|") pDataConstr + +{-# LINE 441 "src/ehc/EH/Parser.chs" #-} +pDataField = mkEH DataField_Field Nothing <$> pTyExprBase +pDataLabField = mkEH DataField_Field <$> (Just <$> pList1Sep pComma pVar) <* pKey "::" <*> pTyExpr +pDataFields = pList pDataField +pDataLabFields = pList1Sep pComma pDataLabField + +{-# LINE 450 "src/ehc/EH/Parser.chs" #-} +pCaseAlts = foldr (:) [] + <$> pBlock1 pOCurly pSemi pCCurly pCaseAlt +pCaseAlt = mkEH CaseAlt_Pat <$> pPatExpr <* pKey "->" <*> pExpr + +pTyVars = pList pTyVar +pTyVar = mkEH TyVar_Var <$> pVar + +{-# LINE 459 "src/ehc/EH/Parser.chs" #-} +pTyVars1 :: EHCParser TyVars +pTyVars1 = pList1 pTyVar + +{-# LINE 468 "src/ehc/EH/Parser.chs" #-} +data RowFld a = FldSel HsName a | FldNoSel a | FldUpd HsName a + +pParenRow :: Bool -> String -> String -> String -> Maybe (String,r -> HsName -> e -> r) + -> (r,HsName -> r,r -> Maybe HsName -> e -> r,r -> e,e -> e) + -> EHCParser HsName -> EHCParser e -> EHCParser e + +pParenRow singleAsIs o c sep mbUpd (semEmpty,semVar,semExt,semRow,semParens) pSel pE + = pKey o *> pRowFlds <* pKey c + where pFld = ((pSel <**> pSep) <|> pSucceed FldNoSel) <*> pE + pFlds = pListSep pComma pFld + pExtFlds = mkE <$> (pRowNested <|> semVar <$> pVar) <* pKey "|" <*> pFlds + pFldsOrExt = mkE semEmpty <$> pFlds <|> pExtFlds + pRowNested = pKey o *> pFldsOrExt <* pKey c + pRowFlds = if singleAsIs + then pFld <**> ( (\fs f -> mkR (f:fs)) <$ pComma <*> pFlds + <|> pSucceed (\le -> case le of {FldNoSel e -> semParens e; _ -> mkR [le]}) + ) + <|> semRow <$> pExtFlds + <|> pSucceed (mkR []) + else semRow <$> pFldsOrExt + mkR fs = semRow (mkE semEmpty fs ) + mkE ext fs = foldl (\r f -> case f of + FldSel l e -> semExt r (Just l) e + FldNoSel e -> semExt r Nothing e + FldUpd l e -> semUpd r l e + ) ext fs + (pSep,semUpd) = case mbUpd of + Just (sepUpd,sem) -> (FldSel <$ pKey sep <|> FldUpd <$ pKey sepUpd,sem) + Nothing -> (FldSel <$ pKey sep,\r _ _ -> r) + +{-# LINE 500 "src/ehc/EH/Parser.chs" #-} +pExprSelSuffix :: EHCParser (Expr -> Expr) +pExprSelSuffix = (\lbls e -> foldl (mkEH Expr_Sel) e lbls) + <$> pList (pHASH *> pSel) + +pSel :: EHCParser HsName +pSel = pVar <|> pCon <|> mkHNmPos <$> pInt + +{-# LINE 513 "src/ehc/EH/Parser.chs" #-} +pPrExprClass :: EHCParser PrExpr +pPrExprClass = mkEH PrExpr_Class <$> pCon <*> pTyExprs + +{-# LINE 518 "src/ehc/EH/Parser.chs" #-} +pPrExprPrefix :: EHCParser (PrExpr -> PrExpr) +pPrExprPrefix = mkEH PrExpr_Arrow <$> pPrExprBase <* pKeyw hsnPrArrow + <|> mkEH PrExpr_Forall <$ pKey "forall" <*> pVar <* pKey "." + +{-# LINE 524 "src/ehc/EH/Parser.chs" #-} +pPrExpr :: EHCParser PrExpr +pPrExpr = pPrExprPrefix <*> pPrExpr + <|> pPrExprBase + +{-# LINE 530 "src/ehc/EH/Parser.chs" #-} +pTyPrExpr :: EHCParser TyExpr +pTyPrExpr = pTyPrExprPrefix <*> pTyPrExpr + <|> mkEH TyExpr_Pred <$> pPrExprBase + +{-# LINE 536 "src/ehc/EH/Parser.chs" #-} +pPrExprBase :: EHCParser PrExpr +pPrExprBase = pPrExprClass + <|> pParens pPrExpr +{-# LINE 541 "src/ehc/EH/Parser.chs" #-} + <|> mkEH PrExpr_DynVar <$> pDynVar <* pKey "::" <*> pTyExpr + <|> pVar <**> ( (\s v -> mkEH PrExpr_Lacks (mkEH RowTyExpr_Var v) s) + <$ pKey "\\" <*> pSel +{-# LINE 550 "src/ehc/EH/Parser.chs" #-} + ) + +{-# LINE 558 "src/ehc/EH/Parser.chs" #-} +pClassHead :: EHCParser TyExpr +pClassHead = pTyPrExprPrefix <*> pHd <|> pHd + where pHd = mkEH TyExpr_Pred <$> pPrExprClass + +pDeclClass :: EHCParser Decl +pDeclClass = (\h deps d -> mkEH Decl_Class h deps Nothing d []) + <$ pKey "class" + <*> pClassHead + <*> (pKey "|" *> pListSep pComma (mkEH FuncDep_Dep <$> pTyVars1 <* pKey "->" <*> pTyVars1) + `opt` [] + ) + <* pKey "where" <*> pDecls + +pDeclInstance :: EHCParser Decl +pDeclInstance = pKey "instance" + *> ( (\n h d -> mkEH Decl_Instance n InstNormal h d) + <$> ((\n e -> Just (n,e)) <$> pVar <*> (True <$ pKey "<:" <|> False <$ pKey "::") `opt` Nothing) + <*> pClassHead + <* pKey "where" <*> pDecls + <|> mkEH Decl_InstanceIntro Nothing <$> pExpr <* pKey "<:" <*> pPrExprClass + ) + +{-# LINE 594 "src/ehc/EH/Parser.chs" #-} +pDynVar :: EHCParser HsName +pDynVar = pKeyw hsnDynVar *> pVar + diff --git a/src/UHC/Light/Compiler/EHC/Common.hs b/src/UHC/Light/Compiler/EHC/Common.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/Common.hs @@ -0,0 +1,222 @@ +module UHC.Light.Compiler.EHC.Common +( module Data.Maybe, module Data.List, module Data.Char +, module System.IO +, module UHC.Util.CompileRun, module UHC.Util.Pretty, module UHC.Util.FPath, module UHC.Util.Utils +, module UHC.Light.Compiler.Base.Common, module UHC.Light.Compiler.Base.HsName.Builtin, module UHC.Light.Compiler.Opts +, module UHC.Light.Compiler.Error, module UHC.Light.Compiler.Error.Pretty +, module UHC.Light.Compiler.Gam.Full +, HSState (..) +, EHState (..) +, CRState (..) +, EHCompileUnitState (..) +, ecuStateFinalDestination +, ecuStateIsCore +, EHCompileUnitKind (..) +, ecuStateToKind +, FinalCompileHow (..) +, mkShellCmd, mkShellCmd', showShellCmd +, mkInOrOutputFPathDirFor +, mkInOrOutputFPathFor +, mkOutputFPath +, mkPerModuleOutputFPath +, mkPerExecOutputFPath +, hsstateIsLiteral +, hsstateShowLit +, hsstateNext +, CState (..), OState (..) ) +where +import Data.List +import Data.Char +import Data.Maybe +import Control.Monad.State +import System.IO +import UHC.Util.CompileRun +import UHC.Util.Pretty +import UHC.Util.FPath +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Opts.CommandLine +import UHC.Util.Time +import System.Directory + + + + +{-# LINE 35 "src/ehc/EHC/Common.chs" #-} +-- dummy, so module is not empty for initial variants, and exports will take effect + +{-# LINE 45 "src/ehc/EHC/Common.chs" #-} +data HSState + = HSStart -- starting from .hs + | HSAllSem -- done all semantics for .hs + | HMOnlyMinimal -- done minimal info only + -- | HMStart -- starting from nothing, not using .hi info nor .hs file, just for linking etc + | HSOnlyImports -- done imports from .hs + | HIStart -- starting from .hi + | HIAllSem -- done all semantics for .hi + | HIOnlyImports -- done imports from .hi + | LHSStart -- starting from .lhs + | LHSOnlyImports -- done imports from .lhs + deriving (Show,Eq) + +{-# LINE 66 "src/ehc/EHC/Common.chs" #-} +hsstateIsLiteral :: HSState -> Bool +hsstateIsLiteral LHSStart = True +hsstateIsLiteral LHSOnlyImports = True +hsstateIsLiteral _ = False + +{-# LINE 75 "src/ehc/EHC/Common.chs" #-} +hsstateShowLit :: HSState -> String +hsstateShowLit LHSStart = "Literal" +hsstateShowLit LHSOnlyImports = "Literal" +hsstateShowLit _ = "" + +{-# LINE 86 "src/ehc/EHC/Common.chs" #-} +hsstateNext :: HSState -> HSState +hsstateNext HSStart = HSOnlyImports +hsstateNext HIStart = HIOnlyImports +-- hsstateNext HMStart = HMOnlyMinimal +hsstateNext LHSStart = LHSOnlyImports +hsstateNext st = st + +{-# LINE 99 "src/ehc/EHC/Common.chs" #-} +data EHState + = EHStart + | EHAllSem + deriving (Show,Eq) + +{-# LINE 108 "src/ehc/EHC/Common.chs" #-} +-- | State for .c files +data CState + = CStart + | CAllSem + deriving (Show,Eq) + +-- | State for .o files +data OState + = OStart + | OAllSem + deriving (Show,Eq) + +{-# LINE 124 "src/ehc/EHC/Common.chs" #-} +data CRState + = CRStartText + | CRStartBinary + | CROnlyImports + | CRAllSem + deriving (Show,Eq) + +{-# LINE 135 "src/ehc/EHC/Common.chs" #-} +data EHCompileUnitState + = ECUS_Unknown + | ECUS_Haskell !HSState + | ECUS_Eh !EHState + | ECUS_C !CState + | ECUS_O !OState + | ECUS_Core !CRState + | ECUS_Grin + | ECUS_Fail + deriving (Show,Eq) + +{-# LINE 152 "src/ehc/EHC/Common.chs" #-} +-- | The final state +ecuStateFinalDestination :: (EHCompileUnitState -> EHCompileUnitState) -> EHCompileUnitState -> EHCompileUnitState +ecuStateFinalDestination postModf + = postModf . n + where n (ECUS_Haskell _) = ECUS_Haskell HSAllSem + n (ECUS_Eh _) = ECUS_Eh EHAllSem + n (ECUS_C _) = ECUS_C CAllSem + n (ECUS_O _) = ECUS_O OAllSem + n (ECUS_Core _) = ECUS_Core CRAllSem + n _ = ECUS_Fail + +{-# LINE 169 "src/ehc/EHC/Common.chs" #-} +-- | Is compilation from Core source +ecuStateIsCore :: EHCompileUnitState -> Bool +ecuStateIsCore st = case st of + ECUS_Core _ -> True + _ -> False + +{-# LINE 183 "src/ehc/EHC/Common.chs" #-} +data EHCompileUnitKind + = EHCUKind_HS -- Haskell: .hs .lhs .hi + | EHCUKind_C -- C: .c + | EHCUKind_None -- Nothing + deriving Eq + +{-# LINE 193 "src/ehc/EHC/Common.chs" #-} +ecuStateToKind :: EHCompileUnitState -> EHCompileUnitKind +ecuStateToKind s + = case s of + ECUS_Haskell _ -> EHCUKind_HS + ECUS_C _ -> EHCUKind_C + _ -> EHCUKind_None + +{-# LINE 208 "src/ehc/EHC/Common.chs" #-} +data FinalCompileHow + = FinalCompile_Module + | FinalCompile_Exec + +{-# LINE 218 "src/ehc/EHC/Common.chs" #-} +mkShellCmd' :: [Cmd] -> FilePath -> CmdLineOpts -> (FilePath,[String]) +mkShellCmd' forCmds cmdStr o = (cmdStr, showCmdLineOpts' forCmds o) + +mkShellCmd :: [String] -> (FilePath,[String]) +mkShellCmd (cmd:args) = (cmd,args) + +showShellCmd :: (FilePath,[String]) -> String +showShellCmd (cmd,args) = concat $ intersperse " " $ [cmd] ++ args + +{-# LINE 233 "src/ehc/EHC/Common.chs" #-} +mkInOrOutputFPathDirFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> (FPath,Maybe String) +mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix + = (fpathSetSuff suffix fp', d) + where (fp',d) = case inoutputfor of + OutputFor_Module -> f ehcOptOutputDir + OutputFor_Pkg -> f ehcOptOutputDir -- ehcOptOutputPkgLibDir + InputFrom_Loc l + | filelocIsPkg l -> f (const Nothing) + | otherwise -> f ehcOptOutputDir + f g = case g opts of + Just d -> ( fpathPrependDir d' + $ fpathSetBase (fpathBase fp) -- ensure possibly adapted name in filesys is used + $ mkFPath modNm -- includes module hierarchy into filename + , Just d' + ) + where d' = filePathUnPrefix d + _ -> (fp,Nothing) + +{-# LINE 258 "src/ehc/EHC/Common.chs" #-} +mkInOrOutputFPathFor :: FPATH nm => InOrOutputFor -> EHCOpts -> nm -> FPath -> String -> FPath +mkInOrOutputFPathFor inoutputfor opts modNm fp suffix + = fst $ mkInOrOutputFPathDirFor inoutputfor opts modNm fp suffix + +{-# LINE 264 "src/ehc/EHC/Common.chs" #-} +mkOutputFPath :: FPATH nm => EHCOpts -> nm -> FPath -> String -> FPath +mkOutputFPath = mkInOrOutputFPathFor OutputFor_Module + +{-# LINE 273 "src/ehc/EHC/Common.chs" #-} +-- | FPath for per module output +mkPerModuleOutputFPath :: EHCOpts -> Bool -> HsName -> FPath -> String -> FPath +mkPerModuleOutputFPath opts doSepBy_ modNm fp suffix + = fpO modNm fp + where fpO m f= case ehcOptPkgOpt opts of + Just _ -> nm_ + _ | doSepBy_ -> nm_ + | otherwise -> mkOutputFPath opts m f suffix + where nm_ = mkOutputFPath opts (hsnMapQualified (const base) m) (fpathSetBase base f) suffix + where base = hsnShow "_" "_" m + +{-# LINE 290 "src/ehc/EHC/Common.chs" #-} +-- | FPath for final executable, with possible suffix (and forcing flag, even on given exec) +mkPerExecOutputFPath :: EHCOpts -> HsName -> FPath -> Maybe (String, Bool) -> FPath +mkPerExecOutputFPath opts modNm fp mbSuffix + = maybe id (\(s,force) -> if force then fpathSetSuff s else id) mbSuffix fpExec + where fpExecBasedOnSrc = maybe (mkOutputFPath opts modNm fp "") (\(s,_) -> mkOutputFPath opts modNm fp s) mbSuffix + fpExec = maybe fpExecBasedOnSrc id (ehcOptMbOutputFile opts) + diff --git a/src/UHC/Light/Compiler/EHC/CompileGroup.hs b/src/UHC/Light/Compiler/EHC/CompileGroup.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompileGroup.hs @@ -0,0 +1,20 @@ +module UHC.Light.Compiler.EHC.CompileGroup +( EHCompileGroup (..), emptyECG ) +where +import UHC.Light.Compiler.EHC.Common + +{-# LINE 21 "src/ehc/EHC/CompileGroup.chs" #-} +data EHCompileGroup + = EHCompileGroup + { ecgNm :: HsName + , ecgModL :: [HsName] + } + +emptyECG :: EHCompileGroup +emptyECG + = EHCompileGroup + { ecgNm = hsnUnknown + , ecgModL = [] + } + + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Cleanup.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Cleanup.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Cleanup.hs @@ -0,0 +1,72 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Cleanup +( cpCleanupHSMod, cpCleanupHS, cpCleanupFoldEH, cpCleanupEH +, cpCleanupCore +, cpCleanupCU, cpCleanupFlow ) +where +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import Control.Monad.State + +{-# LINE 33 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-} +cpCleanupHSMod :: HsName -> EHCompilePhase () +cpCleanupHSMod modNm + = cpUpdCU modNm + (\e -> e { ecuMbHSSemMod = Nothing + } + ) + +cpCleanupHS :: HsName -> EHCompilePhase () +cpCleanupHS modNm + = cpUpdCU modNm + (\e -> e { ecuMbHS = Nothing + , ecuMbHSSem = Nothing + } + ) + +cpCleanupFoldEH :: HsName -> EHCompilePhase () +cpCleanupFoldEH modNm + = cpUpdCU modNm + (\e -> e { ecuMbEH = Nothing + } + ) + +cpCleanupEH :: HsName -> EHCompilePhase () +cpCleanupEH modNm + = cpUpdCU modNm + (\e -> e { ecuMbEHSem = Nothing + } + ) + +{-# LINE 64 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-} +cpCleanupCore :: [HsName] -> EHCompilePhase () +cpCleanupCore modNmL + = cpSeq [cl m | m <- modNmL] + where cl m = cpUpdCU m + (\e -> e { ecuMbCore = Nothing + , ecuMbCoreSem = Nothing + , ecuMbCoreSemMod = Nothing + } + ) + +{-# LINE 116 "src/ehc/EHC/CompilePhase/Cleanup.chs" #-} +cpCleanupCU :: HsName -> EHCompilePhase () +cpCleanupCU modNm + = do { cpUpdCU modNm + (\e -> e { ecuHIInfo = {- HI.hiiRetainAfterCleanup -} (ecuHIInfo e) + , ecuMbOptim = Nothing + } + ) + } + +cpCleanupFlow :: HsName -> EHCompilePhase () +cpCleanupFlow modNm + = cpUpdCU modNm + (\e -> e { ecuMbHSSemMod = Nothing + -- , ecuMbPrevHI = Nothing + -- , ecuMbPrevHISem = Nothing + -- , ecuMbPrevHIInfo = Nothing + } + ) + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/CompileC.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/CompileC.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/CompileC.hs @@ -0,0 +1,161 @@ +module UHC.Light.Compiler.EHC.CompilePhase.CompileC +( cpCompileWithGCC +, cpPreprocessWithCPP ) +where +import Data.Char +import Data.Maybe +import Control.Monad.State +import qualified Data.Map as Map +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import UHC.Light.Compiler.Opts.CommandLine +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.EHC.Environment +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.FileSearchLocation +import UHC.Light.Compiler.Base.PackageDatabase + + + +{-# LINE 50 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} +gccDefs :: EHCOpts -> [String] -> CmdLineOpts +gccDefs opts builds + = map (\(d,mbval) -> cppOpt $ CmdFlag_Define ("__UHC" ++ d ++ "__") mbval) + $ [ ("" , Just (Cfg.verAsNumber Cfg.version)) + , ("_TARGET_" ++ (map toUpper $ show $ ehcOptTarget opts), Nothing ) + ] + ++ map (\x -> ("_BUILDS_" ++ x, Nothing)) + builds + ++ map (\x -> (x,Nothing)) + [ "_" ++ map (\c -> case c of {'.' -> '_'; c -> c}) (Cfg.verFull Cfg.version) ] + + +{-# LINE 64 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} +gccInclDirs :: EHCOpts -> [PkgModulePartition] -> [FilePath] +gccInclDirs opts pkgKeyDirL = ds ++ (map fst $ Map.elems pdmp) + where (ds,pdmp) = pkgPartInclDirs opts pkgKeyDirL + +{-# LINE 77 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} +cpCompileWithGCC :: FinalCompileHow -> [HsName] -> HsName -> EHCompilePhase () +cpCompileWithGCC how othModNmL modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + fpC = case ecuStateToKind $ ecuState ecu of + EHCUKind_C -> fp + _ -> mkOutputFPath opts modNm fp "c" + fpO m f = mkPerModuleOutputFPath opts False m f "o" + fpExec = mkPerExecOutputFPath opts modNm fp (fmap (flip (,) False) Cfg.mbSuffixExec) + variant= Cfg.installVariant opts + (fpTarg,targOpt,linkOpts,linkLibOpt,dotOFilesOpt,genOFiles + ,pgmExec + ) + = case how of + FinalCompile_Exec + -> ( fpExec + , ( if ehcOptOptimizationLevel opts >= OptimizationLevel_Much then [gccOptF "O2"] else if ehcOptOptimizationLevel opts >= OptimizationLevel_Normal then [gccOptF "O1"] else [] ) + ++ Cfg.gccOpts ++ [gccOptOutput $ fpathToStr fpExec] + , Cfg.ehcGccOptsStatic' + , + map (mkl2 Cfg.INST_LIB_PKG2) + (if ehcOptWholeProgOptimizationScope opts then [] else map tup123to12 pkgKeyDirL) + ++ + map (mkl Cfg.INST_LIB) + Cfg.libnamesRts + ++ map (\l -> gccArg $ Cfg.mkInstallFilePrefix opts Cfg.INST_LIB_SHARED variant "" ++ Cfg.mkCLibFilename "" l) (Cfg.libnamesGcc opts) + ++ map gccOptLib Cfg.libnamesGccEhcExtraExternalLibs + , + if ehcOptWholeProgOptimizationScope opts + then [ ] + else + [ gccArg $ fpathToStr $ fpO m fp | m <- othModNmL2, let (_,_,_,fp) = crBaseInfo m cr ] + , [] + , PgmExec_Linker + ) + where -- mkl how l = Cfg.mkCLibFilename (Cfg.mkInstallFilePrefix opts how variant l) l + mkl how l = gccArg $ Cfg.mkInstalledRts opts Cfg.mkCLibFilename how variant l + mkl2 how (l,d) + = gccArg $ + Cfg.mkCLibFilename (d ++ "/") + (showPkgKey l) + {- + = Cfg.mkCLibFilename (Cfg.mkInstallFilePrefix opts how variant (showPkgKey l) ++ "/" ++ + mkInternalPkgFileBase l (Cfg.installVariant opts) + (ehcOptTarget opts) (ehcOptTargetFlavor opts) ++ "/") + (showPkgKey l) + -} + FinalCompile_Module + -> (o, Cfg.gccOpts ++ [gccOptF "c", gccOptOutput $ fpathToStr o ], Cfg.ehcGccOptsStatic', [], [], [o] + , PgmExec_C + ) + where o = fpO modNm fp + (pkgKeyDirL,othModNmL2) = crPartitionIntoPkgAndOthers cr othModNmL + pkgKeyL = map tup123to1 pkgKeyDirL + ; when (targetIsC (ehcOptTarget opts)) + (do { let compileC + = mkShellCmd' [Cmd_CPP, Cmd_C] + (Cfg.shellCmdOverride opts + Cfg.shellCmdGcc + pgmExec) + ( gccDefs opts ["O"] + ++ [ cppOptI $ Cfg.mkInstallFilePrefix opts Cfg.INST_INCLUDE variant "" ] + ++ [ cppOptI $ Cfg.mkInstallFilePrefix opts Cfg.INST_INCLUDE_SHARED variant "" ] + ++ [ cppOptI d | d <- gccInclDirs opts pkgKeyDirL ] + ++ linkOpts + ++ targOpt + ++ ehcOptCmdLineOpts opts + ++ dotOFilesOpt + ++ [ gccArg $ fpathToStr fpC ] + ++ linkLibOpt + ) + ; when (ehcOptVerbosity opts >= VerboseALot) + (do { cpMsg' modNm VerboseALot "GCC" Nothing fpTarg + ; lift $ putStrLn $ showShellCmd compileC + }) + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { lift $ putStrLn ("pkgs : " ++ show pkgKeyL) + ; lift $ putStrLn ("pkgdirs : " ++ show pkgKeyDirL) + ; lift $ putStrLn ("other: " ++ show othModNmL2) + }) + ; cpSeq [ cpSystem' Nothing compileC + , cpUpdCU modNm (ecuStoreGenCodeFiles genOFiles) + ] + }) + } + +{-# LINE 196 "src/ehc/EHC/CompilePhase/CompileC.chs" #-} +cpPreprocessWithCPP :: [PkgModulePartition] -> HsName -> EHCompilePhase () +cpPreprocessWithCPP pkgKeyDirL modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + fpCPP = fpathSetSuff {- mkOutputFPath opts modNm fp -} (maybe "" (\s -> s ++ "-") (fpathMbSuff fp) ++ "cpp") fp + ; {- when ( ehcOptCPP opts + || modNm == hsnModIntlBase -- 20080211, AD: builtin hack to preprocess EHC.Prelude with cpp, for now, to avoid implementation of pragmas + ) -} + (do { let shellCmdCpp = Cfg.shellCmdOverride opts Cfg.shellCmdCpp PgmExec_CPP + shellCmdCppOpts = execOptsPlain $ Map.findWithDefault [] shellCmdCpp $ ehcOptExecOptsMp opts + preCPP = mkShellCmd' [Cmd_CPP,Cmd_CPP_Preprocessing] shellCmdCpp + ( Cfg.cppOpts ++ gccDefs opts ["CPP"] + ++ map cppOptF shellCmdCppOpts -- [ {- "traditional-cpp", -} {- "std=gnu99", -} "fno-show-column", "P" ] + ++ [ cppOptI d | d <- gccInclDirs opts pkgKeyDirL ] + ++ ehcOptCmdLineOpts opts + ++ map (cppArg . fpathToStr) [ fp ] -- , fpCPP ] + ) + ; when (ehcOptVerbosity opts >= VerboseALot) + (do { cpMsg modNm VerboseALot "CPP" + -- ; lift $ putStrLn ("pkg db: " ++ show (ehcOptPkgDb opts)) + -- ; lift $ putStrLn ("pkg srch filter: " ++ (show $ ehcOptPackageSearchFilter opts)) + -- ; lift $ putStrLn ("exposed pkgs: " ++ show (pkgExposedPackages $ ehcOptPkgDb opts)) + -- ; lift $ putStrLn ("pkgKeyDirL: " ++ show pkgKeyDirL) + ; lift $ putStrLn $ showShellCmd preCPP + }) + ; when (crModCanCompile modNm cr) + (do { lift $ fpathEnsureExists fpCPP + ; cpSystem' (Just $ fpathToStr fpCPP) preCPP + ; cpRegisterFilesToRm [fpCPP] + }) + -- ; cpUpdCU modNm (ecuStoreSrcFilePath fpCPP) + ; cpUpdCU modNm (ecuStoreCppFilePath fpCPP) + }) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/FlowBetweenPhase.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/FlowBetweenPhase.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/FlowBetweenPhase.hs @@ -0,0 +1,294 @@ +module UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase +( cpFlowEHSem1 +, cpFlowHsSem1 +, cpFlowHISem +, cpFlowCoreModSem +, cpFlowCoreSemAfterFold, cpFlowCoreSemBeforeFold +, cpFlowHILamMp +, cpFlowOptim ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad.State +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.EHC.CompilePhase.Module +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.UsedModNms +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import qualified UHC.Light.Compiler.HI as HI +import UHC.Light.Compiler.CHR.Solve (chrStoreUnion) +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.EHC.CompilePhase.Module(cpUpdHiddenExports) + + + + + + + + + + + + +{-# LINE 75 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +prepFlow :: a -> a +prepFlow x | x `seq` True = x +-- prepFlow = id + +gamUnionFlow :: Ord k => Gam k v -> Gam k v -> Gam k v +gamUnionFlow = gamUnion + +{-# LINE 96 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowHsSem1 :: HsName -> EHCompilePhase () +cpFlowHsSem1 modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + hsSem = panicJust "cpFlowHsSem1" $ ecuMbHSSem ecu + ehInh = crsiEHInh crsi + hsInh = crsiHSInh crsi + hii = ecuHIInfo ecu + ig = prepFlow $! HSSem.gathIdGam_Syn_AGItf hsSem + fg = prepFlow $! HSSem.gathFixityGam_Syn_AGItf hsSem + hsInh' = hsInh + { HSSem.idGam_Inh_AGItf = ig `gamUnionFlow` HSSem.idGam_Inh_AGItf hsInh + , HSSem.fixityGam_Inh_AGItf = fg `gamUnionFlow` HSSem.fixityGam_Inh_AGItf hsInh + } + ehInh' = ehInh + { EHSem.idQualGam_Inh_AGItf = idGam2QualGam ig `gamUnionFlow` EHSem.idQualGam_Inh_AGItf ehInh + } + hii' = hii + { HI.hiiFixityGam = fg + -- , HI.hiiIdDefHIIdGam = HI.hiiIdDefOccGamToHIIdGam ig + , HI.hiiHIDeclImpModS = ecuHIDeclImpNmS ecu + } + opts' = opts + { ehcOptBuiltinNames = mkEHBuiltinNames mk + } + where mk = if ehcOptUseAssumePrelude opts + then \_ n -> n + else \k n -> idQualGamReplacement (EHSem.idQualGam_Inh_AGItf ehInh') k (hsnQualified n) + ; when (isJust (ecuMbHSSem ecu)) + (do { cpUpdSI (\crsi -> crsi {crsiHSInh = hsInh', crsiEHInh = ehInh', crsiOpts = opts'}) + ; cpUpdCU modNm $! ecuStoreHIInfo hii' + -- ; lift $ putStrLn (forceEval hii' `seq` "cpFlowHsSem1") + }) + -- ; lift $ putWidthPPLn 120 (ppGam $ EHSem.idQualGam_Inh_AGItf $ ehInh') + } + + +{-# LINE 139 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowEHSem1 :: HsName -> EHCompilePhase () +cpFlowEHSem1 modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + ehSem = panicJust "cpFlowEHSem1.ehSem" $ ecuMbEHSem ecu + ehInh = crsiEHInh crsi + coreInh = crsiCoreInh crsi + dg = prepFlow $! EHSem.gathDataGam_Syn_AGItf ehSem + vg = prepFlow $! EHSem.gathValGam_Syn_AGItf ehSem + tg = prepFlow $! EHSem.gathTyGam_Syn_AGItf ehSem + tkg = prepFlow $! EHSem.gathTyKiGam_Syn_AGItf ehSem + pg = prepFlow $! EHSem.gathPolGam_Syn_AGItf ehSem + kg = prepFlow $! EHSem.gathKiGam_Syn_AGItf ehSem + clg = prepFlow $! EHSem.gathClGam_Syn_AGItf ehSem + dfg = prepFlow $! EHSem.gathClDfGam_Syn_AGItf ehSem + cs = prepFlow $! EHSem.gathChrStore_Syn_AGItf ehSem + lm = prepFlow $! EHSem.gathLamMp_Syn_AGItf ehSem + mmi = panicJust "cpFlowEHSem1.crsiModMp" $ Map.lookup modNm $ crsiModMp crsi + hii = ecuHIInfo ecu + mentrelFilterMp + = mentrelFilterMpUnions [ EHSem.gathMentrelFilterMp_Syn_AGItf ehSem, mentrelToFilterMp' False [modNm] (mmiExps mmi) ] + usedImpS = mentrelFilterMpModuleNames mentrelFilterMp + ehInh' = ehInh + { EHSem.dataGam_Inh_AGItf = dg `gamUnionFlow` EHSem.dataGam_Inh_AGItf ehInh + , EHSem.valGam_Inh_AGItf = vg `gamUnionFlow` EHSem.valGam_Inh_AGItf ehInh + , EHSem.tyGam_Inh_AGItf = tg `gamUnionFlow` EHSem.tyGam_Inh_AGItf ehInh + , EHSem.tyKiGam_Inh_AGItf = tkg `gamUnionFlow` EHSem.tyKiGam_Inh_AGItf ehInh + , EHSem.polGam_Inh_AGItf = pg `gamUnionFlow` EHSem.polGam_Inh_AGItf ehInh + , EHSem.kiGam_Inh_AGItf = kg `gamUnionFlow` EHSem.kiGam_Inh_AGItf ehInh + , EHSem.clGam_Inh_AGItf = clg `gamUnionFlow` EHSem.clGam_Inh_AGItf ehInh + , EHSem.clDfGam_Inh_AGItf = dfg `gamUnionFlow` EHSem.clDfGam_Inh_AGItf ehInh + , EHSem.chrStore_Inh_AGItf = cs `chrStoreUnion` EHSem.chrStore_Inh_AGItf ehInh + } + hii' = hii + { -- 20100717 AD: redundant because later extracted from Core because of inlining etc, TBD + HI.hiiHIUsedImpModS = usedImpS + , HI.hiiMbOrphan = EHSem.mbOrphan_Syn_AGItf ehSem + , HI.hiiValGam = vg + , HI.hiiTyGam = tg + , HI.hiiTyKiGam = tkg + , HI.hiiPolGam = pg + , HI.hiiDataGam = dg + , HI.hiiClGam = clg + , HI.hiiClDfGam = dfg + , HI.hiiCHRStore = {- HI.hiiScopedPredStoreToList -} cs + -- , HI.hiiLamMp = lm + } + coreInh' = coreInh + { Core2GrSem.dataGam_Inh_CodeAGItf = EHSem.dataGam_Inh_AGItf ehInh' + , Core2GrSem.lamMp_Inh_CodeAGItf = lm `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh -- assumption: no duplicates, otherwise merging as done later has to be done + } + ; when (isJust (ecuMbEHSem ecu)) + (do { cpUpdSI + (\crsi -> crsi + { crsiCoreInh = coreInh', crsiEHInh = ehInh' } + ) + ; cpUpdCU modNm ( ecuStoreHIInfo hii' + . ecuStoreHIUsedImpS usedImpS + . ecuStoreUsedNames mentrelFilterMp + ) + -- put back additional hidden exports + ; cpUpdHiddenExports modNm $ Seq.toList $ EHSem.gathHiddenExports_Syn_AGItf ehSem + }) + } + +{-# LINE 243 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowHISem :: HsName -> EHCompilePhase () +cpFlowHISem modNm + = do { cr <- get + ; let (ecu,crsi,_,_) = crBaseInfo modNm cr + -- hiSem = panicJust "cpFlowHISem.hiSem" $ ecuMbPrevHISem ecu + hiInfo = panicJust "cpFlowHISem.hiInfo" $ ecuMbPrevHIInfo ecu + ehInh = crsiEHInh crsi + ehInh' = ehInh + { EHSem.valGam_Inh_AGItf = (HI.hiiValGam hiInfo) `gamUnionFlow` EHSem.valGam_Inh_AGItf ehInh + , EHSem.tyGam_Inh_AGItf = (HI.hiiTyGam hiInfo) `gamUnionFlow` EHSem.tyGam_Inh_AGItf ehInh + , EHSem.tyKiGam_Inh_AGItf = (HI.hiiTyKiGam hiInfo) `gamUnionFlow` EHSem.tyKiGam_Inh_AGItf ehInh + , EHSem.polGam_Inh_AGItf = (HI.hiiPolGam hiInfo) `gamUnionFlow` EHSem.polGam_Inh_AGItf ehInh + , EHSem.dataGam_Inh_AGItf = (HI.hiiDataGam hiInfo) `gamUnionFlow` EHSem.dataGam_Inh_AGItf ehInh + , EHSem.clGam_Inh_AGItf = (HI.hiiClGam hiInfo) `gamUnionFlow` EHSem.clGam_Inh_AGItf ehInh + , EHSem.clDfGam_Inh_AGItf = (HI.hiiClDfGam hiInfo) `gamUnionFlow` EHSem.clDfGam_Inh_AGItf ehInh + , EHSem.chrStore_Inh_AGItf = (HI.hiiCHRStore hiInfo) `chrStoreUnion` EHSem.chrStore_Inh_AGItf ehInh + } + hsInh = crsiHSInh crsi + hsInh' = hsInh + { HSSem.fixityGam_Inh_AGItf = (HI.hiiFixityGam hiInfo) `gamUnionFlow` HSSem.fixityGam_Inh_AGItf hsInh + , HSSem.idGam_Inh_AGItf = (HI.hiiIdDefOccGam hiInfo) `gamUnionFlow` HSSem.idGam_Inh_AGItf hsInh + } + coreInh = crsiCoreInh crsi + coreInh' = coreInh + { Core2GrSem.lamMp_Inh_CodeAGItf = (HI.hiiLamMp hiInfo) `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh + } + optim = crsiOptim crsi + optim' = optim + ; when (isJust (ecuMbPrevHIInfo ecu)) + (do { cpUpdSI (\crsi -> crsi { crsiEHInh = ehInh' + , crsiHSInh = {- tr "cpFlowHISem.crsiHSInh" (pp $ HSSem.idGam_Inh_AGItf hsInh') $ -} hsInh' + , crsiCoreInh = coreInh' + , crsiOptim = optim' + }) + }) + } + +{-# LINE 294 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +-- | Flow info after Core source check +cpFlowCoreModSem :: HsName -> EHCompilePhase () +cpFlowCoreModSem modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + -- ehInh = crsiEHInh crsi + coreInh = crsiCoreInh crsi + mbCoreModSem = ecuMbCoreSemMod ecu + ; when (isJust mbCoreModSem) $ do + { let coreModSem = fromJust mbCoreModSem + -- ehInh' = ehInh + -- { EHSem.dataGam_Inh_AGItf = EHSem.dataGam_Inh_AGItf ehInh `gamUnionFlow` Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem + -- } + coreInh' = coreInh + { Core2GrSem.dataGam_Inh_CodeAGItf = Core2GrSem.dataGam_Inh_CodeAGItf coreInh `gamUnionFlow` Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem + } + -- ; lift $ putStrLn $ "cpFlowCoreModSem" ++ (show $ gamKeys $ Core2ChkSem.gathDataGam_Syn_CodeAGItf coreModSem) + -- ; cpUpdSI (\crsi -> crsi { crsiEHInh = ehInh' }) + ; cpUpdSI (\crsi -> crsi { crsiCoreInh = coreInh' }) + } + } + +{-# LINE 320 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowCoreSemAfterFold :: HsName -> EHCompilePhase () +cpFlowCoreSemAfterFold modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + coreSem = panicJust "cpFlowCoreSemAfterFold.coreSem" $ ecuMbCoreSem ecu + + coreInh = crsiCoreInh crsi + hii = ecuHIInfo ecu + am = prepFlow $! Core2GrSem.gathLamMp_Syn_CodeAGItf coreSem + coreInh' = coreInh + { Core2GrSem.lamMp_Inh_CodeAGItf = am `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh -- assumption: old info can be overridden, otherwise merge should be done here + } + hii' = hii + { HI.hiiLamMp = am + } + ; when (isJust (ecuMbCoreSem ecu)) + (do { cpUpdSI (\crsi -> crsi {crsiCoreInh = coreInh'}) + ; cpUpdCU modNm ( ecuStoreHIInfo hii' + ) + }) + } + +cpFlowCoreSemBeforeFold :: HsName -> EHCompilePhase () +cpFlowCoreSemBeforeFold modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + core = panicJust "cpFlowCoreSemBeforeFold.core" $ ecuMbCore ecu + + -- 20100717 AD: required here because of inlining etc, TBD + (usedImpS, introdModS) = cmodUsedModNms core + + hii = ecuHIInfo ecu + hii' = hii + { -- 20100717 AD: required here because of inlining etc, TBD + HI.hiiHIUsedImpModS = usedImpS + } + -- ; lift $ putStrLn $ "cpFlowCoreSemBeforeFold usedImpS " ++ show usedImpS + -- ; lift $ putStrLn $ "cpFlowCoreSemBeforeFold introdModS " ++ show introdModS + ; cpUpdCU modNm ( ecuStoreHIInfo hii' + -- + -- 20100717 AD: required here because of inlining etc, TBD + . ecuStoreHIUsedImpS usedImpS + . ecuStoreIntrodModS introdModS + ) + ; impNmL <- cpGenImpNmInfo modNm + ; cpUpdCU modNm ( ecuStoreCore $ cmodSetImports impNmL core + ) + } + +{-# LINE 373 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowHILamMp :: HsName -> EHCompilePhase () +cpFlowHILamMp modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + coreInh = crsiCoreInh crsi + hii = ecuHIInfo ecu + + -- put back result: call info map (lambda arity, ...), overwriting previous entries + ; cpUpdSI (\crsi -> crsi {crsiCoreInh = coreInh {Core2GrSem.lamMp_Inh_CodeAGItf = HI.hiiLamMp hii `lamMpUnionBindAspMp` Core2GrSem.lamMp_Inh_CodeAGItf coreInh}}) + } + +{-# LINE 386 "src/ehc/EHC/CompilePhase/FlowBetweenPhase.chs" #-} +cpFlowOptim :: HsName -> EHCompilePhase () +cpFlowOptim modNm + = do { cr <- get + ; let (ecu,crsi,_,_) = crBaseInfo modNm cr + optim = crsiOptim crsi + moptim = panicJust "cpFlowOptim" $ ecuMbOptim ecu + hii = ecuHIInfo ecu + optim' = optim + hii' = hii + ; when (isJust (ecuMbOptim ecu)) + (do { cpUpdSI (\crsi -> crsi {crsiOptim = optim'}) + ; cpUpdCU modNm $! ecuStoreHIInfo $! prepFlow hii' + -- ; lift $ putStrLn (forceEval hii' `seq` "cpFlowOptim") + }) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Link.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Link.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Link.hs @@ -0,0 +1,27 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Link +( cpLinkO ) +where +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import Control.Monad.State +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.EHC.Environment +import UHC.Light.Compiler.Base.Target + +{-# LINE 37 "src/ehc/EHC/CompilePhase/Link.chs" #-} +cpLinkO :: [HsName] -> String -> EHCompilePhase () +cpLinkO modNmL pkgNm + = do { cr <- get + ; let (crsi,opts) = crBaseInfo' cr + codeFiles = [ fpathToStr o | m <- modNmL, o <- ecuGenCodeFiles $ crCU m cr ] + (libFile,_) = mkInOrOutputFPathDirFor OutputFor_Pkg opts l l (fpathSuff l) + where l = mkFPath $ Cfg.mkCLibFilename "" pkgNm + linkCode = map mkShellCmd $ Cfg.mkShellCmdLibtool (fpathToStr libFile) codeFiles + ; when (ehcOptVerbosity opts >= VerboseALot) + (do { lift $ mapM_ (putStrLn . showShellCmd) linkCode + }) + ; unless (null codeFiles) + (cpSeq [ cpSystem c | c <- linkCode ]) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Module.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Module.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Module.hs @@ -0,0 +1,210 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Module +( cpCheckMods' +, cpCheckMods +, GetMeta (..), allGetMeta +, cpGetCoreModnameAndImports +, cpGetHsModnameAndImports, cpGetHsMod, cpGetMetaInfo +, cpGetDummyCheckSrcMod +, cpUpdateModOffMp +, cpGenImpNmInfo +, cpUpdHiddenExports ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified UHC.Util.Rel as Rel +import UHC.Util.Time +import UHC.Util.FPath +import System.Directory +import Control.Monad.State +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import UHC.Light.Compiler.Module.ImportExport +import qualified UHC.Light.Compiler.Config as Cfg +import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import UHC.Light.Compiler.CodeGen.RefGenerator +import UHC.Light.Compiler.Base.Debug + + + + +{-# LINE 53 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpCheckMods' :: (HsName -> ModMpInfo) -> [Mod] -> EHCompilePhase () +cpCheckMods' dfltMod modL@(Mod {modName = modNm} : _) + = do { cr <- get + -- ; cpMsg modNm VerboseDebug $ "cpCheckMods' modL: " ++ show modL + ; let crsi = crStateInfo cr + (mm,e) = modMpCombine' dfltMod modL (crsiModMp crsi) + ; cpUpdSI (\crsi -> crsi {crsiModMp = mm}) + ; cpSetLimitErrsWhen 5 "Module analysis" e + } + +{-# LINE 72 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpCheckMods :: [HsName] -> EHCompilePhase () +cpCheckMods modNmL + = do { cr <- get + ; let modL = [ addBuiltin $ ecuMod $ crCU n cr | n <- modNmL ] + ; cpCheckMods' (\n -> panic $ "cpCheckMods: " ++ show n) modL + } + where addBuiltin m = m { modImpL = modImpBuiltin : modImpL m } + +{-# LINE 86 "src/ehc/EHC/CompilePhase/Module.chs" #-} +data GetMeta + = GetMeta_Src + | GetMeta_HI + | GetMeta_Core + | GetMeta_Dir + deriving (Eq,Ord) + +allGetMeta + = [ GetMeta_Src, GetMeta_HI, GetMeta_Core + , GetMeta_Dir + ] + + +{-# LINE 107 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpGetCoreModnameAndImports :: HsName -> EHCompilePhase HsName +cpGetCoreModnameAndImports modNm + = do { cr <- get + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + mbCrSemMod = ecuMbCoreSemMod ecu + crSemMod = panicJust "cpGetCoreModnameAndImports" mbCrSemMod + modNm' = Core2ChkSem.realModuleNm_Syn_CodeAGItf crSemMod + ; case mbCrSemMod of + {- + Just _ | ecuIsTopMod ecu -> cpUpdCUWithKey modNm (\_ ecu -> (modNm', upd $ cuUpdKey modNm' ecu)) + | otherwise -> do { cpUpdCU modNm upd ; return modNm } + -} + Just _ -> cpUpdCUWithKey modNm $ \_ ecu -> + ( modNm' + , ecuStoreHSDeclImpS (Set.fromList $ Core2ChkSem.impModNmL_Syn_CodeAGItf crSemMod ) + $ cuUpdKey modNm' ecu + ) + _ -> return modNm + } + +{-# LINE 129 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpGetHsModnameAndImports :: HsName -> EHCompilePhase HsName +cpGetHsModnameAndImports modNm + = do { cr <- get + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + mbHsSemMod = ecuMbHSSemMod ecu + hsSemMod = panicJust "cpGetHsModnameAndImports" mbHsSemMod + modNm' = HSSemMod.realModuleNm_Syn_AGItf hsSemMod + upd = ecuStoreHSDeclImpS ( -- (\v -> tr "XX" (pp $ Set.toList v) v) $ + HSSemMod.modImpNmS_Syn_AGItf hsSemMod) + ; case mbHsSemMod of + Just _ | ecuIsTopMod ecu -> cpUpdCUWithKey modNm (\_ ecu -> (modNm', upd $ cuUpdKey modNm' ecu)) + | otherwise -> do { cpUpdCU modNm upd ; return modNm } + _ -> return modNm + } + +cpGetHsMod :: HsName -> EHCompilePhase () +cpGetHsMod modNm + = do { cr <- get + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + mbHsSemMod = ecuMbHSSemMod ecu + hsSemMod = panicJust "cpGetHsMod" mbHsSemMod + mod = HSSemMod.mod_Syn_AGItf hsSemMod + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { cpMsg modNm VerboseDebug "cpGetHsMod" + ; lift $ putWidthPPLn 120 (pp mod) + }) + ; when (isJust mbHsSemMod) + (cpUpdCU modNm (ecuStoreMod mod)) + } + +cpGetMetaInfo :: [GetMeta] -> HsName -> EHCompilePhase () +cpGetMetaInfo gm modNm + = do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + ; when (GetMeta_Src `elem` gm) + (tm opts ecu ecuStoreSrcTime (ecuSrcFilePath ecu)) + {- + ; when (GetMeta_HI `elem` gm) + (tm opts ecu ecuStoreHITime + (mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi") + ) + -} + ; when (GetMeta_HI `elem` gm) + (tm opts ecu ecuStoreHIInfoTime + (mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi") + ) + ; when (GetMeta_Core `elem` gm) + (tm opts ecu ecuStoreCoreTime (fpathSetSuff Cfg.suffixDotlessBinaryCore fp)) + ; when (GetMeta_Dir `elem` gm) + (wr opts ecu ecuStoreDirIsWritable ( fp )) + } + where tm :: EHCOpts -> EHCompileUnit -> (ClockTime -> EHCompileUnit -> EHCompileUnit) -> FPath -> EHCompilePhase () + tm opts ecu store fp + = do { let n = fpathToStr fp + ; nExists <- lift $ doesFileExist n + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { lift $ putStrLn ("meta info of: " ++ show (ecuModNm ecu) ++ ", file: " ++ n ++ ", exists: " ++ show nExists) + }) + ; when nExists + (do { t <- lift $ fpathGetModificationTime fp + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { lift $ putStrLn ("time stamp of: " ++ show (ecuModNm ecu) ++ ", time: " ++ show t) + }) + ; cpUpdCU modNm $ store t + }) + } + wr opts ecu store fp + = do { pm <- lift $ getPermissions (maybe "." id $ fpathMbDir fp) + -- ; lift $ putStrLn (fpathToStr fp ++ " writ " ++ show (writable pm)) + ; cpUpdCU modNm $ store (writable pm) + } + +{-# LINE 225 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpGetDummyCheckSrcMod :: HsName -> EHCompilePhase () +cpGetDummyCheckSrcMod modNm + = do { cr <- get + ; let crsi = crStateInfo cr + mm = crsiModMp crsi + mod = Mod modNm Nothing Nothing [] Rel.empty Rel.empty [] + ; cpUpdCU modNm (ecuStoreMod mod) + ; cpUpdSI (\crsi -> crsi {crsiModMp = Map.insert modNm emptyModMpInfo mm}) + } + +{-# LINE 241 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpUpdateModOffMp :: [HsName] -> EHCompilePhase () +cpUpdateModOffMp modNmL + = do { cr <- get + ; let crsi = crStateInfo cr + offMp = crsiModOffMp crsi + (offMp',_) + = foldr add (offMp, Map.size offMp) modNmL + where add modNm (offMp, offset) + = case Map.lookup modNm offMp of + Just (o,_) -> (Map.insert modNm (o, new) offMp, offset ) + _ -> (Map.insert modNm (o, new) offMp, offset') + where (o, offset') = refGen1 offset 1 modNm + where new = crsiExpNmOffMp modNm crsi + ; cpUpdSI (\crsi -> crsi {crsiModOffMp = offMp'}) + } + +{-# LINE 263 "src/ehc/EHC/CompilePhase/Module.chs" #-} +-- | Compute imported module names +cpGenImpNmInfo :: HsName -> EHCompilePhase [HsName] +cpGenImpNmInfo modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + isWholeProg = ehcOptOptimizationScope opts > OptimizationScope_PerModule + impNmL | isWholeProg = [] + | otherwise = ecuImpNmL ecu + ; return impNmL + } + +{-# LINE 280 "src/ehc/EHC/CompilePhase/Module.chs" #-} +cpUpdHiddenExports :: HsName -> [(HsName,IdOccKind)] -> EHCompilePhase () +cpUpdHiddenExports modNm exps + = when (not $ null exps) + (do { cpUpdSI (\crsi -> crsi { crsiModMp = modMpAddHiddenExps modNm exps $ crsiModMp crsi + }) + ; cpUpdateModOffMp [modNm] + }) + + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Output.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Output.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Output.hs @@ -0,0 +1,153 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Output +( CPOutputCoreHow (..), cpOutputCoreModules +, cpOutputCore +, cpOutputHI ) +where +import qualified UHC.Util.FastSeq as Seq +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad.State +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import qualified UHC.Light.Compiler.Config as Cfg +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore +import UHC.Light.Compiler.Core.ToCoreRun +import UHC.Light.Compiler.CoreRun.Pretty +import UHC.Light.Compiler.Core as Core +import UHC.Light.Compiler.Core.Pretty +import UHC.Util.Time +import System.Directory +import qualified UHC.Light.Compiler.SourceCodeSig as Sig +import qualified UHC.Light.Compiler.HI as HI +import qualified UHC.Util.Binary as Bin +import UHC.Util.Serialize +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Module.ImportExport +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import UHC.Light.Compiler.Gam.Utils + + + + + + + + + + + + +{-# LINE 93 "src/ehc/EHC/CompilePhase/Output.chs" #-} +-- | Abstraction for writing a module to output with variation in suffices +cpOutputSomeModules + :: (EHCOpts -> EHCompileUnit -> FPath -> FilePath -> mod -> IO ()) + -> (EHCOpts -> HsName -> FPath -> String -> FPath) + -> (Int -> String -> String) + -> String + -> HsName + -> [(String,mod)] + -> EHCompilePhase [FPath] +cpOutputSomeModules write mkfp mknmsuff suff modNm mods = do + cr <- get + let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + forM (zip [1..] mods) $ \(nr,(nmsuff,mod)) -> do + let fpC = mkfp opts modNm fp (suff ++ mknmsuff nr nmsuff) -- for now nmsuff after suff, but should be inside name + fnC = fpathToStr fpC + lift $ do + fpathEnsureExists fpC + write opts ecu fpC fnC mod + return fpC + +{-# LINE 151 "src/ehc/EHC/CompilePhase/Output.chs" #-} +data CPOutputCoreHow + = CPOutputCoreHow_Text + | CPOutputCoreHow_Binary + | CPOutputCoreHow_Run + +cpOutputCoreModules + :: CPOutputCoreHow -> [CoreOpt] + -> (Int -> String -> String) + -> String -> HsName + -> [(String,CModule)] + -> EHCompilePhase [FPath] +cpOutputCoreModules how coreOpts mknmsuff suff modNm cMods + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr + ; cpOutputSomeModules write mkOutputFPath mknmsuff suff modNm cMods + } + where write opts _ fpC fnC cMod = case how of + CPOutputCoreHow_Text -> do + let cMod' = cmodTrfEraseTyCore opts cMod + putPPFPath fpC (ppCModule (opts {ehcOptCoreOpts = coreOpts ++ ehcOptCoreOpts opts}) cMod') 100 + CPOutputCoreHow_Binary -> + putSerializeFile fnC cMod + CPOutputCoreHow_Run -> do + let cMod' = cmod2CoreRun cMod + putPPFPath fpC (ppMod' opts cMod') 100 + +{-# LINE 187 "src/ehc/EHC/CompilePhase/Output.chs" #-} +cpOutputCore :: CPOutputCoreHow -> [CoreOpt] -> String -> String -> HsName -> EHCompilePhase FPath +cpOutputCore how coreOpts nmsuff suff modNm + = do { cr <- get + ; let (ecu,_,_,_) = crBaseInfo modNm cr + mbCore = ecuMbCore ecu + cMod = panicJust "cpOutputCore" mbCore + ; cpMsg modNm VerboseALot "Emit Core" + ; fmap head $ cpOutputCoreModules how coreOpts (\_ nm -> nm) suff modNm [(nmsuff,cMod)] + } + +{-# LINE 314 "src/ehc/EHC/CompilePhase/Output.chs" #-} +cpOutputHI :: String -> HsName -> EHCompilePhase () +cpOutputHI suff modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + mmi = panicJust "cpOutputHI.crsiModMp" $ Map.lookup modNm $ crsiModMp crsi + hii1 = ecuHIInfo ecu + impNmS = ecuImpNmS ecu + hii2 = hii1 { HI.hiiValidity = HI.HIValidity_Ok + , HI.hiiModuleNm = modNm + , HI.hiiExps = mmiExps mmi + , HI.hiiHiddenExps = mmiHiddenExps mmi + , HI.hiiHasMain = ecuHasMain ecu + , HI.hiiTarget = ehcOptTarget opts + , HI.hiiTargetFlavor = ehcOptTargetFlavor opts + , HI.hiiSrcTimeStamp = Sig.timestamp + , HI.hiiSrcSig = Sig.sig + , HI.hiiSrcVersionMajor = Cfg.verMajor Cfg.version + , HI.hiiSrcVersionMinor = Cfg.verMinor Cfg.version + , HI.hiiSrcVersionMinorMinor = Cfg.verMinorMinor Cfg.version + , HI.hiiSrcVersionSvn = Cfg.verSvnRevision Cfg.version + , HI.hiiCompileFlags = optsDiscrRecompileRepr opts + , HI.hiiCompiler = Cfg.installVariant opts + , HI.hiiTransClosedUsedModMp = Map.unions $ + Map.singleton modNm impNmS : [ ecuTransClosedUsedModMp $ crCU m cr | m <- Set.toList impNmS ] + , HI.hiiTransClosedOrphanModS= Set.unions $ + [ Set.unions [if ecuIsOrphan me then Set.singleton m else Set.empty, ecuTransClosedOrphanModS me] + | m <- Set.toList impNmS + , let me = crCU m cr + ] + } + hii3 = hii2 + fpH = mkOutputFPath opts modNm fp suff + fnH = fpathToStr fpH + ; cpMsg modNm VerboseALot "Emit HI" + ; hiExists <- lift $ doesFileExist fnH + ; when (hiExists) + (lift $ removeFile fnH) + ; when (ehcOptVerbosity opts > VerboseALot) + (do { lift $ putPPLn ("hii3: " >#< hii3) + ; lift $ putPPLn ("orph: " >#< vlist [ m >#< (fmap Set.toList $ HI.hiiMbOrphan $ ecuHIInfo me) | m <- Set.toList impNmS, let me = crCU m cr ]) + ; lift $ putPPLn ("used nms: " >#< (pp $ show $ ecuUsedNames ecu)) + }) + ; lift $ do { fpathEnsureExists fpH + ; putSerializeFile fnH hii3 + } + ; now <- lift $ getClockTime + ; cpUpdCU modNm ( ecuStoreHIInfoTime now + . ecuStoreHIInfo hii3 + ) + } + + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Parsers.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Parsers.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Parsers.hs @@ -0,0 +1,215 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Parsers +( cpParseOffside +, cpParseEH +, cpParseCoreWithFPath +, cpParseOffsideStopAtErr +, cpDecodeHIInfo +, cpDecodeCore +, cpGetPrevHI +, cpGetPrevCore +, cpParseHs +, cpParseHsImport ) +where +import UU.Parsing +import UU.Parsing.Offside +import qualified UHC.Util.ScanUtils as ScanUtils +import UHC.Light.Compiler.Scanner.Common +import UHC.Util.ParseUtils +import Control.Monad.State +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import qualified UHC.Light.Compiler.EH as EH +import qualified UHC.Light.Compiler.EH.Parser as EHPrs +import qualified UHC.Light.Compiler.HS as HS +import qualified UHC.Light.Compiler.HS.Parser as HSPrs +import qualified UHC.Light.Compiler.Core as Core +import qualified UHC.Light.Compiler.Core.Parser as CorePrs +import qualified UHC.Light.Compiler.HI as HI +import qualified UHC.Util.Binary as Bin +import UHC.Util.Serialize +import qualified UHC.Light.Compiler.Config as Cfg +import qualified UHC.Light.Compiler.SourceCodeSig as Sig +import Control.Exception as CE + + + + + + + +{-# LINE 61 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +-- | Generalization of parser invocation +cpParseWithFPath + :: PP msg + => (ScanUtils.ScanOpts -> FilePath -> Handle -> IO inp) -- tokenize/scan file + -> (parser -> inp -> (a,[msg])) -- parse tokens + -> ([Err] -> EHCompilePhase out) -- monadic output from errors + -> parser -- the parser + -> ScanUtils.ScanOpts -- options to the tokenizer/scanner + -> EcuUpdater a -- updater of state + -> Maybe FPath -- possibly overriding FilePath instead of default derived from state for this module name + -> HsName -- module name + -> EHCompilePhase out +cpParseWithFPath + scan parse seterrs + parser scanOpts store mbFp modNm + = do { cr <- get + ; (fn,fh) <- lift $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False + ; tokens <- lift $ scan scanOpts fn fh + ; let (res,msgs) = parse parser tokens + errs = map (rngLift emptyRange mkPPErr) msgs + ; cpUpdCU modNm (store res) + ; seterrs errs + } + +-- cpParseOffsideWithFPath :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> Maybe FPath -> HsName -> EHCompilePhase () +-- `HSPrs.HSParser a' is a type synonym for `OffsideParser [Token] Pair Token (Maybe Token) a' but is not expanded as such... +cpParseOffsideWithFPath :: OffsideParser [Token] Pair Token (Maybe Token) a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> Maybe FPath -> HsName -> EHCompilePhase () +cpParseOffsideWithFPath parser scanOpts store description mbFp modNm + = cpParseWithFPath offsideScanHandle parseOffsideToResMsgs (cpSetLimitErrsWhen 5 description) parser scanOpts store mbFp modNm +{- + = do { cr <- get + ; (fn,fh) <- lift $ openFPath (maybe (ecuFilePath (crCU modNm cr)) id mbFp) ReadMode False + ; tokens <- lift $ offsideScanHandle scanOpts fn fh + -- ; lift $ putStrLn $ show tokens -- does not work, no Show instance + ; let (res,msgs) = parseOffsideToResMsgs parser tokens + errs = map (rngLift emptyRange mkPPErr) msgs + ; cpUpdCU modNm (store res) + ; cpSetLimitErrsWhen 5 description errs + } +-} + +{-# LINE 104 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseOffside :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> String -> HsName -> EHCompilePhase () +cpParseOffside parser scanOpts store description modNm + = cpParseOffsideWithFPath parser scanOpts store description Nothing modNm + +{-# LINE 135 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseEH :: HsName -> EHCompilePhase () +cpParseEH + = cpParseOffside EHPrs.pAGItf (ehScanOpts defaultEHCOpts) ecuStoreEH "Parse (EH syntax) of module" + +{-# LINE 162 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseHs :: Bool -> HsName -> EHCompilePhase () +cpParseHs litmode modNm + = do { cr <- get + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + ; cpParseOffsideWithFPath + (HSPrs.pAGItf opts) ((hsScanOpts opts) {ScanUtils.scoLitmode = litmode}) ecuStoreHS + ("Parse (" ++ (if litmode then "Literate " else "") ++ "Haskell syntax) of module") + Nothing modNm + } + +{-# LINE 174 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseOffsideStopAtErr :: HSPrs.HSParser a -> ScanUtils.ScanOpts -> EcuUpdater a -> HsName -> EHCompilePhase () +cpParseOffsideStopAtErr parser scanOpts store modNm + = do { cr <- get + ; (fn,fh) <- lift $ openFPath (ecuFilePath (crCU modNm cr)) ReadMode False + ; tokens <- lift $ offsideScanHandle scanOpts fn fh + ; let (res,_) = parseOffsideToResMsgsStopAtErr parser tokens + ; cpUpdCU modNm (store res) + } + +{-# LINE 194 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseHsImport :: Bool -> HsName -> EHCompilePhase () +cpParseHsImport litmode modNm + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr + ; cpParseOffsideStopAtErr (HSPrs.pAGItfImport opts) ((hsScanOpts opts) {ScanUtils.scoLitmode = litmode}) ecuStoreHS modNm + } + +{-# LINE 203 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpParseCoreWithFPath :: Maybe FPath -> HsName -> EHCompilePhase () +cpParseCoreWithFPath mbFp modNm + = do (_,opts) <- gets crBaseInfo' + cpParseWithFPath scanHandle parseToResMsgs (cpSetLimitErrsWhen 5 "Parse Core") CorePrs.pCModule (coreScanOpts opts) ecuStoreCore mbFp modNm + +{- +cpParseCore :: HsName -> EHCompilePhase () +cpParseCore modNm + = do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + fpC = fpathSetSuff Cfg.suffixDotlessInputOutputTextualCore fp + ; cpMsg' modNm VerboseALot "Parsing" Nothing fpC + ; errs <- cpParsePlainToErrs CorePrs.pCModule (coreScanOpts opts) ecuStoreCore fpC modNm + ; when (ehcDebugStopAtCoreError opts) + (cpSetLimitErrsWhen 5 "Parse Core (of previous compile) of module" errs) + ; return () + } +-} + +{-# LINE 248 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpDecodeHIInfo :: HsName -> EHCompilePhase () +cpDecodeHIInfo modNm + = do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + -- if outputdir is specified, use that location to possibly read hi from. + fpH = mkInOrOutputFPathFor (InputFrom_Loc $ ecuFileLocation ecu) opts modNm fp "hi" + ; cpMsg' modNm VerboseALot "Decoding" Nothing fpH + ; hiinfo <- lift $ + CE.catch (do { i <- getSGetFile (fpathToStr fpH) (HI.sgetHIInfo opts) + -- getSerializeFile (fpathToStr fpH) + -- Bin.getBinaryFPath fpH + ; return i + }) + (\(_ :: SomeException) -> return $ HI.emptyHIInfo {HI.hiiValidity = HI.HIValidity_Absent}) + ; when (ehcOptVerbosity opts > VerboseALot) + (do { lift $ putPPLn (pp hiinfo) + }) + ; let canCompile = crModCanCompile modNm cr + ; case HI.hiiValidity hiinfo of + HI.HIValidity_WrongMagic | not canCompile + -> cpSetLimitErrsWhen 1 "Read HI" + [rngLift emptyRange Err_WrongMagic + (show modNm) + (fpathToStr fpH) + ] + HI.HIValidity_Inconsistent | not canCompile + -> cpSetLimitErrsWhen 1 "Read HI (of previous compile) of module" + [rngLift emptyRange Err_InconsistentHI + (show modNm) + (fpathToStr fpH) + [Sig.timestamp, Cfg.installVariant opts, show $ ehcOptTarget opts, show $ ehcOptTargetFlavor opts] + [HI.hiiSrcTimeStamp hiinfo , HI.hiiCompiler hiinfo , show $ HI.hiiTarget hiinfo, show $ HI.hiiTargetFlavor hiinfo] + ] + _ -> cpUpdCU modNm (ecuStorePrevHIInfo {-- $ HI.hiiPostCheckValidity opts -} hiinfo) + } + +{-# LINE 294 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +-- | Decode from serialized file and store result in the compileunit for the module modNm +cpDecode :: Serialize x => Maybe String -> EcuUpdater x -> HsName -> EHCompilePhase () +cpDecode mbSuff store modNm + = do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + fpC = maybe id fpathSetSuff mbSuff fp + ; cpMsg' modNm VerboseALot "Decoding" Nothing fpC + ; x <- liftIO $ getSerializeFile (fpathToStr fpC) + ; cpUpdCU modNm (store x) + } + +{-# LINE 312 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpDecodeCore :: Maybe String -> HsName -> EHCompilePhase () +cpDecodeCore suff = cpDecode suff ecuStoreCore + +{-# LINE 321 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpGetPrevHI :: HsName -> EHCompilePhase () +cpGetPrevHI modNm + = do { cr <- get + ; let ecu = crCU modNm cr + -- ; when (isJust (ecuMbHITime ecu)) + -- (cpParseHI modNm) + ; when (isJust (ecuMbHIInfoTime ecu)) + (cpDecodeHIInfo modNm) + } + +{-# LINE 333 "src/ehc/EHC/CompilePhase/Parsers.chs" #-} +cpGetPrevCore :: HsName -> EHCompilePhase () +cpGetPrevCore modNm + = do { cr <- get + ; let ecu = crCU modNm cr + ; when (isJust (ecuMbCoreTime ecu) && isNothing (ecuMbCore ecu)) + (cpDecodeCore (Just Cfg.suffixDotlessBinaryCore) modNm) + -- (cpParseCore modNm) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs @@ -0,0 +1,31 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Run +( cpRunCoreRun ) +where +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import Data.Maybe +import Control.Monad.State +import Control.Exception +import UHC.Light.Compiler.Core.ToCoreRun +import UHC.Light.Compiler.CoreRun.Run +import UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk as RE + +{-# LINE 41 "src/ehc/EHC/CompilePhase/Run.chs" #-} +-- | Run CoreRun. +-- TBD: fix dependence on whole program linked +cpRunCoreRun :: HsName -> EHCompilePhase () +cpRunCoreRun modNm = do + cr <- get + let (ecu,_,opts,_) = crBaseInfo modNm cr + mbCore = ecuMbCore ecu + cpMsg modNm VerboseNormal "Run Core" + when (isJust mbCore) $ do + let mod = cmod2CoreRun $ fromJust mbCore + res <- liftIO $ catch + (runCoreRun opts [] mod $ cmodRun opts mod) + (\(e :: SomeException) -> hFlush stdout >> (return $ Left $ strMsg $ "cpRunCoreRun: " ++ show e)) + either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) + (\_ -> return ()) + res + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Semantics.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Semantics.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Semantics.hs @@ -0,0 +1,179 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Semantics +( cpFoldCore2Grin +, cpFoldEH +, cpFoldHs +, cpFoldCoreMod +, cpFoldHsMod +, cpFoldHIInfo ) +where +import Control.Monad.State +import qualified Data.Map as Map +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.Core as Core +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import qualified Data.Set as Set +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import qualified UHC.Light.Compiler.HI as HI +import qualified UHC.Util.Rel as Rel +import UHC.Light.Compiler.Module.ImportExport +import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty + + + + + + + +{-# LINE 61 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldCore2Grin :: HsName -> EHCompilePhase () +cpFoldCore2Grin modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbCore = ecuMbCore ecu + core = panicJust "cpFoldCore2Grin" mbCore + coreInh = crsiCoreInh crsi + coreSem = Core2GrSem.wrap_CodeAGItf + (Core2GrSem.sem_CodeAGItf (Core.CodeAGItf_AGItf core)) + (coreInh { Core2GrSem.gUniq_Inh_CodeAGItf = crsiHereUID crsi + , Core2GrSem.opts_Inh_CodeAGItf = opts + , Core2GrSem.importUsedModules_Inh_CodeAGItf = ecuImportUsedModules ecu + }) + ; when (isJust mbCore) + (cpUpdCU modNm ( ecuStoreCoreSem coreSem + )) + } + +{-# LINE 83 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldCoreMod :: HsName -> EHCompilePhase () +cpFoldCoreMod modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbCore = ecuMbCore ecu + core = panicJust "cpFoldCoreMod" mbCore + inh = Core2ChkSem.Inh_CodeAGItf + { Core2ChkSem.opts_Inh_CodeAGItf = opts + , Core2ChkSem.dataGam_Inh_CodeAGItf = EHSem.dataGam_Inh_AGItf $ crsiEHInh crsi + } + coreSem = Core2ChkSem.cmodCheck' inh core + hasMain = Core2ChkSem.hasMain_Syn_CodeAGItf coreSem + -- ; lift $ putStrLn $ "cpFoldCoreMod " ++ show hasMain + ; when (isJust mbCore) + (cpUpdCU modNm ( ecuStoreCoreSemMod coreSem + . ecuSetHasMain hasMain + )) + } + +{-# LINE 104 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldEH :: HsName -> EHCompilePhase () +cpFoldEH modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbEH = ecuMbEH ecu + ehSem = EHSem.wrap_AGItf (EHSem.sem_AGItf $ panicJust "cpFoldEH" mbEH) + ((crsiEHInh crsi) + { EHSem.moduleNm_Inh_AGItf = ecuModNm ecu + , EHSem.gUniq_Inh_AGItf = crsiHereUID crsi + , EHSem.opts_Inh_AGItf = opts + , EHSem.isMainMod_Inh_AGItf = ecuIsMainMod ecu + }) + ; when (isJust mbEH) + (cpUpdCU modNm $! ecuStoreEHSem $! ehSem) + } + +{-# LINE 124 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldHs :: HsName -> EHCompilePhase () +cpFoldHs modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbHS = ecuMbHS ecu + inh = crsiHSInh crsi + hsSem = HSSem.wrap_AGItf (HSSem.sem_AGItf $ panicJust "cpFoldHs" mbHS) + (inh { HSSem.opts_Inh_AGItf = opts + , HSSem.gUniq_Inh_AGItf = crsiHereUID crsi + , HSSem.moduleNm_Inh_AGItf = modNm + , HSSem.isTopMod_Inh_AGItf = ecuIsTopMod ecu + , HSSem.modInScope_Inh_AGItf = inscps + , HSSem.modEntToOrig_Inh_AGItf = exps + , HSSem.topInstanceNmL_Inh_AGItf = modInstNmL (ecuMod ecu) + }) + where mmi = panicJust "cpFoldHs.crsiModMp" $ Map.lookup modNm $ crsiModMp crsi + inscps = Rel.toDomMap --- $ (\v -> tr "XX mmiInscps mmi" (pp v ) v) + $ mmiInscps + --- $ (\v -> tr "XX mmi" (pp v ) v) + $ mmi + exps = Rel.toRngMap $ Rel.restrictRng (\o -> let mq = hsnQualifier (ioccNm o) in isJust mq && fromJust mq /= modNm) + $ Rel.mapRng mentIdOcc $ mmiExps mmi + hasMain= HSSem.mainValExists_Syn_AGItf hsSem + ; when (isJust mbHS) + (do { cpUpdCU modNm ( ecuStoreHSSem hsSem + . ecuStoreHIDeclImpS ( -- (\v -> tr "YY" (pp $ Set.toList v) v) $ + ecuHSDeclImpNmS ecu) + -- . ecuSetHasMain hasMain + ) + ; when (ehcOptVerbosity opts >= VerboseDebug) + (lift $ putStrLn (show modNm ++ " hasMain=" ++ show hasMain)) + -- ; when hasMain (crSetAndCheckMain modNm) + }) + } + +{-# LINE 171 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldHsMod :: HsName -> EHCompilePhase () +cpFoldHsMod modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbHS = ecuMbHS ecu + inh = crsiHSModInh crsi + hsSemMod = HSSemMod.wrap_AGItf (HSSemMod.sem_AGItf $ panicJust "cpFoldHsMod" mbHS) + (inh { HSSemMod.gUniq_Inh_AGItf = crsiHereUID crsi + , HSSemMod.moduleNm_Inh_AGItf = modNm + }) + hasMain= HSSemMod.mainValExists_Syn_AGItf hsSemMod + pragmas = HSSemMod.fileHeaderPragmas_Syn_AGItf hsSemMod + (ecuOpts,modifiedOpts) + = ehcOptUpdateWithPragmas pragmas opts + ; when (isJust mbHS) + (cpUpdCU modNm ( ecuStoreHSSemMod hsSemMod + . ecuSetHasMain hasMain + . ecuStorePragmas pragmas + . (if modifiedOpts then ecuStoreOpts ecuOpts else id) + ) ) + } + +{-# LINE 199 "src/ehc/EHC/CompilePhase/Semantics.chs" #-} +cpFoldHIInfo :: HsName -> EHCompilePhase () +cpFoldHIInfo modNm + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + mbHIInfo = ecuMbPrevHIInfo ecu + hiInfo = panicJust "cpFoldHIInfo" mbHIInfo + hasMain = HI.hiiHasMain hiInfo + ; when (isJust mbHIInfo && HI.hiiValidity hiInfo == HI.HIValidity_Ok) + (do { let mm = crsiModMp crsi + mmi = Map.findWithDefault emptyModMpInfo modNm mm + mmi' = mkModMpInfo modNm + (mmiInscps mmi) + ( -- (\v -> tr "cpFoldHIInfo.hiiExps" (pp v) v) $ + HI.hiiExps hiInfo) + (HI.hiiHiddenExps hiInfo) + -- ; when hasMain (crSetAndCheckMain modNm) + ; cpUpdSI (\crsi -> crsi {crsiModMp = Map.insert modNm mmi' mm}) + ; cpUpdCU modNm ( ecuStorePrevHIInfo hiInfo + . ecuStoreHIDeclImpS (HI.hiiHIDeclImpModS hiInfo) + . ecuStoreHIUsedImpS (HI.hiiHIUsedImpModS hiInfo) + . ecuSetHasMain hasMain + ) + ; when (ehcOptVerbosity opts >= VerboseDebug) + (lift $ putStrLn + (show modNm + ++ ": hi imps, decl=" ++ show (HI.hiiHIDeclImpModS hiInfo) + ++ ", used=" ++ show (HI.hiiHIUsedImpModS hiInfo) + ) ) + }) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/TopLevelPhases.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/TopLevelPhases.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/TopLevelPhases.hs @@ -0,0 +1,812 @@ +module UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases +( cpEhcCheckAbsenceOfMutRecModules +, cpEhcFullProgCompileAllModules +, cpEhcFullProgModuleDetermineNeedsCompile +, cpEhcModuleCompile1 ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified UHC.Util.FastSeq as Seq +import Control.Monad.State +import qualified UHC.Light.Compiler.Config as Cfg +import System.IO.Unsafe +import Debug.Trace +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import UHC.Light.Compiler.EHC.CompilePhase.Parsers +import UHC.Light.Compiler.EHC.CompilePhase.Translations +import UHC.Light.Compiler.EHC.CompilePhase.Output +import UHC.Light.Compiler.EHC.CompilePhase.Transformations +import UHC.Light.Compiler.EHC.CompilePhase.Semantics +import UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase +import UHC.Light.Compiler.EHC.CompilePhase.CompileC +import UHC.Light.Compiler.EHC.CompilePhase.Run +import UHC.Light.Compiler.EHC.CompileGroup +import UHC.Light.Compiler.EHC.CompilePhase.Module +import UHC.Light.Compiler.Module.ImportExport +import qualified UHC.Light.Compiler.Core as Core (cModMerge) +import qualified UHC.Light.Compiler.Core.Merge as CMerge (cModMerge) +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import UHC.Light.Compiler.Base.PackageDatabase +import UHC.Light.Compiler.EHC.CompilePhase.Link +import UHC.Light.Compiler.Base.Pragma +import UHC.Light.Compiler.EHC.CompilePhase.Cleanup +{-# LINE 6 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Top level combinations, stratified into 6 levels, +where higher numbered levels use lower numbered levels. + +Levels: +1: processing building blocks +2: ehc compilation phases, including progress messages, stopping when asked for +3: ehc grouping of compilation phases for a single module +4: single module compilation +5: full program phases +6: full program compilation + +Naming convention for functions: +level 1 : with prefix 'cpProcess' +level 2..6 : with prefix 'cpEhc' + +-} + + + + + + + + + + + + + + +{-# LINE 112 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | top lever driver for after all per-module work has been done, and whole program stuff like combining/linking can start +cpEhcFullProgLinkAllModules :: [HsName] -> EHCompilePhase () +cpEhcFullProgLinkAllModules modNmL + = do { cr <- get + ; let (mainModNmL,impModNmL) = splitMain cr modNmL + (_,opts) = crBaseInfo' cr -- ' + ; when (not $ null modNmL) + (cpMsg (head modNmL) VerboseDebug ("Main mod split: " ++ show mainModNmL ++ ": " ++ show impModNmL)) + ; case (mainModNmL, ehcOptLinkingStyle opts) of + ([mainModNm], LinkingStyle_Exec) + -> case () of + () | ehcOptOptimizationScope opts >= OptimizationScope_WholeCore + -> cpSeq ( hpt + ++ exec + ) + | targetDoesHPTAnalysis (ehcOptTarget opts) + -> cpSeq $ hpt ++ exec + | otherwise + -> cpSeq exec + where exec = [ cpEhcExecutablePerModule FinalCompile_Exec impModNmL mainModNm ] + hpt = [ cpEhcFullProgPostModulePhases opts modNmL (impModNmL,mainModNm) + , cpEhcCorePerModulePart2 mainModNm + ] + ([mainModNm], _) + -> return () + -- cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MayNotHaveMain mainModNm] + ([], LinkingStyle_Exec) + -> cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MustHaveMain] + ([], LinkingStyle_None) + -> return () + ([], LinkingStyle_Pkg) + -> do let cfgwr o = liftIO $ pkgWritePkgOptionAsCfg o fp + where (fp,_) = mkInOrOutputFPathDirFor OutputFor_Pkg opts l l "" + l = mkFPath "" + case ehcOptPkgOpt opts of + Just (pkgopt@(PkgOption {pkgoptName=pkg})) -> do + cfgwr pkgopt + case () of + () | targetAllowsOLinking (ehcOptTarget opts) -> do + cpLinkO impModNmL pkg + _ -> return () + _ -> return () + } + where splitMain cr = partition (\n -> ecuHasMain $ crCU n cr) + +{-# LINE 170 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcCheckAbsenceOfMutRecModules :: EHCompilePhase () +cpEhcCheckAbsenceOfMutRecModules + = do { cr <- get + ; let mutRecL = filter (\ml -> length ml > 1) $ crCompileOrder cr + ; when (not $ null mutRecL) + (cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MutRecModules mutRecL] + ) + } + +{-# LINE 193 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgCompileAllModules :: EHCompilePhase () +cpEhcFullProgCompileAllModules + = do { cr <- get + ; let modNmLL = crCompileOrder cr + modNmL = map head modNmLL + ; cpSeq ( [] + ++ (let modNmL2 = filter (\m -> let (ecu,_,_,_) = crBaseInfo m cr in not $ filelocIsPkg $ ecuFileLocation ecu) modNmL + nrMods = length modNmL2 + in zipWith (\m i -> cpUpdCU m (ecuStoreSeqNr (EHCCompileSeqNr i nrMods)) ) modNmL2 [1..nrMods] + ) + ++ [cpEhcFullProgModuleCompileN modNmL] + ++ [cpEhcFullProgLinkAllModules modNmL] + ) + } + +{-# LINE 225 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase () +cpEhcFullProgPostModulePhases opts modNmL modSpl + | ehcOptOptimizationScope opts >= OptimizationScope_WholeCore = cpEhcCoreFullProgPostModulePhases opts modNmL modSpl + | otherwise = return () + +{-# LINE 267 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcCoreFullProgPostModulePhases :: EHCOpts -> [HsName] -> ([HsName],HsName) -> EHCompilePhase () +cpEhcCoreFullProgPostModulePhases opts modNmL (impModNmL,mainModNm) + = cpSeq ([ cpSeq [cpGetPrevCore m | m <- modNmL] + , mergeIntoOneBigCore + , cpTransformCore OptimizationScope_WholeCore mainModNm + , cpFlowHILamMp mainModNm + , cpProcessCoreFold mainModNm -- redo folding for replaced main module + ] + -- ++ (if ehcOptDumpCoreStages opts then [void $ cpOutputCore CPOutputCoreHow_Text "" "full.core" mainModNm] else []) + ++ [ cpMsg mainModNm VerboseDebug ("Full Core generated, from: " ++ show impModNmL) + ] + ) + where mergeIntoOneBigCore + = do { cr <- get + ; cpUpdCU mainModNm + $ ecuStoreCore + $ CMerge.cModMerge (mOf mainModNm cr, [ mOf m cr | m <- impModNmL ]) + ; cpCleanupCore impModNmL -- clean up Core and CoreSem (it can still be read through cr in the next statement) + } + where mOf m cr = panicJust "cpEhcCoreFullProgPostModulePhases.mergeIntoOneBigCore" $ ecuMbCore $ crCU m cr + +{-# LINE 292 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Per module compilation of (import) ordered sequence of module, as part of a full program compilation + +-} +{-# LINE 296 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgModuleCompileN :: [HsName] -> EHCompilePhase () +cpEhcFullProgModuleCompileN modNmL + = cpSeq (merge (map cpEhcFullProgModuleCompile1 modNmL) + (map cpEhcFullProgBetweenModuleFlow modNmL) + ) + where merge (c1:cs1) (c2:cs2) = c1 : c2 : merge cs1 cs2 + merge [] cs = cs + merge cs [] = cs + +{-# LINE 307 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Find out whether a compilation is needed, and if so, can be done. + +-} +{-# LINE 311 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgModuleDetermineNeedsCompile :: HsName -> EHCompilePhase () +cpEhcFullProgModuleDetermineNeedsCompile modNm + = do { cr <- get + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + needsCompile = crModNeedsCompile modNm cr + canCompile = crModCanCompile modNm cr + ; when (ehcOptVerbosity opts >= VerboseDebug) + (lift $ putStrLn + ( show modNm + ++ ", src fpath: " ++ show (ecuSrcFilePath ecu) + ++ ", fileloc: " ++ show (ecuFileLocation ecu) + ++ ", needs compile: " ++ show needsCompile + ++ ", can compile: " ++ show canCompile + ++ ", can use HI instead of HS: " ++ show (ecuCanUseHIInsteadOfHS ecu) + ++ ", has main: " ++ show (ecuHasMain ecu) + ++ ", is main: " ++ show (ecuIsMainMod ecu) + ++ ", is top: " ++ show (ecuIsTopMod ecu) + ++ ", valid HI: " ++ show (ecuIsValidHIInfo ecu) + ++ ", HS newer: " ++ show (ecuIsHSNewerThanHI ecu) + )) + ; cpUpdCU modNm (ecuSetNeedsCompile (needsCompile && canCompile)) + } + +{-# LINE 336 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Compilation of 1 module, as part of a full program compilation + +-} +{-# LINE 340 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgModuleCompile1 :: HsName -> EHCompilePhase () +cpEhcFullProgModuleCompile1 modNm + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr -- ' + ; when (ehcOptVerbosity opts >= VerboseALot) + (lift $ putStrLn ("====================== Compile1: " ++ show modNm ++ "======================")) + ; cpEhcFullProgModuleDetermineNeedsCompile modNm + ; cr <- get + ; let (ecu,_,_,_) = crBaseInfo modNm cr + targ = ecuFinalDestinationState ecu -- ECUS_Haskell $ if ecuNeedsCompile ecu then HSAllSem else HIAllSem + ; cpEhcModuleCompile1 (Just targ) modNm + ; cr <- get + ; let (ecu,_,_,_) = crBaseInfo modNm cr + -- ; return () + ; when (ecuHasMain ecu) (crSetAndCheckMain modNm) + } + +{-# LINE 359 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Flow of info between modules, as part of a full program compilation + +-} +{-# LINE 363 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcFullProgBetweenModuleFlow :: HsName -> EHCompilePhase () +cpEhcFullProgBetweenModuleFlow modNm + = do { cr <- get + ; case ecuState $ crCU modNm cr of + ECUS_Haskell HSAllSem -> return () + ECUS_Haskell HIAllSem -> cpFlowHISem modNm + _ -> return () + ; cpCleanupFlow modNm + } + +{-# LINE 385 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcModuleCompile1 :: Maybe EHCompileUnitState -> HsName -> EHCompilePhase HsName +cpEhcModuleCompile1 targHSState modNm +{-# LINE 389 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} + = do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + defaultResult = modNm + ; when (ehcOptVerbosity opts >= VerboseALot) + (lift $ putStrLn ("====================== Module: " ++ show modNm ++ " ======================")) + ; when (ehcOptVerbosity opts >= VerboseDebug) + (lift $ putStrLn ("State: in: " ++ show (ecuState ecu) ++ ", to: " ++ show targHSState)) + ; case (ecuState ecu,targHSState) of +{-# LINE 417 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} + (ECUS_Haskell st,Just (ECUS_Haskell HSOnlyImports)) + | st == HSStart + || st == LHSStart + -> do { cpEhcHaskellModulePrepareSrc modNm + ; modNm2 <- cpEhcHaskellImport stnext + (pkgExposedPackages $ ehcOptPkgDb opts) + modNm + ; cpEhcHaskellModulePrepareHS2 modNm2 + ; cpMsg modNm2 VerboseNormal ("Imports of " ++ hsstateShowLit st ++ "Haskell") + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm2 cr + ; lift $ putStrLn ("After HS import: nm=" ++ show modNm ++ ", newnm=" ++ show modNm2 ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu)) + }) + ; cpUpdCU modNm2 (ecuStoreState (ECUS_Haskell stnext)) + ; cpStopAt CompilePoint_Imports + ; return modNm2 + } + where stnext = hsstateNext st + (ECUS_Haskell HIStart,Just (ECUS_Haskell HSOnlyImports)) + -> do { cpMsg modNm VerboseNormal ("Imports of HI") + ; cpEhcHaskellModulePrepareHI modNm + ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell (hsstateNext HIStart))) + ; when (ehcOptVerbosity opts >= VerboseDebug) + (do { cr <- get + ; let (ecu,_,opts,fp) = crBaseInfo modNm cr + ; lift $ putStrLn ("After HI import: nm=" ++ show modNm ++ ", fp=" ++ show fp ++ ", imp=" ++ show (ecuImpNmS ecu)) + }) + ; return defaultResult + } + (ECUS_Haskell st,Just (ECUS_Haskell HSOnlyImports)) + | st == HSOnlyImports + || st == HIOnlyImports + || st == LHSOnlyImports + -> return defaultResult + (ECUS_Haskell st,Just (ECUS_Haskell HSAllSem)) + | st == HSOnlyImports + || st == LHSOnlyImports + -> do { cpMsg modNm VerboseMinimal ("Compiling " ++ hsstateShowLit st ++ "Haskell") + ; cpEhcHaskellModuleAfterImport (ecuIsTopMod ecu) opts st + (pkgExposedPackages $ ehcOptPkgDb opts) + modNm + ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HSAllSem)) + ; return defaultResult + } + (ECUS_Haskell st,Just (ECUS_Haskell HIAllSem)) + | st == HSOnlyImports + || st == HIOnlyImports + || st == LHSOnlyImports + -> do { cpMsg modNm VerboseNormal "Reading HI" + ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HIAllSem)) + ; return defaultResult + } + +{-# LINE 488 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} + (ECUS_Haskell HSStart,_) + -> do { cpMsg modNm VerboseMinimal "Compiling Haskell" + ; cpEhcHaskellModulePrepare modNm + ; cpEhcHaskellParse + (ehcOptCPP opts) False + (pkgExposedPackages $ ehcOptPkgDb opts) + modNm + ; cpEhcHaskellModuleCommonPhases True True opts modNm + ; when (ehcOptWholeProgHPTAnalysis opts) + (cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm) + ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HSAllSem)) + ; return defaultResult + } + (ECUS_Haskell st,Just (ECUS_Haskell HMOnlyMinimal)) + | st == HIStart || st == HSStart -- st /= HMOnlyMinimal + -> do { let mod = emptyMod' modNm + ; cpUpdCU modNm (ecuStoreMod mod) + -- ; cpCheckMods [modNm] + ; cpUpdCU modNm (ecuStoreState (ECUS_Haskell HMOnlyMinimal)) + ; return defaultResult + } + (ECUS_Core cst, Just (ECUS_Haskell HSOnlyImports)) + | cst == CRStartText || isBinary + -> do { cpMsg modNm VerboseNormal $ "Reading Core (" ++ (if isBinary then "binary" else "textual") ++ ")" + -- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first... + ; cpEhcHaskellModulePrepareSrc modNm + ; modNm2 <- cpEhcCoreImport isBinary modNm + ; cpGetDummyCheckSrcMod modNm2 -- really dummy, should be based on actual import info to be extracted by cpEhcCoreImport + ; cpUpdCU modNm2 (ecuStoreState (ECUS_Core CROnlyImports)) + ; return modNm2 + } + where isBinary = cst == CRStartBinary + (ECUS_Core CROnlyImports,Just (ECUS_Core CRAllSem)) + -> do { cpMsg modNm VerboseMinimal "Compiling Core" + -- 20140605 AD, code below is temporary, to cater for minimal and working infrastructure first... + ; cpEhcCoreModuleAfterImport (ecuIsTopMod ecu) opts modNm +{- + ; cpProcessCoreModFold modNm + ; cpEhcCoreModuleCommonPhases True True True {- isMainMod isTopMod doMkExec -} opts modNm +-} + ; cpUpdCU modNm (ecuStoreState (ECUS_Core CRAllSem)) + ; return defaultResult + } + (_,Just (ECUS_Haskell HSOnlyImports)) + -> return defaultResult + (ECUS_Eh EHStart,_) + -> do { cpMsg modNm VerboseMinimal "Compiling EH" + ; cpUpdOpts (\o -> o {ehcOptHsChecksInEH = True}) + ; cpEhcEhParse modNm + ; cpGetDummyCheckSrcMod modNm + ; cpEhcEhModuleCommonPhases True True True opts modNm + + ; when (ehcOptWholeProgHPTAnalysis opts) + (cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm) + ; cpUpdCU modNm (ecuStoreState (ECUS_Eh EHAllSem)) + ; return defaultResult + } + (ECUS_C CStart,_) + | targetIsOnUnixAndOrC (ehcOptTarget opts) + -> do { cpSeq [ cpMsg modNm VerboseMinimal "Compiling C" + , cpCompileWithGCC FinalCompile_Module [] modNm + , cpUpdCU modNm (ecuStoreState (ECUS_C CAllSem)) + ] + ; return defaultResult + } + | otherwise + -> do { cpMsg modNm VerboseMinimal "Skipping C" + ; return defaultResult + } + (ECUS_O OStart,_) + | targetIsOnUnixAndOrC (ehcOptTarget opts) + -> do { cpSeq [ cpMsg modNm VerboseMinimal "Passing through .o file" + -- , cpCompileWithGCC FinalCompile_Module [] modNm + , cpUpdCU modNm (ecuStoreState (ECUS_O OAllSem)) + ] + ; return defaultResult + } + | otherwise + -> do { cpMsg modNm VerboseMinimal "Skipping .o file" + ; return defaultResult + } + _ -> return defaultResult + } + +{-# LINE 607 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +EH common phases: analysis + core + grin + +-} +{-# LINE 611 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcCoreModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase () +cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm + = cpSeq ([ + cpEhcCorePerModulePart1 modNm + ] + ) + +{-# LINE 628 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcEhModuleCommonPhases :: Bool -> Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase () +cpEhcEhModuleCommonPhases isMainMod isTopMod doMkExec opts modNm + = cpSeq [ cpEhcEhAnalyseModuleDefs modNm + , cpEhcCoreModuleCommonPhases isMainMod isTopMod doMkExec opts modNm + ] + +{-# LINE 636 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Common phases when starting with a Haskell module. +-- HS common phases: HS analysis + EH common +cpEhcHaskellModuleCommonPhases :: Bool -> Bool -> EHCOpts -> HsName -> EHCompilePhase () +cpEhcHaskellModuleCommonPhases isTopMod doMkExec opts modNm + = cpSeq [ cpEhcHaskellAnalyseModuleDefs modNm + , do { cr <- get + ; let (ecu,_,_,_) = crBaseInfo modNm cr + ; cpEhcEhModuleCommonPhases + (ecuIsMainMod ecu) + isTopMod doMkExec opts modNm + } + ] + +{-# LINE 655 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | All the work to be done after Haskell src imports have been read/analysed. +-- Post module import common phases: Parse + Module analysis + HS common +cpEhcHaskellModuleAfterImport + :: Bool -> EHCOpts -> HSState + -> [PkgModulePartition] + -> HsName -> EHCompilePhase () +cpEhcHaskellModuleAfterImport + isTopMod opts hsst + pkgKeyDirL + modNm + = cpSeq [ cpEhcHaskellParse False (hsstateIsLiteral hsst) + pkgKeyDirL + modNm + , cpEhcHaskellAnalyseModuleItf modNm + , cpEhcHaskellModuleCommonPhases isTopMod False opts modNm + , cpEhcHaskellModulePostlude modNm + ] + +{-# LINE 681 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | All the work to be done after Core src/binary imports have been read/analysed +cpEhcCoreModuleAfterImport + :: Bool -> EHCOpts + -> HsName -> EHCompilePhase () +cpEhcCoreModuleAfterImport + isTopMod opts + modNm + = do { cr <- get + ; let (ecu,_,_,_) = crBaseInfo modNm cr + ; cpSeq + [ cpEhcCoreAnalyseModuleItf modNm + , cpProcessCoreModFold modNm + , cpEhcCoreModuleCommonPhases (ecuIsMainMod ecu) isTopMod False opts modNm +{- + , cpEhcHaskellModuleCommonPhases isTopMod False opts modNm + , cpEhcHaskellModulePostlude modNm +-} + ] + } + +{-# LINE 707 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +{-| +Prepare module for compilation. +This should be the first step before compilation of a module and is meant to obtain cached info from a previous compilation. + +-} +{-# LINE 724 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcHaskellModulePrepareSrc :: HsName -> EHCompilePhase () +cpEhcHaskellModulePrepareSrc modNm + = cpGetMetaInfo [GetMeta_Src,GetMeta_Dir] modNm + +cpEhcHaskellModulePrepareHS2 :: HsName -> EHCompilePhase () +cpEhcHaskellModulePrepareHS2 modNm + = cpSeq [ cpGetMetaInfo + [ GetMeta_Src, GetMeta_HI, GetMeta_Core + , GetMeta_Dir + ] modNm + , cpGetPrevHI modNm + -- , cpFoldHI modNm + , cpFoldHIInfo modNm + ] + +cpEhcHaskellModulePrepareHI :: HsName -> EHCompilePhase () +cpEhcHaskellModulePrepareHI modNm + = cpSeq [ cpGetMetaInfo + [ GetMeta_HI, GetMeta_Core + ] modNm + , cpGetPrevHI modNm + -- , cpFoldHI modNm + , cpFoldHIInfo modNm + ] + +cpEhcHaskellModulePrepare :: HsName -> EHCompilePhase () +cpEhcHaskellModulePrepare modNm + = cpSeq [ cpEhcHaskellModulePrepareSrc modNm + , cpEhcHaskellModulePrepareHS2 modNm + ] + +{-# LINE 763 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcHaskellModulePostlude :: HsName -> EHCompilePhase () +cpEhcHaskellModulePostlude modNm + = cpSeq [ cpOutputHI "hi" modNm + , cpCleanupCU modNm + ] + +{-# LINE 773 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Get import information from Haskell module source text. +cpEhcHaskellImport + :: HSState + -> [PkgModulePartition] + -> HsName -> EHCompilePhase HsName +cpEhcHaskellImport + hsst + pkgKeyDirL + modNm + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr + + -- 1st, parse + ; cppAndParse modNm + (ehcOptCPP opts) + ; cpStepUID + + -- and then get pragmas and imports + ; modNm' <- foldAndImport modNm + ; cr2 <- get + ; let (ecu,_,opts2,_) = crBaseInfo modNm' cr2 + + -- if we find out that CPP should have invoked or cmdline options (pragma OPTIONS_UHC) have been specified, + -- we backtrack to the original runstate and redo the above with CPP + ; if (not (ehcOptCPP opts2) -- reinvoke if CPP has not been invoked before + || ehcOptCmdLineOptsDoneViaPragma opts2 -- or options have been set via pragma + ) + -- check whether the pragma has a cmdline option like effect + && (not $ null $ filter pragmaInvolvesCmdLine $ Set.toList $ ecuPragmas ecu) -- Set.member Pragma_CPP (ecuPragmas ecu) + then do { put cr + ; when (isJust $ ecuMbOpts ecu) + (cpUpdCU modNm (ecuStoreOpts opts2)) + ; cppAndParse modNm (ehcOptCPP opts || Set.member Pragma_CPP (ecuPragmas ecu)) + ; cpStepUID + ; foldAndImport modNm + } + else return modNm' + } + where cppAndParse modNm + doCPP + = cpSeq [ when doCPP (cpPreprocessWithCPP pkgKeyDirL modNm) + , cpParseHsImport (hsstateIsLiteral hsst) modNm + ] + foldAndImport modNm + = do { cpFoldHsMod modNm + ; cpGetHsModnameAndImports modNm + } + +{-# LINE 838 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Parse a Haskell module +cpEhcHaskellParse + :: Bool -> Bool + -> [PkgModulePartition] + -> HsName -> EHCompilePhase () +cpEhcHaskellParse + doCPP litmode + pkgKeyDirL + modNm + = cpSeq ( + (if doCPP then [cpPreprocessWithCPP pkgKeyDirL modNm] else []) + ++ [ cpParseHs litmode modNm ] + ++ [ cpMsg modNm VerboseALot "Parsing done" + , cpStopAt CompilePoint_Parse + ] + ) + +{-# LINE 865 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcEhParse :: HsName -> EHCompilePhase () +cpEhcEhParse modNm + = cpSeq [ cpParseEH modNm + , cpStopAt CompilePoint_Parse + ] + +{-# LINE 873 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpEhcCoreParse :: HsName -> EHCompilePhase () +cpEhcCoreParse modNm + = cpSeq [ cpParseCoreWithFPath Nothing modNm + , cpStopAt CompilePoint_Parse + ] + +{-# LINE 881 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Analyse a Haskell src module for +-- (1) module information (import, export, etc), +cpEhcHaskellAnalyseModuleItf :: HsName -> EHCompilePhase () +cpEhcHaskellAnalyseModuleItf modNm + = cpSeq [ cpStepUID, cpFoldHsMod modNm, cpGetHsMod modNm + , cpCheckMods [modNm] + , cpCleanupHSMod modNm + ] + +{-# LINE 897 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Analyse a Core text/binary src module for +-- (1) module information (import, export, etc), +cpEhcCoreAnalyseModuleItf :: HsName -> EHCompilePhase () +cpEhcCoreAnalyseModuleItf modNm + = cpSeq [ cpCheckMods [modNm] + -- , cpCleanupHSMod modNm + ] + +{-# LINE 912 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Analyse a Haskell src module for +-- (2) names + dependencies +cpEhcHaskellAnalyseModuleDefs :: HsName -> EHCompilePhase () +cpEhcHaskellAnalyseModuleDefs modNm + = cpSeq [ cpStepUID + , cpProcessHs modNm + , cpMsg modNm VerboseALot "Name+dependency analysis done" + , cpStopAt CompilePoint_AnalHS + ] + +{-# LINE 924 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Analyse a Haskell src module for +-- (3) types +cpEhcEhAnalyseModuleDefs :: HsName -> EHCompilePhase () +cpEhcEhAnalyseModuleDefs modNm + = cpSeq [ cpStepUID, cpProcessEH modNm + , cpMsg modNm VerboseALot "Type analysis done" + , cpStopAt CompilePoint_AnalEH + ] + +{-# LINE 935 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Part 1 Core processing, on a per module basis, part1 is done always +cpEhcCorePerModulePart1 :: HsName -> EHCompilePhase () +cpEhcCorePerModulePart1 modNm + = do { cr <- get + ; let (_,_,opts,_) = crBaseInfo modNm cr + earlyMerge = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore + ; cpSeq + ( [ cpStepUID ] + ++ [ cpProcessCoreBasic modNm + , cpMsg modNm VerboseALot "Core (basic) done" + , when (not earlyMerge) $ cpProcessCoreRest modNm + , cpStopAt CompilePoint_Core + ] + ) + } + +{-# LINE 967 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Get import information from Core module source text. +cpEhcCoreImport + :: Bool -> HsName -> EHCompilePhase HsName +cpEhcCoreImport + isBinary modNm + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr + + ; if isBinary + then -- cpDecodeCore (Just Cfg.suffixDotlessInputOutputBinaryCore) modNm + cpDecodeCore Nothing modNm + else cpParseCoreWithFPath Nothing modNm + ; cpFoldCoreMod modNm + ; cpGetCoreModnameAndImports modNm + } + +{-# LINE 985 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Analyse a Core src module +cpEhcCoreAnalyseModule :: HsName -> EHCompilePhase () +cpEhcCoreAnalyseModule modNm + = do { cr <- get + ; cpUpdateModOffMp [modNm] + ; let (ecu,_,opts,_) = crBaseInfo modNm cr + coreSem = panicJust "cpEhcCoreAnalyseModule" $ ecuMbCoreSemMod ecu + errs = Seq.toList $ Core2ChkSem.errs_Syn_CodeAGItf coreSem + ; cpSetLimitErrsWhen 5 "Core analysis" errs + } + +{-# LINE 998 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Part 2 Core processing, part2 is done either for per individual module compilation or after full program analysis +cpEhcCorePerModulePart2 :: HsName -> EHCompilePhase () +cpEhcCorePerModulePart2 modNm + = do { cr <- get + ; let (_,_,opts,_) = crBaseInfo modNm cr + earlyMerge = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore + ; cpSeq [ when earlyMerge $ cpProcessCoreRest modNm + ] + } + +{-# LINE 1042 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Core+grin processing, on a per module basis, may only be done when full program analysis is done +cpEhcCoreGrinPerModuleDoneFullProgAnalysis :: HsName -> EHCompilePhase () +cpEhcCoreGrinPerModuleDoneFullProgAnalysis modNm + = cpSeq ( [ cpEhcCorePerModulePart2 modNm + , cpEhcExecutablePerModule FinalCompile_Exec [] modNm + , cpMsg modNm VerboseALot "Full Program Analysis (Core+Grin) done" + ] + ) + +{-# LINE 1053 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- | Make final executable code, either still partly or fully (i.e. also linking) +cpEhcExecutablePerModule :: FinalCompileHow -> [HsName] -> HsName -> EHCompilePhase () +cpEhcExecutablePerModule how impModNmL modNm + = do { cr <- get + ; let (_,_,opts,_) = crBaseInfo modNm cr + ; cpSeq $ + [ cpCompileWithGCC how impModNmL modNm ] + } + +{-# LINE 1079 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpProcessHs :: HsName -> EHCompilePhase () +cpProcessHs modNm + = cpSeq [ cpFoldHs modNm + , cpFlowHsSem1 modNm + , cpTranslateHs2EH modNm + , cpCleanupHS modNm + ] + +{-# LINE 1093 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpProcessEH :: HsName -> EHCompilePhase () +cpProcessEH modNm + = do { cr <- get + ; let (_,_,opts,fp) = crBaseInfo modNm cr + {- + optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { s <- execStateT (do { cpMsg modNm VerboseALot ("EH>: " ++ s) + ; x `seq` cpMsg modNm VerboseALot ("EH<: " ++ s) + }) cr + ; return x + }) } + -- optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { putCompileMsg VerboseALot (ehcOptVerbosity opts) ("EH: " ++ s) Nothing modNm fp ; return x }) } + -- optsTr = opts { ehcOptTrace = \s x -> unsafePerformIO (do { putStrLn ("EH: " ++ s) ; return x }) } + -- optsTr = opts { ehcOptTrace = trace } + -- ; cpUpdStateInfo (\crsi -> crsi {crsiOpts = optsTr}) + ; cpUpdCU modNm (ecuStoreOpts optsTr) + -} + ; cpSeq [ cpFoldEH modNm + , cpCleanupFoldEH modNm + , cpFlowEHSem1 modNm + , cpTranslateEH2Output modNm + , + cpTranslateEH2Core modNm + , cpCleanupEH modNm + ] + } + +{-# LINE 1155 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- unprocessed core -> folded core +cpProcessCoreBasic :: HsName -> EHCompilePhase () +cpProcessCoreBasic modNm + = do { cr <- get + ; let (_,_,opts,_) = crBaseInfo modNm cr + ; cpSeq [ cpTransformCore OptimizationScope_PerModule modNm + , cpFlowHILamMp modNm + -- , when (ehcOptEmitCore opts) (void $ cpOutputCore CPOutputCoreHow_Binary "" "core" modNm) + , void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessBinaryCore modNm + , cpProcessCoreFold modNm + ] + } + +{-# LINE 1175 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- unfolded core -> folded core +-- (called on merged core, and on core directly generated from cached grin) +cpProcessCoreFold :: HsName -> EHCompilePhase () +cpProcessCoreFold modNm + = cpSeq $ + [ cpFlowCoreSemBeforeFold modNm ] ++ + [ cpFoldCore2Grin modNm ] + ++ [ cpFlowCoreSemAfterFold modNm ] + +{-# LINE 1190 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +cpProcessCoreModFold :: HsName -> EHCompilePhase () +cpProcessCoreModFold modNm + = cpSeq $ + [ cpEhcCoreAnalyseModule modNm + , cpFlowCoreModSem modNm + ] + +{-# LINE 1199 "src/ehc/EHC/CompilePhase/TopLevelPhases.chs" #-} +-- folded core -> grin, jazy, and the rest +cpProcessCoreRest :: HsName -> EHCompilePhase () +cpProcessCoreRest modNm + = do { cr <- get + ; let (_,_,opts,_) = crBaseInfo modNm cr + ; cpSeq ( [] + ++ (if CoreOpt_Dump `elem` ehcOptCoreOpts opts + then [void $ cpOutputCore CPOutputCoreHow_Text [] "" Cfg.suffixDotlessOutputTextualCore modNm] + else []) + ++ (if CoreOpt_DumpBinary `elem` ehcOptCoreOpts opts + then [void $ cpOutputCore CPOutputCoreHow_Binary [] "" Cfg.suffixDotlessInputOutputBinaryCore modNm] + else []) + ++ (if CoreOpt_RunDump `elem` ehcOptCoreOpts opts + then [void $ cpOutputCore CPOutputCoreHow_Run [] "" Cfg.suffixDotlessInputOutputCoreRun modNm] + else []) + ++ (if CoreOpt_Run `elem` ehcOptCoreOpts opts -- TBD: only when right backend? For now, just do it + then [cpRunCoreRun modNm] + else []) + ++ [ cpCleanupCore [modNm] ] + ) + } + + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Transformations.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Transformations.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Transformations.hs @@ -0,0 +1,74 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Transformations +( cpTransformCore ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad.State +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.CodeGen.TrfUtils +import UHC.Light.Compiler.Core.Trf +import UHC.Light.Compiler.EHC.CompilePhase.Output +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import qualified UHC.Light.Compiler.HI as HI +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import UHC.Light.Compiler.EHC.CompilePhase.Module(cpUpdHiddenExports) + + + + + + + + + + +{-# LINE 71 "src/ehc/EHC/CompilePhase/Transformations.chs" #-} +cpTransformCore :: OptimizationScope -> HsName -> EHCompilePhase () +cpTransformCore optimScope modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + ; cpMsg' modNm VerboseALot "Transforming Core ..." Nothing fp + + -- transform + ; let mbCore = ecuMbCore ecu + coreInh = crsiCoreInh crsi + trfcoreIn = emptyTrfCore + { trfstMod = panicJust "cpTransformCore" mbCore + , trfstUniq = crsiNextUID crsi + , trfstExtra = emptyTrfCoreExtra + { trfcoreECUState = ecuState ecu + , trfcoreIsLamLifted = maybe False Core2ChkSem.isLamLifted_Syn_CodeAGItf $ ecuMbCoreSemMod ecu + , trfcoreExpNmOffMp = crsiExpNmOffMp modNm crsi + , trfcoreInhLamMp = Core2GrSem.lamMp_Inh_CodeAGItf $ crsiCoreInh crsi + } + } + trfcoreOut = trfCore opts optimScope (Core2GrSem.dataGam_Inh_CodeAGItf $ crsiCoreInh crsi) modNm trfcoreIn + + -- ; lift $ putStrLn $ "cpTransformCore trfcoreIsLamLifted: " ++ show (trfcoreIsLamLifted $ trfstExtra trfcoreIn) + -- put back result: Core + ; cpUpdCU modNm $! ecuStoreCore (trfstMod trfcoreOut) + + -- put back result: unique counter + ; cpSetUID (trfstUniq trfcoreOut) + + -- put back result: call info map (lambda arity, ...) + ; let hii = ecuHIInfo ecu + lamMp = HI.hiiLamMp hii + ; cpUpdCU modNm + ( ecuStoreHIInfo + (hii { HI.hiiLamMp = (trfcoreGathLamMp $ trfstExtra trfcoreOut) `Map.union` lamMp + }) + ) + -- put back result: additional hidden exports, it should be in a cpFlowXX variant + ; cpUpdHiddenExports modNm $ zip (Set.toList $ trfcoreExtraExports $ trfstExtra trfcoreOut) (repeat IdOcc_Val) + + -- dump intermediate stages, print errors, if any + ; let (nms,mcs,errs) = unzip3 $ trfstModStages trfcoreOut + ; cpOutputCoreModules CPOutputCoreHow_Text [{- CoreOpt_DumpAlsoNonParseable -}] (\n nm -> "-" ++ show optimScope ++ "-" ++ show n ++ "-" ++ nm) Cfg.suffixDotlessOutputTextualCore modNm [ (n,nm) | (n, Just nm) <- zip nms mcs ] + ; cpSeq $ zipWith (\nm err -> cpSetLimitErrsWhen 5 ("Core errors: " ++ nm) err) nms errs + } + diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs @@ -0,0 +1,80 @@ +module UHC.Light.Compiler.EHC.CompilePhase.Translations +( cpTranslateHs2EH +, cpTranslateEH2Output +, cpTranslateEH2Core ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import qualified UHC.Util.FastSeq as Seq +import Control.Monad.State +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import UHC.Light.Compiler.EHC.CompileRun +import UHC.Light.Compiler.Base.Target +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.EHC.CompilePhase.Module +import UHC.Light.Compiler.CodeGen.ValAccess as VA +import UHC.Light.Compiler.CodeGen.RefGenerator + + + + + + + + +{-# LINE 94 "src/ehc/EHC/CompilePhase/Translations.chs" #-} +cpTranslateHs2EH :: HsName -> EHCompilePhase () +cpTranslateHs2EH modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + mbHsSem= ecuMbHSSem ecu + hsSem = panicJust "cpTranslateHs2EH" mbHsSem + eh = HSSem.eh_Syn_AGItf hsSem + errs = Seq.toList $ HSSem.errSq_Syn_AGItf hsSem + ; when (isJust mbHsSem) + (do { cpUpdCU modNm (ecuStoreEH eh) + ; cpSetLimitErrsWhen 5 "Dependency/name analysis" errs + ; when (ehcOptEmitHS opts) + (lift $ putPPFPath (mkOutputFPath opts modNm fp "hs2") (HSSem.pp_Syn_AGItf hsSem) 1000) + ; when (ehcOptShowHS opts) + (lift $ putWidthPPLn 120 (HSSem.pp_Syn_AGItf hsSem)) + }) + } + +{-# LINE 114 "src/ehc/EHC/CompilePhase/Translations.chs" #-} +cpTranslateEH2Output :: HsName -> EHCompilePhase () +cpTranslateEH2Output modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + mbEHSem= ecuMbEHSem ecu + ehSem = panicJust "cpTranslateEH2Output" mbEHSem + about = "EH analyses: Type checking" + errs = Seq.toList $ EHSem.allErrSq_Syn_AGItf ehSem + ; when (isJust mbEHSem) + (do { cpSetLimitErrsWhen 5 about errs + ; when (ehcOptEmitEH opts) + (lift $ putPPFPath (mkOutputFPath opts modNm fp "eh2") (EHSem.pp_Syn_AGItf ehSem) 1000) + ; when (ehcOptShowEH opts) + (lift $ putWidthPPLn 120 (EHSem.pp_Syn_AGItf ehSem)) + } + ) + } + +{-# LINE 159 "src/ehc/EHC/CompilePhase/Translations.chs" #-} +cpTranslateEH2Core :: HsName -> EHCompilePhase () +cpTranslateEH2Core modNm + = do { cr <- get + ; let (ecu,crsi,opts,fp) = crBaseInfo modNm cr + mbEHSem= ecuMbEHSem ecu + ehSem = panicJust "cpTranslateEH2Core" mbEHSem + core = cmodTrfElimNonCodegenConstructs opts $ EHSem.cmodule_Syn_AGItf ehSem + ; when (isJust mbEHSem) + (cpUpdCU modNm ( ecuStoreCore core + )) + } + diff --git a/src/UHC/Light/Compiler/EHC/CompileRun.hs b/src/UHC/Light/Compiler/EHC/CompileRun.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompileRun.hs @@ -0,0 +1,321 @@ +module UHC.Light.Compiler.EHC.CompileRun +( EHCompileRunStateInfo (..) +, emptyEHCompileRunStateInfo +, EHCompileRun, EHCompilePhase +, crBaseInfo, crBaseInfo' +, cpUpdOpts +, cpMsg, cpMsg' +, cpStepUID, cpSetUID +, cpSystem', cpSystem +, cpSystemRaw +, cpStopAt +, crsiExpNmOffMp +, crModNeedsCompile +, crModCanCompile +, crSetAndCheckMain +, EHCTime, EHCTimeDiff, getEHCTime, ehcTimeDiff, ehcTimeDiffFmt +, EHCIOInfo (..), newEHCIOInfo +, cpRegisterFilesToRm +, cpRmFilesToRm +, crPartitionIntoPkgAndOthers ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import System.IO +import System.Exit +import System.Environment +import System.Process +import Control.Monad.State +import UHC.Light.Compiler.CodeGen.ValAccess as VA +import UHC.Light.Compiler.EHC.Common +import UHC.Light.Compiler.EHC.CompileUnit +import qualified UHC.Light.Compiler.Core as Core +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import UHC.Light.Compiler.EHC.CompileGroup +import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod +import UHC.Light.Compiler.Module.ImportExport +import UHC.Util.Time +import System.CPUTime +import System.Locale +import Data.IORef +import System.IO.Unsafe +import System.Directory +import Control.Exception as CE +import UHC.Util.FPath +import UHC.Light.Compiler.Base.PackageDatabase + + + + + + + + + + + + +{-# LINE 68 "src/ehc/EHC/CompileRun.chs" #-} +type EHCTime = Integer +type EHCTimeDiff = Integer + +getEHCTime :: IO EHCTime +getEHCTime = getCPUTime + +ehcTimeDiff :: EHCTime -> EHCTime -> EHCTimeDiff +ehcTimeDiff = (-) + +ehcTimeDiffFmt :: EHCTimeDiff -> String +ehcTimeDiffFmt t + = fm 2 hrs ++ ":" ++ fm 2 mins ++ ":" ++ fm 2 secs ++ ":" ++ fm 6 (psecs `div` 1000000) + where (r0 , psecs) = t `quotRem` 1000000000000 + (r1 , secs ) = r0 `quotRem` 60 + (r2 , mins ) = r1 `quotRem` 60 + (days, hrs ) = r2 `quotRem` 24 + fm n x = strPadLeft '0' n (show x) + +{-# LINE 88 "src/ehc/EHC/CompileRun.chs" #-} +data EHCIOInfo + = EHCIOInfo + { ehcioinfoStartTime :: EHCTime + , ehcioinfoLastTime :: EHCTime + } + +newEHCIOInfo :: IO (IORef EHCIOInfo) +newEHCIOInfo + = do t <- getEHCTime + newIORef (EHCIOInfo t t) + + +{-# LINE 122 "src/ehc/EHC/CompileRun.chs" #-} +data EHCompileRunStateInfo + = EHCompileRunStateInfo + { crsiOpts :: !EHCOpts -- options + , crsiNextUID :: !UID -- unique id, the next one + , crsiHereUID :: !UID -- unique id, the current one + , crsiHSInh :: !HSSem.Inh_AGItf -- current inh attrs for HS sem + , crsiEHInh :: !EHSem.Inh_AGItf -- current inh attrs for EH sem + , crsiCoreInh :: !Core2GrSem.Inh_CodeAGItf -- current inh attrs for Core2Grin sem + , crsiMbMainNm :: !(Maybe HsName) -- name of main module, if any + , crsiHSModInh :: !HSSemMod.Inh_AGItf -- current inh attrs for HS module analysis sem + , crsiModMp :: !ModMp -- import/export info for modules + , crsiGrpMp :: (Map.Map HsName EHCompileGroup) -- not yet used, for mut rec modules + , crsiOptim :: !Optim -- inter module optimisation info + , crsiModOffMp :: !VA.HsName2FldMpMp -- mapping of all modules + exp entries to offsets in module + exp tables + , crsiEHCIOInfo :: !(IORef EHCIOInfo) -- unsafe info + , crsiFilesToRm :: ![FPath] -- files to clean up (remove) + } + +{-# LINE 150 "src/ehc/EHC/CompileRun.chs" #-} +emptyEHCompileRunStateInfo :: EHCompileRunStateInfo +emptyEHCompileRunStateInfo + = EHCompileRunStateInfo + { crsiOpts = defaultEHCOpts + , crsiNextUID = uidStart + , crsiHereUID = uidStart + , crsiHSInh = panic "emptyEHCompileRunStateInfo.crsiHSInh" + , crsiEHInh = panic "emptyEHCompileRunStateInfo.crsiEHInh" + , crsiCoreInh = panic "emptyEHCompileRunStateInfo.crsiCoreInh" + , crsiMbMainNm = Nothing + , crsiHSModInh = panic "emptyEHCompileRunStateInfo.crsiHSModInh" + , crsiModMp = Map.empty + , crsiGrpMp = Map.empty + , crsiOptim = defaultOptim + , crsiModOffMp = Map.empty + , crsiEHCIOInfo = panic "emptyEHCompileRunStateInfo.crsiEHCIOInfo" + , crsiFilesToRm = [] + } + +{-# LINE 179 "src/ehc/EHC/CompileRun.chs" #-} +crsiExpNmOffMp :: HsName -> EHCompileRunStateInfo -> VA.HsName2FldMp +crsiExpNmOffMp modNm crsi = mmiNmOffMp $ panicJust ("crsiExpNmOffMp: " ++ show modNm) $ Map.lookup modNm $ crsiModMp crsi + +{-# LINE 184 "src/ehc/EHC/CompileRun.chs" #-} +instance Show EHCompileRunStateInfo where + show _ = "EHCompileRunStateInfo" + +instance PP EHCompileRunStateInfo where + pp i = "CRSI:" >#< ppModMp (crsiModMp i) + +{-# LINE 192 "src/ehc/EHC/CompileRun.chs" #-} +instance CompileRunStateInfo EHCompileRunStateInfo HsName () where + crsiImportPosOfCUKey n i = () + +{-# LINE 197 "src/ehc/EHC/CompileRun.chs" #-} +type EHCompileRun = CompileRun HsName EHCompileUnit EHCompileRunStateInfo Err +type EHCompilePhase a = CompilePhase HsName EHCompileUnit EHCompileRunStateInfo Err a + +{-# LINE 206 "src/ehc/EHC/CompileRun.chs" #-} +crBaseInfo' :: EHCompileRun -> (EHCompileRunStateInfo,EHCOpts) +crBaseInfo' cr + = (crsi,opts) + where crsi = crStateInfo cr + opts = crsiOpts crsi + +crBaseInfo :: HsName -> EHCompileRun -> (EHCompileUnit,EHCompileRunStateInfo,EHCOpts,FPath) +crBaseInfo modNm cr + = ( ecu ,crsi + -- if any per module opts are available, use those + , maybe opts id $ ecuMbOpts ecu + , fp + ) + where ecu = crCU modNm cr + (crsi,opts) = crBaseInfo' cr + fp = ecuFilePath ecu + +{-# LINE 233 "src/ehc/EHC/CompileRun.chs" #-} +cpMemUsage :: EHCompilePhase () +cpMemUsage + = return () + +{-# LINE 256 "src/ehc/EHC/CompileRun.chs" #-} +cpUpdOpts :: (EHCOpts -> EHCOpts) -> EHCompilePhase () +cpUpdOpts upd + = cpUpdSI (\crsi -> crsi {crsiOpts = upd $ crsiOpts crsi}) + +{-# LINE 266 "src/ehc/EHC/CompileRun.chs" #-} +cpRegisterFilesToRm :: [FPath] -> EHCompilePhase () +cpRegisterFilesToRm fpL + = cpUpdSI (\crsi -> crsi {crsiFilesToRm = fpL ++ crsiFilesToRm crsi}) + +{-# LINE 272 "src/ehc/EHC/CompileRun.chs" #-} +cpRmFilesToRm :: EHCompilePhase () +cpRmFilesToRm + = do { cr <- get + ; let (crsi,opts) = crBaseInfo' cr + files = Set.toList $ Set.fromList $ map fpathToStr $ crsiFilesToRm crsi + ; lift $ mapM rm files + ; cpUpdSI (\crsi -> crsi {crsiFilesToRm = []}) + } + where rm f = CE.catch (removeFile f) + (\(e :: SomeException) -> hPutStrLn stderr (show f ++ ": " ++ show e)) + +{-# LINE 289 "src/ehc/EHC/CompileRun.chs" #-} +cpMsg :: HsName -> Verbosity -> String -> EHCompilePhase () +cpMsg modNm v m + = do { cr <- get + ; let (_,_,_,fp) = crBaseInfo modNm cr + ; cpMsg' modNm v m Nothing fp + } + +cpMsg' :: HsName -> Verbosity -> String -> Maybe String -> FPath -> EHCompilePhase () +cpMsg' modNm v m mbInfo fp + = do { cr <- get + ; let (ecu,crsi,opts,_) = crBaseInfo modNm cr + ; ehcioinfo <- lift $ readIORef (crsiEHCIOInfo crsi) + ; clockTime <- lift getEHCTime + ; let clockStartTimePrev = ehcioinfoStartTime ehcioinfo + clockTimePrev = ehcioinfoLastTime ehcioinfo + clockStartTimeDiff = ehcTimeDiff clockTime clockStartTimePrev + clockTimeDiff = ehcTimeDiff clockTime clockTimePrev + ; let + t = if v >= VerboseALot then "<" ++ strBlankPad 35 (ehcTimeDiffFmt clockStartTimeDiff ++ "/" ++ ehcTimeDiffFmt clockTimeDiff) ++ ">" else "" + m' = show (ecuSeqNr ecu) ++ t ++ " " ++ m + ; lift $ putCompileMsg v (ehcOptVerbosity opts) m' mbInfo modNm fp + ; clockTime <- lift getEHCTime + ; lift $ writeIORef (crsiEHCIOInfo crsi) (ehcioinfo {ehcioinfoLastTime = clockTime}) + -- ; cpUpdSI (\crsi -> crsi { crsiTime = clockTime }) + ; cpMemUsage + } + +{-# LINE 330 "src/ehc/EHC/CompileRun.chs" #-} +cpStepUID :: EHCompilePhase () +cpStepUID + = cpUpdSI (\crsi -> let (n,h) = mkNewLevUID (crsiNextUID crsi) + in crsi {crsiNextUID = n, crsiHereUID = h} + ) + +cpSetUID :: UID -> EHCompilePhase () +cpSetUID u + = cpUpdSI (\crsi -> crsi {crsiNextUID = u}) + +{-# LINE 346 "src/ehc/EHC/CompileRun.chs" #-} +cpSystem' :: Maybe FilePath -> (FilePath,[String]) -> EHCompilePhase () +cpSystem' mbStdOut (cmd,args) + = do { exitCode <- lift $ system $ showShellCmd $ (cmd,args ++ (maybe [] (\o -> [">", o]) mbStdOut)) + ; case exitCode of + ExitSuccess -> return () + _ -> cpSetFail + } + +cpSystem :: (FilePath,[String]) -> EHCompilePhase () +cpSystem = cpSystem' Nothing + +{-# LINE 376 "src/ehc/EHC/CompileRun.chs" #-} +cpSystemRaw :: String -> [String] -> EHCompilePhase () +cpSystemRaw cmd args + = do { exitCode <- lift $ rawSystem cmd args + ; case exitCode of + ExitSuccess -> return () + _ -> cpSetErrs [rngLift emptyRange Err_PP $ pp $ show exitCode] -- cpSetFail + } + +{-# LINE 390 "src/ehc/EHC/CompileRun.chs" #-} +cpStopAt :: CompilePoint -> EHCompilePhase () +cpStopAt atPhase + = do { cr <- get + ; let (_,opts) = crBaseInfo' cr + ; unless (atPhase < ehcStopAtPoint opts) + cpSetStopAllSeq + } + +{-# LINE 404 "src/ehc/EHC/CompileRun.chs" #-} +crPartitionNewerOlderImports :: HsName -> EHCompileRun -> ([EHCompileUnit],[EHCompileUnit]) +crPartitionNewerOlderImports modNm cr + = partition isNewer $ map (flip crCU cr) $ ecuImpNmL ecu + where ecu = crCU modNm cr + t = panicJust "crPartitionNewerOlderImports1" $ ecuMbHIInfoTime ecu + isNewer ecu' + | isJust mbt = t' `diffClockTimes` t > noTimeDiff + | otherwise = False + where t' = panicJust "crPartitionNewerOlderImports2" $ ecuMbHIInfoTime ecu' + mbt = ecuMbHIInfoTime ecu' + +{-# LINE 421 "src/ehc/EHC/CompileRun.chs" #-} +crModNeedsCompile :: HsName -> EHCompileRun -> Bool +crModNeedsCompile modNm cr + = ecuIsMainMod ecu -- ecuIsTopMod ecu + || not ( ehcOptCheckRecompile opts + && ecuCanUseHIInsteadOfHS ecu + && null newer + ) + where ecu = crCU modNm cr + (newer,_) = crPartitionNewerOlderImports modNm cr + opts = crsiOpts $ crStateInfo cr + +{-# LINE 442 "src/ehc/EHC/CompileRun.chs" #-} +crModCanCompile :: HsName -> EHCompileRun -> Bool +crModCanCompile modNm cr + = isJust (ecuMbSrcTime ecu) && ecuDirIsWritable ecu + where ecu = crCU modNm cr + +{-# LINE 453 "src/ehc/EHC/CompileRun.chs" #-} +-- | split module names in those part of a package, and others +crPartitionIntoPkgAndOthers :: EHCompileRun -> [HsName] -> ([PkgModulePartition],[HsName]) +crPartitionIntoPkgAndOthers cr modNmL + = ( [ (p,d,m) + | ((p,d),m) <- Map.toList $ Map.unionsWith (++) $ map Map.fromList ps + ] + , concat ms + ) + where (ps,ms) = unzip $ map loc modNmL + loc m = case filelocKind $ ecuFileLocation ecu of + FileLocKind_Dir -> ([ ], [m]) + FileLocKind_Pkg p d -> ([((p,d),[m])], [ ]) + where (ecu,_,_,_) = crBaseInfo m cr + +{-# LINE 473 "src/ehc/EHC/CompileRun.chs" #-} +crSetAndCheckMain :: HsName -> EHCompilePhase () +crSetAndCheckMain modNm + = do { cr <- get + ; let (crsi,opts) = crBaseInfo' cr + mkerr lim ns = cpSetLimitErrs 1 "compilation run" [rngLift emptyRange Err_MayOnlyHaveNrMain lim ns modNm] + ; case crsiMbMainNm crsi of + Just n | n /= modNm -> mkerr 1 [n] + _ | ehcOptDoExecLinking opts -> cpUpdSI (\crsi -> crsi {crsiMbMainNm = Just modNm}) + | otherwise -> return () + -- mkerr 0 [] + } + diff --git a/src/UHC/Light/Compiler/EHC/CompileUnit.hs b/src/UHC/Light/Compiler/EHC/CompileUnit.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/CompileUnit.hs @@ -0,0 +1,415 @@ +module UHC.Light.Compiler.EHC.CompileUnit +( EHCompileUnit (..) +, ecuFilePath +, emptyECU +, ecuFinalDestinationState +, EcuUpdater, ecuStoreSrcFilePath, ecuStoreState, ecuStoreHS, ecuStoreEH, ecuStoreHSSem, ecuStoreEHSem +, ecuStoreCoreSemMod +, ecuStoreCoreSem +, ecuStoreCore +, Optim (..), defaultOptim +, ecuHSDeclImpNmS, ecuHIDeclImpNmS, ecuHIUsedImpNmS +, ecuIsMainMod +, ecuImpNmS, ecuImpNmL +, ecuTransClosedUsedModMp, ecuTransClosedOrphanModS +, ecuIsOrphan +, ecuStoreHSDeclImpS, ecuSetNeedsCompile, ecuStoreHIUsedImpS, ecuStoreHIInfoTime, ecuStoreSrcTime, ecuStoreHSSemMod, ecuStoreIntrodModS, ecuStoreHIDeclImpS, ecuStoreMod, ecuSetIsTopMod, ecuSetHasMain, ecuStoreOptim, ecuStoreHIInfo, ecuStorePrevHIInfo +, ecuStoreCoreTime +, ecuStoreDirIsWritable +, ecuIsHSNewerThanHI +, ecuIsValidHIInfo +, ecuCanUseHIInsteadOfHS +, EHCCompileSeqNr (..) +, ecuAnHIInfo +, ecuStoreOpts, ecuStorePragmas, ecuStoreUsedNames, ecuSetTarget +, ecuStoreGenCodeFiles +, ecuStoreCppFilePath, ecuStoreSeqNr ) +where +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.EHC.Common +import qualified UHC.Light.Compiler.HS as HS +import qualified UHC.Light.Compiler.EH as EH +import qualified UHC.Light.Compiler.Core as Core +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import qualified UHC.Light.Compiler.Core.Check as Core2ChkSem +import qualified UHC.Light.Compiler.HI as HI +import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.CodeGen.ImportUsedModules +import UHC.Util.Time +import System.Directory +import qualified UHC.Light.Compiler.Base.Pragma as Pragma +import UHC.Light.Compiler.Base.Target +import UHC.Util.Debug + + + + + + + + +{-# LINE 92 "src/ehc/EHC/CompileUnit.chs" #-} +data Optim + = Optim + +defaultOptim :: Optim +defaultOptim + = Optim + +{-# LINE 115 "src/ehc/EHC/CompileUnit.chs" #-} +data EHCCompileSeqNr + = EHCCompileSeqNr + { ecseqnrThis :: !Int + , ecseqnrTotal :: !Int + } + deriving (Eq,Ord) + +zeroEHCCompileSeqNr :: EHCCompileSeqNr +zeroEHCCompileSeqNr = EHCCompileSeqNr 0 0 + +instance Show EHCCompileSeqNr where + show (EHCCompileSeqNr this total) + = "[" ++ replicate (length tot - length ths) ' ' ++ ths ++ "/" ++ tot ++ "]" + where tot = show total + ths = show this + +{-# LINE 137 "src/ehc/EHC/CompileUnit.chs" #-} +data EHCompileUnit + = EHCompileUnit + { ecuSrcFilePath :: !FPath + , ecuMbCppFilePath :: !(Maybe FPath) + , ecuFileLocation :: !FileLoc + , ecuGrpNm :: !HsName + , ecuModNm :: !HsName + , ecuMbHS :: !(Maybe HS.AGItf) + , ecuMbHSSem :: !(Maybe HSSem.Syn_AGItf) + , ecuMbEH :: !(Maybe EH.AGItf) + , ecuMbEHSem :: !(Maybe EHSem.Syn_AGItf) + , ecuMbCore :: !(Maybe Core.CModule) + , ecuMbCoreSem :: !(Maybe Core2GrSem.Syn_CodeAGItf) + , ecuMbCoreSemMod :: !(Maybe Core2ChkSem.Syn_CodeAGItf) + , ecuState :: !EHCompileUnitState + , ecuImportUsedModules :: !ImportUsedModules -- imported modules info + , ecuIsTopMod :: !Bool -- module has been specified for compilation on commandline + , ecuHasMain :: !Bool -- has a def for 'main'? + , ecuNeedsCompile :: !Bool -- (re)compilation from .hs needed? + , ecuMbSrcTime :: !(Maybe ClockTime) -- timestamp of possibly absent source (hs, or other type) file + , ecuMbHIInfoTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated hi file + , ecuMbCoreTime :: !(Maybe ClockTime) -- timestamp of possibly previously generated core file + , ecuMbHSSemMod :: !(Maybe HSSemMod.Syn_AGItf) + , ecuMod :: !Mod -- import/export info of module + , ecuMbPrevHIInfo :: !(Maybe HI.HIInfo) -- possible HI info of previous run + , ecuMbOptim :: !(Maybe Optim) + , ecuHIInfo :: !HI.HIInfo -- HI info of module + , ecuDirIsWritable :: !Bool -- can be written in dir of module? + , ecuMbOpts :: (Maybe EHCOpts) -- possibly per module adaption of options (caused by pragmas) + , ecuTarget :: Target -- target for which we compile + , ecuPragmas :: !(Set.Set Pragma.Pragma) -- pragmas of module + , ecuUsedNames :: ModEntRelFilterMp -- map holding actually used names, to later filter cache of imported hi's to be included in this module's hi + , ecuSeqNr :: !EHCCompileSeqNr -- sequence nr of sorted compilation + , ecuGenCodeFiles :: ![FPath] -- generated code files + } + +{-# LINE 211 "src/ehc/EHC/CompileUnit.chs" #-} +ecuHSDeclImpNmS = iumHSDeclModules . ecuImportUsedModules +ecuHIDeclImpNmS = iumHIDeclModules . ecuImportUsedModules +ecuHIUsedImpNmS = iumHIUsedModules . ecuImportUsedModules + +{-# LINE 217 "src/ehc/EHC/CompileUnit.chs" #-} +ecuFilePath :: EHCompileUnit -> FPath +ecuFilePath ecu + = maybe (ecuSrcFilePath ecu) id (ecuMbCppFilePath ecu) + +{-# LINE 227 "src/ehc/EHC/CompileUnit.chs" #-} +ecuIsMainMod :: EHCompileUnit -> Bool +ecuIsMainMod e = ecuIsTopMod e && ecuHasMain e + +{-# LINE 232 "src/ehc/EHC/CompileUnit.chs" #-} +-- | give the current value HIInfo, or the previous one +ecuAnHIInfo :: EHCompileUnit -> HI.HIInfo +ecuAnHIInfo e + = case ecuMbPrevHIInfo e of + Just pi | HI.hiiIsEmpty hii + -> pi + _ -> hii + where hii = ecuHIInfo e + +{-# LINE 243 "src/ehc/EHC/CompileUnit.chs" #-} +emptyECU :: EHCompileUnit +emptyECU + = EHCompileUnit + { ecuSrcFilePath = emptyFPath + , ecuMbCppFilePath = Nothing + , ecuFileLocation = emptyFileLoc + , ecuGrpNm = hsnUnknown + , ecuModNm = hsnUnknown + , ecuMbHS = Nothing + , ecuMbHSSem = Nothing + , ecuMbEH = Nothing + , ecuMbEHSem = Nothing + , ecuMbCore = Nothing + , ecuMbCoreSem = Nothing + , ecuMbCoreSemMod = Nothing + , ecuState = ECUS_Unknown + , ecuImportUsedModules = emptyImportUsedModules + , ecuIsTopMod = False + , ecuHasMain = False + , ecuNeedsCompile = True + , ecuMbSrcTime = Nothing + , ecuMbHIInfoTime = Nothing + , ecuMbCoreTime = Nothing + , ecuMbHSSemMod = Nothing + , ecuMod = emptyMod + , ecuMbPrevHIInfo = Nothing + , ecuMbOptim = Nothing + , ecuHIInfo = HI.emptyHIInfo + , ecuDirIsWritable = False + , ecuMbOpts = Nothing + , ecuTarget = defaultTarget + , ecuPragmas = Set.empty + , ecuUsedNames = Map.empty + , ecuSeqNr = zeroEHCCompileSeqNr + , ecuGenCodeFiles = [] + } + +{-# LINE 321 "src/ehc/EHC/CompileUnit.chs" #-} +ecuImpNmS :: EHCompileUnit -> Set.Set HsName +ecuImpNmS ecu = -- (\v -> tr "XX" (pp $ Set.toList v) v) $ + Set.delete (ecuModNm ecu) $ Set.unions [ ecuHSDeclImpNmS ecu, ecuHIDeclImpNmS ecu, ecuHIUsedImpNmS ecu ] + +ecuImpNmL :: EHCompileUnit -> [HsName] +ecuImpNmL = Set.toList . ecuImpNmS -- ecu = (nub $ ecuHSDeclImpNmL ecu ++ ecuHIDeclImpNmL ecu ++ ecuHIUsedImpNmL ecu) \\ [ecuModNm ecu] + +{-# LINE 330 "src/ehc/EHC/CompileUnit.chs" #-} +-- | The used modules, for linking, according to .hi info +ecuTransClosedUsedModMp :: EHCompileUnit -> HI.HIInfoUsedModMp +ecuTransClosedUsedModMp = HI.hiiTransClosedUsedModMp . ecuAnHIInfo + +-- | The orphan modules, must be .hi read, according to .hi info +ecuTransClosedOrphanModS :: EHCompileUnit -> Set.Set HsName +ecuTransClosedOrphanModS = HI.hiiTransClosedOrphanModS . ecuAnHIInfo + +{-# LINE 340 "src/ehc/EHC/CompileUnit.chs" #-} +-- | Is orphan, according to .hi info +ecuIsOrphan :: EHCompileUnit -> Bool +ecuIsOrphan = isJust . HI.hiiMbOrphan . ecuAnHIInfo + +{-# LINE 360 "src/ehc/EHC/CompileUnit.chs" #-} +instance CompileUnitState EHCompileUnitState where + cusDefault = ECUS_Eh EHStart + cusUnk = ECUS_Unknown + cusIsUnk = (==ECUS_Unknown) +{-# LINE 369 "src/ehc/EHC/CompileUnit.chs" #-} + cusIsImpKnown s = case s of + ECUS_Haskell HSOnlyImports -> True + ECUS_Haskell HIOnlyImports -> True + ECUS_Haskell HMOnlyMinimal -> True + ECUS_Haskell LHSOnlyImports -> True + ECUS_Haskell HSAllSem -> True + ECUS_Haskell HIAllSem -> True + ECUS_Core CROnlyImports -> True + _ -> False + +{-# LINE 385 "src/ehc/EHC/CompileUnit.chs" #-} +instance FileLocatable EHCompileUnit FileLoc where + fileLocation = ecuFileLocation + noFileLocation = emptyFileLoc + +{-# LINE 391 "src/ehc/EHC/CompileUnit.chs" #-} +instance CompileUnit EHCompileUnit HsName FileLoc EHCompileUnitState where + cuDefault = emptyECU + cuFPath = ecuFilePath + cuLocation = fileLocation + cuKey = ecuModNm + cuState = ecuState + cuUpdFPath = ecuStoreSrcFilePath + cuUpdLocation = ecuStoreFileLocation + cuUpdState = ecuStoreState + cuUpdKey nm u = u {ecuModNm = nm} + cuImports = ecuImpNmL + cuParticipation u = if not (Set.null $ Set.filter (Pragma.pragmaIsExcludeTarget $ ecuTarget u) $ ecuPragmas u) + then [CompileParticipation_NoImport] + else [] + +instance FPathError Err + +instance CompileRunError Err () where + crePPErrL = ppErrL + creMkNotFoundErrL _ fp sp sufs = [rngLift emptyRange Err_FileNotFound fp sp sufs] + creAreFatal = errLIsFatal + +instance CompileModName HsName where + mkCMNm = hsnFromString + +instance Show EHCompileUnit where + show _ = "EHCompileUnit" + +instance PP EHCompileUnit where + pp ecu + = ecuModNm ecu >|< + ":" >#< ppBracketsCommas (ecuImpNmL ecu) >|< + "," >#< show (ecuState ecu) + +{-# LINE 437 "src/ehc/EHC/CompileUnit.chs" #-} +-- | The final state to be reached +ecuFinalDestinationState :: EHCompileUnit -> EHCompileUnitState +ecuFinalDestinationState ecu = ecuStateFinalDestination upd $ ecuState ecu + where + upd (ECUS_Haskell _) + | ecuNeedsCompile ecu = ECUS_Haskell HSAllSem + | otherwise = ECUS_Haskell HIAllSem + upd s = s + +{-# LINE 454 "src/ehc/EHC/CompileUnit.chs" #-} +type EcuUpdater a = a -> EHCompileUnit -> EHCompileUnit + +ecuStoreSrcFilePath :: EcuUpdater FPath +ecuStoreSrcFilePath x ecu = ecu { ecuSrcFilePath = x } + +ecuStoreFileLocation :: EcuUpdater FileLoc +ecuStoreFileLocation x ecu = ecu { ecuFileLocation = x } + +ecuStoreState :: EcuUpdater EHCompileUnitState +ecuStoreState x ecu = ecu { ecuState = x } + +ecuStoreHS :: EcuUpdater HS.AGItf +ecuStoreHS x ecu = ecu { ecuMbHS = Just x } + +ecuStoreEH :: EcuUpdater EH.AGItf +ecuStoreEH x ecu = ecu { ecuMbEH = Just x } + +ecuStoreHSSem :: EcuUpdater HSSem.Syn_AGItf +ecuStoreHSSem x ecu = ecu { ecuMbHSSem = Just x } + +ecuStoreEHSem :: EcuUpdater EHSem.Syn_AGItf +ecuStoreEHSem x ecu = ecu { ecuMbEHSem = Just x } + +{-# LINE 479 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreCoreSemMod :: EcuUpdater Core2ChkSem.Syn_CodeAGItf +ecuStoreCoreSemMod x ecu = ecu { ecuMbCoreSemMod = Just x } + +{-# LINE 484 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreCoreSem :: EcuUpdater Core2GrSem.Syn_CodeAGItf +ecuStoreCoreSem x ecu = ecu { ecuMbCoreSem = Just x } + +{-# LINE 489 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreCore :: EcuUpdater Core.CModule +ecuStoreCore x ecu | x `seq` True = ecu { ecuMbCore = Just x } + +{-# LINE 546 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreSrcTime :: EcuUpdater ClockTime +ecuStoreSrcTime x ecu = ecu { ecuMbSrcTime = Just x } + +-- ecuStoreHITime :: EcuUpdater ClockTime +-- ecuStoreHITime x ecu = ecu { ecuMbHITime = Just x } + +ecuStoreHIInfoTime :: EcuUpdater ClockTime +ecuStoreHIInfoTime x ecu = ecu { ecuMbHIInfoTime = Just x } + +ecuStoreHSSemMod :: EcuUpdater HSSemMod.Syn_AGItf +ecuStoreHSSemMod x ecu = ecu { ecuMbHSSemMod = Just x } + +ecuStoreHSDeclImpS :: EcuUpdater (Set.Set HsName) +ecuStoreHSDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHSDeclModules = x} } + where ium = ecuImportUsedModules ecu + +ecuStoreHIDeclImpS :: EcuUpdater (Set.Set HsName) +ecuStoreHIDeclImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIDeclModules = x} } + where ium = ecuImportUsedModules ecu + +ecuStoreHIUsedImpS :: EcuUpdater (Set.Set HsName) +ecuStoreHIUsedImpS x ecu = ecu { ecuImportUsedModules = ium {iumHIUsedModules = x} } + where ium = ecuImportUsedModules ecu + +ecuStoreIntrodModS :: EcuUpdater (Set.Set HsName) +ecuStoreIntrodModS x ecu = ecu { ecuImportUsedModules = ium {iumIntrodModules = x} } + where ium = ecuImportUsedModules ecu + +ecuStoreMod :: EcuUpdater Mod +ecuStoreMod x ecu = ecu { ecuMod = x } + +ecuSetIsTopMod :: EcuUpdater Bool +ecuSetIsTopMod x ecu = ecu { ecuIsTopMod = x } + +ecuSetHasMain :: EcuUpdater Bool +ecuSetHasMain x ecu = ecu { ecuHasMain = x } + +ecuSetNeedsCompile :: EcuUpdater Bool +ecuSetNeedsCompile x ecu = ecu { ecuNeedsCompile = x } + +-- ecuStorePrevHI :: EcuUpdater HI.AGItf +-- ecuStorePrevHI x ecu = ecu { ecuMbPrevHI = Just x } + +-- ecuStorePrevHISem :: EcuUpdater HISem.Syn_AGItf +-- ecuStorePrevHISem x ecu = ecu { ecuMbPrevHISem = Just x } + +ecuStorePrevHIInfo :: EcuUpdater HI.HIInfo +ecuStorePrevHIInfo x ecu = ecu { ecuMbPrevHIInfo = Just x } + +ecuStoreOptim :: EcuUpdater Optim +ecuStoreOptim x ecu = ecu { ecuMbOptim = Just x } + +ecuStoreHIInfo :: EcuUpdater HI.HIInfo +ecuStoreHIInfo x ecu | x `seq` True = ecu { ecuHIInfo = x } + +{-# LINE 609 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreCoreTime :: EcuUpdater ClockTime +ecuStoreCoreTime x ecu = ecu { ecuMbCoreTime = Just x } + +{-# LINE 619 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreDirIsWritable :: EcuUpdater Bool +ecuStoreDirIsWritable x ecu = ecu { ecuDirIsWritable = x } + +{-# LINE 624 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreOpts :: EcuUpdater EHCOpts +ecuStoreOpts x ecu = ecu { ecuMbOpts = Just x } + +ecuSetTarget :: EcuUpdater Target +ecuSetTarget x ecu = ecu { ecuTarget = x } + +ecuStorePragmas :: EcuUpdater (Set.Set Pragma.Pragma) +ecuStorePragmas x ecu = ecu { ecuPragmas = x } + +ecuStoreUsedNames :: EcuUpdater ModEntRelFilterMp +ecuStoreUsedNames x ecu = ecu { ecuUsedNames = x } + +{-# LINE 638 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreGenCodeFiles :: EcuUpdater [FPath] +ecuStoreGenCodeFiles x ecu = ecu { ecuGenCodeFiles = x } + +{-# LINE 643 "src/ehc/EHC/CompileUnit.chs" #-} +ecuStoreSeqNr :: EcuUpdater EHCCompileSeqNr +ecuStoreSeqNr x ecu = ecu { ecuSeqNr = x } + +ecuStoreCppFilePath :: EcuUpdater FPath +ecuStoreCppFilePath x ecu = ecu { ecuMbCppFilePath = Just x } + +{-# LINE 655 "src/ehc/EHC/CompileUnit.chs" #-} +-- | Is HS newer? +-- If no HS exists False is returned. +ecuIsHSNewerThanHI :: EHCompileUnit -> Bool +ecuIsHSNewerThanHI ecu + = case (ecuMbSrcTime ecu,ecuMbHIInfoTime ecu) of + (Just ths,Just thi) -> ths `diffClockTimes` thi > noTimeDiff + (Nothing ,Just thi) -> False + _ -> True + +{-# LINE 674 "src/ehc/EHC/CompileUnit.chs" #-} +ecuIsValidHIInfo :: EHCompileUnit -> Bool +ecuIsValidHIInfo ecu + = case ecuMbPrevHIInfo ecu of + Just i -> HI.hiiValidity i == HI.HIValidity_Ok + _ -> False + +{-# LINE 682 "src/ehc/EHC/CompileUnit.chs" #-} +-- | Can HI be used instead of HS? +-- This is purely based on HI being of the right version and HS not newer. +-- The need for recompilation considers dependencies on imports as well. +ecuCanUseHIInsteadOfHS :: EHCompileUnit -> Bool +ecuCanUseHIInsteadOfHS ecu + = ecuIsValidHIInfo ecu && not (ecuIsHSNewerThanHI ecu) + diff --git a/src/UHC/Light/Compiler/EHC/Environment.hs b/src/UHC/Light/Compiler/EHC/Environment.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/Environment.hs @@ -0,0 +1,32 @@ +module UHC.Light.Compiler.EHC.Environment +( EHCEnvironment (..) +, ehcenvDir +, mkEhcenvKey ) +where +import System.Environment +import System.Directory +import System.IO +import UHC.Util.FPath + +{-# LINE 27 "src/ehc/EHC/Environment.chs" #-} +data EHCEnvironment + = EHCEnvironment + { ehcenvVariant :: String + , ehcenvInstallRoot :: String + } + deriving (Show,Read) + +{-# LINE 40 "src/ehc/EHC/Environment.chs" #-} +mkEhcenvKey :: String -> String -> String -> String +mkEhcenvKey version progName ehcDefaultVariant + = progName + ++ "-" ++ version + ++ "-" ++ ehcDefaultVariant + +{-# LINE 60 "src/ehc/EHC/Environment.chs" #-} +ehcenvDir :: String -> IO String +ehcenvDir progKey + = do { d <- getAppUserDataDirectory progKey + ; return d + } + diff --git a/src/UHC/Light/Compiler/EHC/InitialSetup.hs b/src/UHC/Light/Compiler/EHC/InitialSetup.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/EHC/InitialSetup.hs @@ -0,0 +1,81 @@ +module UHC.Light.Compiler.EHC.InitialSetup +( initialHSSem +, initialEHSem +, initialCore2GrSem +, initialHSSemMod ) +where +import qualified Data.Map as Map +import UHC.Light.Compiler.EHC.Common +import qualified UHC.Light.Compiler.HS.MainAG as HSSem +import qualified UHC.Light.Compiler.EH.MainAG as EHSem +import qualified UHC.Light.Compiler.Core.ToGrin as Core2GrSem +import UHC.Light.Compiler.LamInfo +import qualified UHC.Light.Compiler.Gam.ClGam as Pr (initClGam) +import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod +import UHC.Light.Compiler.CodeGen.ImportUsedModules +import UHC.Light.Compiler.Pred.ToCHR (initScopedPredStore) + + + + + + + + +{-# LINE 51 "src/ehc/EHC/InitialSetup.chs" #-} +initialHSSem :: EHCOpts -> HSSem.Inh_AGItf +initialHSSem opts + = HSSem.Inh_AGItf + { HSSem.opts_Inh_AGItf = opts + , HSSem.idGam_Inh_AGItf = HSSem.tyGam2IdDefOccGam initTyGam + `gamUnion` HSSem.kiGam2IdDefOccGam initKiGam + `gamUnion` HSSem.clGam2IdDefOccGam Pr.initClGam + , HSSem.gUniq_Inh_AGItf = uidStart + , HSSem.isTopMod_Inh_AGItf = False + , HSSem.moduleNm_Inh_AGItf = hsnUnknown + , HSSem.modInScope_Inh_AGItf = Map.empty + , HSSem.modEntToOrig_Inh_AGItf = Map.empty + , HSSem.fixityGam_Inh_AGItf = initFixityGam + , HSSem.topInstanceNmL_Inh_AGItf = [] + } + +{-# LINE 73 "src/ehc/EHC/InitialSetup.chs" #-} +initialEHSem :: EHCOpts -> FPath -> EHSem.Inh_AGItf +initialEHSem opts fp + = EHSem.Inh_AGItf + { EHSem.moduleNm_Inh_AGItf = mkHNm (fpathBase fp) + , EHSem.gUniq_Inh_AGItf = uidStart + , EHSem.opts_Inh_AGItf = opts + , EHSem.isMainMod_Inh_AGItf = False + , EHSem.idQualGam_Inh_AGItf = emptyGam + , EHSem.valGam_Inh_AGItf = emptyGam + , EHSem.dataGam_Inh_AGItf = emptyGam + , EHSem.tyGam_Inh_AGItf = initTyGam + , EHSem.tyKiGam_Inh_AGItf = initTyKiGam + , EHSem.polGam_Inh_AGItf = initPolGam + , EHSem.kiGam_Inh_AGItf = initKiGam + , EHSem.clGam_Inh_AGItf = Pr.initClGam + , EHSem.clDfGam_Inh_AGItf = emptyGam + , EHSem.chrStore_Inh_AGItf = initScopedPredStore + } + +{-# LINE 98 "src/ehc/EHC/InitialSetup.chs" #-} +initialCore2GrSem :: EHCOpts -> Core2GrSem.Inh_CodeAGItf +initialCore2GrSem opts + = Core2GrSem.Inh_CodeAGItf + { Core2GrSem.gUniq_Inh_CodeAGItf = uidStart + , Core2GrSem.dataGam_Inh_CodeAGItf = emptyGam + , Core2GrSem.opts_Inh_CodeAGItf = opts + , Core2GrSem.lamMp_Inh_CodeAGItf = initLamMp + , Core2GrSem.importUsedModules_Inh_CodeAGItf = emptyImportUsedModules + } + +{-# LINE 112 "src/ehc/EHC/InitialSetup.chs" #-} +initialHSSemMod :: EHCOpts -> HSSemMod.Inh_AGItf +initialHSSemMod opts + = HSSemMod.Inh_AGItf + { HSSemMod.gUniq_Inh_AGItf = uidStart + , HSSemMod.moduleNm_Inh_AGItf = hsnUnknown + , HSSemMod.opts_Inh_AGItf = opts + } + diff --git a/src/UHC/Light/Compiler/Error.hs b/src/UHC/Light/Compiler/Error.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Error.hs @@ -0,0 +1,132 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Error.ag) +module UHC.Light.Compiler.Error(Err (..), ErrL +, ThingAndRange +, ErrSq +, mkThingAnd1Range +, module UHC.Light.Compiler.Base.Target +, errLIsFatal +, errIsFatal +, mkNestErr, mkNestErr' +, mkErr_NamesNotIntrod, mkErr_NamesNotIntrod') where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Util.Pretty +import qualified UHC.Util.FastSeq as Seq +import Control.Monad.Error.Class +import UHC.Light.Compiler.Base.Target (FFIWay) +import UHC.Util.FPath + + + + + + + + + + + + + + + +type ThingAndRange x = (x,Maybe [(Range,Maybe PP_Doc)]) + + + +type ErrSq = Seq.FastSeq Err + + + +instance Error Err where + strMsg m = rngLift emptyRange Err_Str m + + + +errIsFatal :: Err -> Bool +errIsFatal (Err_MissingDataFields _ _ _ ) = False +errIsFatal (Err_TyCoreMatchClash _ _ _ _ _ ) = False +errIsFatal _ = True + + + +errLIsFatal :: [Err] -> Bool +errLIsFatal es = not (null es) && any errIsFatal es + + + +mkNestErr' :: Range -> PP_Doc -> [ErrSq] -> ErrSq +mkNestErr' r wher errs = Seq.fromList $ mkNestErr r wher $ Seq.toList $ Seq.unions errs + +mkNestErr :: Range -> PP_Doc -> ErrL -> ErrL +mkNestErr r wher errL | null ({- forceEval -} errL) = [] + | otherwise = [Err_NestedIn r wher errL] + + + +mkThingAnd1Range :: Range -> x -> ThingAndRange x +mkThingAnd1Range r x = (x,Just [(r,Nothing)]) + + + +mkErr_NamesNotIntrod' :: PP n => Range -> String -> [ThingAndRange n] -> Err +mkErr_NamesNotIntrod' r m ns = Err_NamesNotIntrod r m (assocLMapKey pp ns) + +mkErr_NamesNotIntrod :: Range -> String -> [HsName] -> Err +mkErr_NamesNotIntrod r m ns = mkErr_NamesNotIntrod' r m (zip (map pp ns) (repeat Nothing)) + +-- Err --------------------------------------------------------- +data Err = Err_PP {range_Err_PP :: !(Range),pp_Err_PP :: !(PP_Doc)} + | Err_Str {range_Err_Str :: !(Range),str_Err_Str :: !(String)} + | Err_UnifyClash {range_Err_UnifyClash :: !(Range),ty1_Err_UnifyClash :: !(Ty),ty2_Err_UnifyClash :: !(Ty),fiMode_Err_UnifyClash :: !(FIMode),ty1detail_Err_UnifyClash :: !(Ty),ty2detail_Err_UnifyClash :: !(Ty),fiModeD_Err_UnifyClash :: !(FIMode)} + | Err_NamesNotIntrod {range_Err_NamesNotIntrod :: !(Range),kind_Err_NamesNotIntrod :: !(String),nmL_Err_NamesNotIntrod :: !(([ThingAndRange PP_Doc]))} + | Err_PatArity {range_Err_PatArity :: !(Range),ty_Err_PatArity :: !(Ty),arity_Err_PatArity :: !(Int)} + | Err_PatArity2 {range_Err_PatArity2 :: !(Range),kind_Err_PatArity2 :: !(String),what_Err_PatArity2 :: !(PP_Doc),arity_Err_PatArity2 :: !(Int)} + | Err_NamesDupIntrod {range_Err_NamesDupIntrod :: !(Range),kind_Err_NamesDupIntrod :: !(String),nmL_Err_NamesDupIntrod :: !(([ThingAndRange HsName]))} + | Err_NestedIn {range_Err_NestedIn :: !(Range),wher_Err_NestedIn :: !(PP_Doc),errL_Err_NestedIn :: !(ErrL)} + | Err_Fixity {range_Err_Fixity :: !(Range),op1_Err_Fixity :: !(PP_Doc),op2_Err_Fixity :: !(PP_Doc)} + | Err_UnifyOccurs {range_Err_UnifyOccurs :: !(Range),ty1_Err_UnifyOccurs :: !(Ty),ty2_Err_UnifyOccurs :: !(Ty),fiMode_Err_UnifyOccurs :: !(FIMode),tvar_Err_UnifyOccurs :: !(TyVarId),ty2detail_Err_UnifyOccurs :: !(Ty),fiModeD_Err_UnifyOccurs :: !(FIMode)} + | Err_OccurCycle {range_Err_OccurCycle :: !(Range),tvar_Err_OccurCycle :: !(TyVarId),ty_Err_OccurCycle :: !(Ty)} + | Err_Newtype {range_Err_Newtype :: !(Range),tyNm_Err_Newtype :: !(HsName)} + | Err_FunPatternLengths {range_Err_FunPatternLengths :: !(Range),funNm_Err_FunPatternLengths :: !(HsName)} + | Err_MissingRowLabels {range_Err_MissingRowLabels :: !(Range),nmL_Err_MissingRowLabels :: !(([HsName])),ty_Err_MissingRowLabels :: !(Ty)} + | Err_TooManyRowLabels {range_Err_TooManyRowLabels :: !(Range),nmL_Err_TooManyRowLabels :: !(([HsName])),ty_Err_TooManyRowLabels :: !(Ty)} + | Err_InconsistentIntros {range_Err_InconsistentIntros :: !(Range),kind_Err_InconsistentIntros :: !(String),nmL_Err_InconsistentIntros :: !(([HsName]))} + | Err_MissingDataFields {range_Err_MissingDataFields :: !(Range),nmL_Err_MissingDataFields :: !(([HsName])),con_Err_MissingDataFields :: !(HsName)} + | Err_MissingAnyDataField {range_Err_MissingAnyDataField :: !(Range),nmL_Err_MissingAnyDataField :: !(([HsName])),tyNm_Err_MissingAnyDataField :: !(HsName)} + | Err_DuplicateDataFields {range_Err_DuplicateDataFields :: !(Range),nmL_Err_DuplicateDataFields :: !(([HsName]))} + | Err_FileNotFound {range_Err_FileNotFound :: !(Range),fileName_Err_FileNotFound :: !(String),locations_Err_FileNotFound :: !(([String])),suffixes_Err_FileNotFound :: !(([FileSuffix]))} + | Err_AmbiguousExport {range_Err_AmbiguousExport :: !(Range),name_Err_AmbiguousExport :: !(HsName),entities_Err_AmbiguousExport :: !(([ThingAndRange HsName]))} + | Err_IllegalFFIWay {range_Err_IllegalFFIWay :: !(Range),ffiWay_Err_IllegalFFIWay :: !(FFIWay)} + | Err_TyCoreMatchClash {range_Err_TyCoreMatchClash :: !(Range),ty1_Err_TyCoreMatchClash :: !(PP_Doc),ty2_Err_TyCoreMatchClash :: !(PP_Doc),ty1detail_Err_TyCoreMatchClash :: !((Maybe PP_Doc)),ty2detail_Err_TyCoreMatchClash :: !((Maybe PP_Doc))} + | Err_TyCoreSeqLevels {range_Err_TyCoreSeqLevels :: !(Range),hereLev_Err_TyCoreSeqLevels :: !(Int),mustLev_Err_TyCoreSeqLevels :: !(Int),ty_Err_TyCoreSeqLevels :: !(PP_Doc)} + | Err_NoCoerceDerivation {range_Err_NoCoerceDerivation :: !(Range),ty1_Err_NoCoerceDerivation :: !(Ty),ty2_Err_NoCoerceDerivation :: !(Ty),fiMode_Err_NoCoerceDerivation :: !(FIMode),func_Err_NoCoerceDerivation :: !(Ty),arg_Err_NoCoerceDerivation :: !(Ty)} + | Err_PrfCutOffReached {range_Err_PrfCutOffReached :: !(Range),pred_Err_PrfCutOffReached :: !(PredOcc),depth_Err_PrfCutOffReached :: !(Int)} + | Err_NotProvenPreds {range_Err_NotProvenPreds :: !(Range),preds_Err_NotProvenPreds :: !(([((Pred,[Range]),PP_Doc)]))} + | Err_AmbigPreds {range_Err_AmbigPreds :: !(Range),preds_Err_AmbigPreds :: !(([(Pred,[Range])])),inQBinds_Err_AmbigPreds :: !((AssocL HsName PP_Doc)),inBinds_Err_AmbigPreds :: !((AssocL HsName PP_Doc))} + | Err_OverlapPreds {range_Err_OverlapPreds :: !(Range),overl_Err_OverlapPreds :: !((AssocL Pred [PP_Doc]))} + | Err_TyHasFreeTVars {range_Err_TyHasFreeTVars :: !(Range),ty_Err_TyHasFreeTVars :: !(Ty)} + | Err_DeclsNotAllowed {range_Err_DeclsNotAllowed :: !(Range),inside_Err_DeclsNotAllowed :: !(String),decls_Err_DeclsNotAllowed :: !((AssocL IdOccKind [HsName]))} + | Err_ValWithoutSig {range_Err_ValWithoutSig :: !(Range),nmL_Err_ValWithoutSig :: !(([HsName]))} + | Err_NoMostSpecificPred {range_Err_NoMostSpecificPred :: !(Range),pred1_Err_NoMostSpecificPred :: !(Pred),pred2_Err_NoMostSpecificPred :: !(Pred)} + | Err_EvidenceAltsLeft {range_Err_EvidenceAltsLeft :: !(Range)} + | Err_MalformedPred {range_Err_MalformedPred :: !(Range),pp_Err_MalformedPred :: !(PP_Doc)} + | Err_TyBetaRedLimit {range_Err_TyBetaRedLimit :: !(Range),ty_Err_TyBetaRedLimit :: !(Ty),tyTo_Err_TyBetaRedLimit :: !(Ty),limit_Err_TyBetaRedLimit :: !(Int)} + | Err_MayOnlyHaveNrMain {range_Err_MayOnlyHaveNrMain :: !(Range),nrAllowed_Err_MayOnlyHaveNrMain :: !(Int),prevModNmL_Err_MayOnlyHaveNrMain :: !(([HsName])),modNm_Err_MayOnlyHaveNrMain :: !(HsName)} + | Err_MayNotHaveMain {range_Err_MayNotHaveMain :: !(Range),modNm_Err_MayNotHaveMain :: !(HsName)} + | Err_MustHaveMain {range_Err_MustHaveMain :: !(Range)} + | Err_ModNameMismatch {range_Err_ModNameMismatch :: !(Range),nmOfFile_Err_ModNameMismatch :: !(HsName),nmFromSrc_Err_ModNameMismatch :: !(HsName)} + | Err_AmbiguousNameRef {range_Err_AmbiguousNameRef :: !(Range),kindName_Err_AmbiguousNameRef :: !(String),kind_Err_AmbiguousNameRef :: !(String),nm_Err_AmbiguousNameRef :: !(HsName),nmAlts_Err_AmbiguousNameRef :: !(([HsName]))} + | Err_MutRecModules {range_Err_MutRecModules :: !(Range),mutRecL_Err_MutRecModules :: !(([[HsName]]))} + | Err_MalformedTy {range_Err_MalformedTy :: !(Range),kind_Err_MalformedTy :: !(String),purpose_Err_MalformedTy :: !(String),ty_Err_MalformedTy :: !(Ty)} + | Err_NoDerivFor {range_Err_NoDerivFor :: !(Range),pred_Err_NoDerivFor :: !(PP_Doc)} + | Err_NoDerivForData {range_Err_NoDerivForData :: !(Range),ty_Err_NoDerivForData :: !(Ty),clNm_Err_NoDerivForData :: !(HsName),reason_Err_NoDerivForData :: !(String)} + | Err_FusionBuildInverse {range_Err_FusionBuildInverse :: !(Range),ty1_Err_FusionBuildInverse :: !(Ty),ty2_Err_FusionBuildInverse :: !(Ty)} + | Err_InconsistentHI {range_Err_InconsistentHI :: !(Range),modNm_Err_InconsistentHI :: !(String),file_Err_InconsistentHI :: !(String),expected_Err_InconsistentHI :: !(([String])),inHI_Err_InconsistentHI :: !(([String]))} + | Err_WrongMagic {range_Err_WrongMagic :: !(Range),modNm_Err_WrongMagic :: !(String),file_Err_WrongMagic :: !(String)} + deriving ( Show) +-- ErrL -------------------------------------------------------- +type ErrL = [Err] diff --git a/src/UHC/Light/Compiler/Error/Pretty.hs b/src/UHC/Light/Compiler/Error/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Error/Pretty.hs @@ -0,0 +1,1188 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Error/Pretty.a) +module UHC.Light.Compiler.Error.Pretty(ppErr, ppErrs, ppErrL +, mkPPErr) where + +import Data.List +import Data.Char +import Data.Maybe +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Util.ParseErrPrettyPrint hiding (ppErr) +import UHC.Util.FPath +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Pretty + + + + + + + + + + + + + + + +ppErrs :: ErrL -> PP_Doc +ppErrs errL = if null errL then empty else ppCmt ("***ERROR(S):" >-< indent 2 (ppErrL errL)) + + + +ppErrL :: ErrL -> PP_Doc +ppErrL errL = if null errL then empty else vlist (map ppErr errL) + +ppErr :: Err -> PP_Doc +ppErr err = let r = wrap_Err (sem_Err err) (Inh_Err {nestDepth_Inh_Err=0}) + in pp_Syn_Err r + + + +mkPPErr :: PP a => Range -> a -> Err +mkPPErr r = Err_PP r . pp + + + +ppMsgErr' :: PP msg => Maybe msg -> PP_Doc -> Range -> PP_Doc +ppMsgErr' msg err r + = mkre (mke msg err) + where mke Nothing err = err + mke (Just m) err = m >|< ":" >-< indent 2 err + mkre x | isEmptyRange r = x + | otherwise = r >|< ":" >-< indent 2 x + +ppMsgErr :: PP msg => msg -> PP_Doc -> Range -> PP_Doc +ppMsgErr msg err r = ppMsgErr' (Just msg) err r + +ppNoMsgErr :: PP_Doc -> Range -> PP_Doc +ppNoMsgErr err r = ppMsgErr' (Nothing :: Maybe PP_Doc) err r + + + +ppFitPair :: FIMode -> Ty -> Ty -> PP_Doc +ppFitPair fim t1 t2 + = if tyIsSimple t1 then p1 >|< p2 else p1 >-< p2 + where p1 = ppTy t1 + p2 = m fim >|< ppTy t2 + m fim = " " ++ show fim ++ " " + + + +ppUnifyErr :: PP msg => msg -> Ty -> Ty -> FIMode -> Ty -> Ty -> FIMode -> Range -> PP_Doc +ppUnifyErr msg t1 t2 fim t1d t2d fimd r + = ppMsgErr msg ( "failed to fit:" >#< ppFitPair fim t1 t2 + >-< "problem with :" >#< ppFitPair fimd t1d t2d -- (ppTy t1d >|< m fimd >|< ppTy t2d) + ) + r + where m fim = " " ++ show fim ++ " " + + + +ppNmAndRange :: PP x => [(x,Maybe [(Range,Maybe PP_Doc)])] -> PP_Doc +ppNmAndRange nmL + = case catMaybes $ map snd $ nmL of + [] -> ppListSep "" "" ", " $ map fst $ nmL + _ -> vlist [ n >|< (if null rs then empty else ":" >#< vlist rs) + | (n,mbrs) <- nmL + , let rs = maybe [] (\rs -> [ maybe (pp r) (\i -> r >#< ppParens i) mbinfo + | (r,mbinfo) <- rs, not (isEmptyRange r) + ] + ) mbrs + ] + +strCapHeading :: String -> String -> String +strCapHeading kind title@(ht:tt) + = maybeHd title (const (strCapitalize kind ++ " " ++ [toLower ht] ++ tt)) kind + +-- Err --------------------------------------------------------- +{- + visit 0: + inherited attribute: + nestDepth : Int + synthesized attributes: + isNestPP : Bool + pp : PP_Doc + alternatives: + alternative PP: + child range : {Range} + child pp : {PP_Doc} + alternative Str: + child range : {Range} + child str : {String} + alternative UnifyClash: + child range : {Range} + child ty1 : {Ty} + child ty2 : {Ty} + child fiMode : {FIMode} + child ty1detail : {Ty} + child ty2detail : {Ty} + child fiModeD : {FIMode} + alternative NamesNotIntrod: + child range : {Range} + child kind : {String} + child nmL : {[ThingAndRange PP_Doc]} + alternative PatArity: + child range : {Range} + child ty : {Ty} + child arity : {Int} + alternative PatArity2: + child range : {Range} + child kind : {String} + child what : {PP_Doc} + child arity : {Int} + alternative NamesDupIntrod: + child range : {Range} + child kind : {String} + child nmL : {[ThingAndRange HsName]} + alternative NestedIn: + child range : {Range} + child wher : {PP_Doc} + child errL : ErrL + visit 0: + local pp : _ + alternative Fixity: + child range : {Range} + child op1 : {PP_Doc} + child op2 : {PP_Doc} + alternative UnifyOccurs: + child range : {Range} + child ty1 : {Ty} + child ty2 : {Ty} + child fiMode : {FIMode} + child tvar : {TyVarId} + child ty2detail : {Ty} + child fiModeD : {FIMode} + alternative OccurCycle: + child range : {Range} + child tvar : {TyVarId} + child ty : {Ty} + alternative Newtype: + child range : {Range} + child tyNm : {HsName} + alternative FunPatternLengths: + child range : {Range} + child funNm : {HsName} + alternative MissingRowLabels: + child range : {Range} + child nmL : {[HsName]} + child ty : {Ty} + alternative TooManyRowLabels: + child range : {Range} + child nmL : {[HsName]} + child ty : {Ty} + alternative InconsistentIntros: + child range : {Range} + child kind : {String} + child nmL : {[HsName]} + alternative MissingDataFields: + child range : {Range} + child nmL : {[HsName]} + child con : {HsName} + alternative MissingAnyDataField: + child range : {Range} + child nmL : {[HsName]} + child tyNm : {HsName} + alternative DuplicateDataFields: + child range : {Range} + child nmL : {[HsName]} + alternative FileNotFound: + child range : {Range} + child fileName : {String} + child locations : {[String]} + child suffixes : {[FileSuffix]} + alternative AmbiguousExport: + child range : {Range} + child name : {HsName} + child entities : {[ThingAndRange HsName]} + alternative IllegalFFIWay: + child range : {Range} + child ffiWay : {FFIWay} + alternative TyCoreMatchClash: + child range : {Range} + child ty1 : {PP_Doc} + child ty2 : {PP_Doc} + child ty1detail : {Maybe PP_Doc} + child ty2detail : {Maybe PP_Doc} + alternative TyCoreSeqLevels: + child range : {Range} + child hereLev : {Int} + child mustLev : {Int} + child ty : {PP_Doc} + alternative NoCoerceDerivation: + child range : {Range} + child ty1 : {Ty} + child ty2 : {Ty} + child fiMode : {FIMode} + child func : {Ty} + child arg : {Ty} + alternative PrfCutOffReached: + child range : {Range} + child pred : {PredOcc} + child depth : {Int} + alternative NotProvenPreds: + child range : {Range} + child preds : {[((Pred,[Range]),PP_Doc)]} + alternative AmbigPreds: + child range : {Range} + child preds : {[(Pred,[Range])]} + child inQBinds : {AssocL HsName PP_Doc} + child inBinds : {AssocL HsName PP_Doc} + alternative OverlapPreds: + child range : {Range} + child overl : {AssocL Pred [PP_Doc]} + alternative TyHasFreeTVars: + child range : {Range} + child ty : {Ty} + alternative DeclsNotAllowed: + child range : {Range} + child inside : {String} + child decls : {AssocL IdOccKind [HsName]} + alternative ValWithoutSig: + child range : {Range} + child nmL : {[HsName]} + alternative NoMostSpecificPred: + child range : {Range} + child pred1 : {Pred} + child pred2 : {Pred} + alternative EvidenceAltsLeft: + child range : {Range} + alternative MalformedPred: + child range : {Range} + child pp : {PP_Doc} + alternative TyBetaRedLimit: + child range : {Range} + child ty : {Ty} + child tyTo : {Ty} + child limit : {Int} + alternative MayOnlyHaveNrMain: + child range : {Range} + child nrAllowed : {Int} + child prevModNmL : {[HsName]} + child modNm : {HsName} + alternative MayNotHaveMain: + child range : {Range} + child modNm : {HsName} + alternative MustHaveMain: + child range : {Range} + alternative ModNameMismatch: + child range : {Range} + child nmOfFile : {HsName} + child nmFromSrc : {HsName} + alternative AmbiguousNameRef: + child range : {Range} + child kindName : {String} + child kind : {String} + child nm : {HsName} + child nmAlts : {[HsName]} + alternative MutRecModules: + child range : {Range} + child mutRecL : {[[HsName]]} + alternative MalformedTy: + child range : {Range} + child kind : {String} + child purpose : {String} + child ty : {Ty} + alternative NoDerivFor: + child range : {Range} + child pred : {PP_Doc} + alternative NoDerivForData: + child range : {Range} + child ty : {Ty} + child clNm : {HsName} + child reason : {String} + alternative FusionBuildInverse: + child range : {Range} + child ty1 : {Ty} + child ty2 : {Ty} + alternative InconsistentHI: + child range : {Range} + child modNm : {String} + child file : {String} + child expected : {[String]} + child inHI : {[String]} + alternative WrongMagic: + child range : {Range} + child modNm : {String} + child file : {String} +-} +-- cata +sem_Err :: Err -> + T_Err +sem_Err (Err_PP _range _pp) = + (sem_Err_PP _range _pp) +sem_Err (Err_Str _range _str) = + (sem_Err_Str _range _str) +sem_Err (Err_UnifyClash _range _ty1 _ty2 _fiMode _ty1detail _ty2detail _fiModeD) = + (sem_Err_UnifyClash _range _ty1 _ty2 _fiMode _ty1detail _ty2detail _fiModeD) +sem_Err (Err_NamesNotIntrod _range _kind _nmL) = + (sem_Err_NamesNotIntrod _range _kind _nmL) +sem_Err (Err_PatArity _range _ty _arity) = + (sem_Err_PatArity _range _ty _arity) +sem_Err (Err_PatArity2 _range _kind _what _arity) = + (sem_Err_PatArity2 _range _kind _what _arity) +sem_Err (Err_NamesDupIntrod _range _kind _nmL) = + (sem_Err_NamesDupIntrod _range _kind _nmL) +sem_Err (Err_NestedIn _range _wher _errL) = + (sem_Err_NestedIn _range _wher (sem_ErrL _errL)) +sem_Err (Err_Fixity _range _op1 _op2) = + (sem_Err_Fixity _range _op1 _op2) +sem_Err (Err_UnifyOccurs _range _ty1 _ty2 _fiMode _tvar _ty2detail _fiModeD) = + (sem_Err_UnifyOccurs _range _ty1 _ty2 _fiMode _tvar _ty2detail _fiModeD) +sem_Err (Err_OccurCycle _range _tvar _ty) = + (sem_Err_OccurCycle _range _tvar _ty) +sem_Err (Err_Newtype _range _tyNm) = + (sem_Err_Newtype _range _tyNm) +sem_Err (Err_FunPatternLengths _range _funNm) = + (sem_Err_FunPatternLengths _range _funNm) +sem_Err (Err_MissingRowLabels _range _nmL _ty) = + (sem_Err_MissingRowLabels _range _nmL _ty) +sem_Err (Err_TooManyRowLabels _range _nmL _ty) = + (sem_Err_TooManyRowLabels _range _nmL _ty) +sem_Err (Err_InconsistentIntros _range _kind _nmL) = + (sem_Err_InconsistentIntros _range _kind _nmL) +sem_Err (Err_MissingDataFields _range _nmL _con) = + (sem_Err_MissingDataFields _range _nmL _con) +sem_Err (Err_MissingAnyDataField _range _nmL _tyNm) = + (sem_Err_MissingAnyDataField _range _nmL _tyNm) +sem_Err (Err_DuplicateDataFields _range _nmL) = + (sem_Err_DuplicateDataFields _range _nmL) +sem_Err (Err_FileNotFound _range _fileName _locations _suffixes) = + (sem_Err_FileNotFound _range _fileName _locations _suffixes) +sem_Err (Err_AmbiguousExport _range _name _entities) = + (sem_Err_AmbiguousExport _range _name _entities) +sem_Err (Err_IllegalFFIWay _range _ffiWay) = + (sem_Err_IllegalFFIWay _range _ffiWay) +sem_Err (Err_TyCoreMatchClash _range _ty1 _ty2 _ty1detail _ty2detail) = + (sem_Err_TyCoreMatchClash _range _ty1 _ty2 _ty1detail _ty2detail) +sem_Err (Err_TyCoreSeqLevels _range _hereLev _mustLev _ty) = + (sem_Err_TyCoreSeqLevels _range _hereLev _mustLev _ty) +sem_Err (Err_NoCoerceDerivation _range _ty1 _ty2 _fiMode _func _arg) = + (sem_Err_NoCoerceDerivation _range _ty1 _ty2 _fiMode _func _arg) +sem_Err (Err_PrfCutOffReached _range _pred _depth) = + (sem_Err_PrfCutOffReached _range _pred _depth) +sem_Err (Err_NotProvenPreds _range _preds) = + (sem_Err_NotProvenPreds _range _preds) +sem_Err (Err_AmbigPreds _range _preds _inQBinds _inBinds) = + (sem_Err_AmbigPreds _range _preds _inQBinds _inBinds) +sem_Err (Err_OverlapPreds _range _overl) = + (sem_Err_OverlapPreds _range _overl) +sem_Err (Err_TyHasFreeTVars _range _ty) = + (sem_Err_TyHasFreeTVars _range _ty) +sem_Err (Err_DeclsNotAllowed _range _inside _decls) = + (sem_Err_DeclsNotAllowed _range _inside _decls) +sem_Err (Err_ValWithoutSig _range _nmL) = + (sem_Err_ValWithoutSig _range _nmL) +sem_Err (Err_NoMostSpecificPred _range _pred1 _pred2) = + (sem_Err_NoMostSpecificPred _range _pred1 _pred2) +sem_Err (Err_EvidenceAltsLeft _range) = + (sem_Err_EvidenceAltsLeft _range) +sem_Err (Err_MalformedPred _range _pp) = + (sem_Err_MalformedPred _range _pp) +sem_Err (Err_TyBetaRedLimit _range _ty _tyTo _limit) = + (sem_Err_TyBetaRedLimit _range _ty _tyTo _limit) +sem_Err (Err_MayOnlyHaveNrMain _range _nrAllowed _prevModNmL _modNm) = + (sem_Err_MayOnlyHaveNrMain _range _nrAllowed _prevModNmL _modNm) +sem_Err (Err_MayNotHaveMain _range _modNm) = + (sem_Err_MayNotHaveMain _range _modNm) +sem_Err (Err_MustHaveMain _range) = + (sem_Err_MustHaveMain _range) +sem_Err (Err_ModNameMismatch _range _nmOfFile _nmFromSrc) = + (sem_Err_ModNameMismatch _range _nmOfFile _nmFromSrc) +sem_Err (Err_AmbiguousNameRef _range _kindName _kind _nm _nmAlts) = + (sem_Err_AmbiguousNameRef _range _kindName _kind _nm _nmAlts) +sem_Err (Err_MutRecModules _range _mutRecL) = + (sem_Err_MutRecModules _range _mutRecL) +sem_Err (Err_MalformedTy _range _kind _purpose _ty) = + (sem_Err_MalformedTy _range _kind _purpose _ty) +sem_Err (Err_NoDerivFor _range _pred) = + (sem_Err_NoDerivFor _range _pred) +sem_Err (Err_NoDerivForData _range _ty _clNm _reason) = + (sem_Err_NoDerivForData _range _ty _clNm _reason) +sem_Err (Err_FusionBuildInverse _range _ty1 _ty2) = + (sem_Err_FusionBuildInverse _range _ty1 _ty2) +sem_Err (Err_InconsistentHI _range _modNm _file _expected _inHI) = + (sem_Err_InconsistentHI _range _modNm _file _expected _inHI) +sem_Err (Err_WrongMagic _range _modNm _file) = + (sem_Err_WrongMagic _range _modNm _file) +-- semantic domain +type T_Err = Int -> + ( Bool,PP_Doc) +data Inh_Err = Inh_Err {nestDepth_Inh_Err :: !(Int)} +data Syn_Err = Syn_Err {isNestPP_Syn_Err :: !(Bool),pp_Syn_Err :: !(PP_Doc)} +wrap_Err :: T_Err -> + Inh_Err -> + Syn_Err +wrap_Err sem (Inh_Err _lhsInestDepth) = + (let ( _lhsOisNestPP,_lhsOpp) = sem _lhsInestDepth + in (Syn_Err _lhsOisNestPP _lhsOpp)) +sem_Err_PP :: Range -> + PP_Doc -> + T_Err +sem_Err_PP range_ pp_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppNoMsgErr pp_ + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_Str :: Range -> + String -> + T_Err +sem_Err_Str range_ str_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppNoMsgErr (pp str_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_UnifyClash :: Range -> + Ty -> + Ty -> + FIMode -> + Ty -> + Ty -> + FIMode -> + T_Err +sem_Err_UnifyClash range_ ty1_ ty2_ fiMode_ ty1detail_ ty2detail_ fiModeD_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppUnifyErr "Type clash" + ty1_ ty2_ fiMode_ ty1detail_ ty2detail_ fiModeD_ + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NamesNotIntrod :: Range -> + String -> + ([ThingAndRange PP_Doc]) -> + T_Err +sem_Err_NamesNotIntrod range_ kind_ nmL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr (strCapHeading kind_ "Names not in scope") + (ppNmAndRange nmL_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_PatArity :: Range -> + Ty -> + Int -> + T_Err +sem_Err_PatArity range_ ty_ arity_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Type has wrong arity for pattern") + ("type :" >#< ty_ >-< "arity:" >#< arity_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_PatArity2 :: Range -> + String -> + PP_Doc -> + Int -> + T_Err +sem_Err_PatArity2 range_ kind_ what_ arity_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr (strCapHeading kind_ "has wrong arity for pattern") + (kind_ >#< ":" >#< what_ >-< "arity:" >#< arity_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NamesDupIntrod :: Range -> + String -> + ([ThingAndRange HsName]) -> + T_Err +sem_Err_NamesDupIntrod range_ kind_ nmL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Name(s) for " ++ kind_ ++ "(s) introduced more than once") + (ppNmAndRange nmL_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NestedIn :: Range -> + PP_Doc -> + T_ErrL -> + T_Err +sem_Err_NestedIn range_ wher_ errL_ = + (\ _lhsInestDepth -> + (case (True) of + { _lhsOisNestPP -> + (case (errL_) of + { ( _errLIisEmpty,errL_1) -> + (case (if _errLIisEmpty then 0 else _lhsInestDepth+1) of + { _errLOnestDepth -> + (case (errL_1 _errLOnestDepth) of + { ( _errLIisNestPP,_errLIppL) -> + (case (let h = if _lhsInestDepth == 1 && _errLIisNestPP + then (text "..." >#<) + else if _lhsInestDepth <= 1 || _lhsInestDepth >= 1 && not _errLIisNestPP + then \x -> ppMsgErr ("In `" >|< wher_ >|< "'") x emptyRange + else id + in h (vlist _errLIppL)) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) }) }) }) }) })) +sem_Err_Fixity :: Range -> + PP_Doc -> + PP_Doc -> + T_Err +sem_Err_Fixity range_ op1_ op2_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Fixity mismatch between" (ppListSep "" "" ", " [op1_,op2_]) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_UnifyOccurs :: Range -> + Ty -> + Ty -> + FIMode -> + TyVarId -> + Ty -> + FIMode -> + T_Err +sem_Err_UnifyOccurs range_ ty1_ ty2_ fiMode_ tvar_ ty2detail_ fiModeD_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppUnifyErr "Infinite type" + ty1_ ty2_ fiMode_ (mkTyVar tvar_) ty2detail_ fiModeD_ + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_OccurCycle :: Range -> + TyVarId -> + Ty -> + T_Err +sem_Err_OccurCycle range_ tvar_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Occur cycle" + ( "type var:" >#< pp tvar_ + >-< "to type :" >#< pp ty_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_Newtype :: Range -> + HsName -> + T_Err +sem_Err_Newtype range_ tyNm_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Newtype must have exactly 1 constructor with 1 field") + ("Type:" >#< tyNm_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_FunPatternLengths :: Range -> + HsName -> + T_Err +sem_Err_FunPatternLengths range_ funNm_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Nr of arguments to function must be equal for all function alternatives") + ("Function:" >#< funNm_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MissingRowLabels :: Range -> + ([HsName]) -> + Ty -> + T_Err +sem_Err_MissingRowLabels range_ nmL_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Missing label(s) in row") + ("Label(s):" >#< ppCommas' nmL_ >-< "Row :" >#< ppTy ty_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_TooManyRowLabels :: Range -> + ([HsName]) -> + Ty -> + T_Err +sem_Err_TooManyRowLabels range_ nmL_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Too many label(s) to fit in row" + ("Label(s):" >#< ppCommas' nmL_ >-< "Row :" >#< ppTy ty_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_InconsistentIntros :: Range -> + String -> + ([HsName]) -> + T_Err +sem_Err_InconsistentIntros range_ kind_ nmL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Inconsistent " ++ kind_ ++ " introductions for") + ("names:" >#< ppCommas' nmL_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MissingDataFields :: Range -> + ([HsName]) -> + HsName -> + T_Err +sem_Err_MissingDataFields range_ nmL_ con_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Missing field(s) in data construction") + ("Field(s) :" >#< ppCommas' nmL_ >-< "Constructor:" >#< pp con_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MissingAnyDataField :: Range -> + ([HsName]) -> + HsName -> + T_Err +sem_Err_MissingAnyDataField range_ nmL_ tyNm_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("No data constructor has all fields") + ("Field(s):" >#< ppCommas' nmL_ >-< "Type :" >#< pp tyNm_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_DuplicateDataFields :: Range -> + ([HsName]) -> + T_Err +sem_Err_DuplicateDataFields range_ nmL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Duplicate field(s) in data construction/update") + ("Field(s):" >#< ppCommas' nmL_) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_FileNotFound :: Range -> + String -> + ([String]) -> + ([FileSuffix]) -> + T_Err +sem_Err_FileNotFound range_ fileName_ locations_ suffixes_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "File not found" + ( "file name :" >#< fileName_ + >-< "searched locations:" >#< vlist (map (text.show) locations_) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_AmbiguousExport :: Range -> + HsName -> + ([ThingAndRange HsName]) -> + T_Err +sem_Err_AmbiguousExport range_ name_ entities_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Ambiguous export" + ( "name :" >#< name_ + >-< "exports:" >#< ppNmAndRange entities_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_IllegalFFIWay :: Range -> + FFIWay -> + T_Err +sem_Err_IllegalFFIWay range_ ffiWay_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Illegal foreign interface" + ( "to:" >#< ffiWay_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_TyCoreMatchClash :: Range -> + PP_Doc -> + PP_Doc -> + (Maybe PP_Doc) -> + (Maybe PP_Doc) -> + T_Err +sem_Err_TyCoreMatchClash range_ ty1_ ty2_ ty1detail_ ty2detail_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Core type mismatch" + ( "between :" >#< ty1_ + >-< "and :" >#< ty2_ + >-< maybe empty (\d -> "in detail between:" >#< d) ty1detail_ + >-< maybe empty (\d -> "and :" >#< d) ty2detail_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_TyCoreSeqLevels :: Range -> + Int -> + Int -> + PP_Doc -> + T_Err +sem_Err_TyCoreSeqLevels range_ hereLev_ mustLev_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "TyCore sequence nr of levels error" + ( "#levels :" >#< hereLev_ + >-< "must be #levels:" >#< mustLev_ + >-< "in :" >#< ty_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NoCoerceDerivation :: Range -> + Ty -> + Ty -> + FIMode -> + Ty -> + Ty -> + T_Err +sem_Err_NoCoerceDerivation range_ ty1_ ty2_ fiMode_ func_ arg_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Cannot derive coercion for type application" + ( "in fit :" >#< ppFitPair fiMode_ ty1_ ty2_ + >-< "type function:" >#< pp func_ + >-< "type arg :" >#< pp arg_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_PrfCutOffReached :: Range -> + PredOcc -> + Int -> + T_Err +sem_Err_PrfCutOffReached range_ pred_ depth_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Proof cut off limit reached" + ( "limit:" >#< pp depth_ + >-< "pred :" >#< pp pred_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NotProvenPreds :: Range -> + ([((Pred,[Range]),PP_Doc)]) -> + T_Err +sem_Err_NotProvenPreds range_ preds_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Predicates remain unproven" + ( "preds:" >#< (vlist [ pp p >-< indent 2 (("at :" >#< vlist r) >-< ("trace:" >#< t)) | ((p,r),t) <- preds_ ] ) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_AmbigPreds :: Range -> + ([(Pred,[Range])]) -> + (AssocL HsName PP_Doc) -> + (AssocL HsName PP_Doc) -> + T_Err +sem_Err_AmbigPreds range_ preds_ inQBinds_ inBinds_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Predicates leading to ambiguous type" + ( "preds :" >#< (ppAssocLV $ assocLMapElt vlist preds_) + >-< "bindings :" >#< ppAssocLV inBinds_ + >-< "bindings (quantified):" >#< ppAssocLV inQBinds_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_OverlapPreds :: Range -> + (AssocL Pred [PP_Doc]) -> + T_Err +sem_Err_OverlapPreds range_ overl_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Proofs for predicates overlap" + ( vlist . map (\(p,evs) -> p >#< ":" >#< ppBracketsCommas evs) $ overl_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_TyHasFreeTVars :: Range -> + Ty -> + T_Err +sem_Err_TyHasFreeTVars range_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Type has free type variables (not allowed)" + ( "type:" >#< pp ty_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_DeclsNotAllowed :: Range -> + String -> + (AssocL IdOccKind [HsName]) -> + T_Err +sem_Err_DeclsNotAllowed range_ inside_ decls_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Declarations are not allowed " ++ inside_) + (vlist [ k >|< ":" >#< ppCommas ns | (k,ns) <- decls_ ] + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_ValWithoutSig :: Range -> + ([HsName]) -> + T_Err +sem_Err_ValWithoutSig range_ nmL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Instance members without corresponding signature from class") + ( "names:" >#< ppCommas nmL_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NoMostSpecificPred :: Range -> + Pred -> + Pred -> + T_Err +sem_Err_NoMostSpecificPred range_ pred1_ pred2_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Cannot determine most specific predicate" + ( "preds:" >#< vlist [pred1_,pred2_] + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_EvidenceAltsLeft :: Range -> + T_Err +sem_Err_EvidenceAltsLeft range_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Evidence alternatives left (TBD: more info)" + ( empty + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MalformedPred :: Range -> + PP_Doc -> + T_Err +sem_Err_MalformedPred range_ pp_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Type cannot be parsed as context") + ( "type:" >#< pp_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_TyBetaRedLimit :: Range -> + Ty -> + Ty -> + Int -> + T_Err +sem_Err_TyBetaRedLimit range_ ty_ tyTo_ limit_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Type synonym expansion limit reached" + ( "limit :" >#< pp limit_ + >-< "type :" >#< pp ty_ + >-< "last expansion :" >#< pp tyTo_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MayOnlyHaveNrMain :: Range -> + Int -> + ([HsName]) -> + HsName -> + T_Err +sem_Err_MayOnlyHaveNrMain range_ nrAllowed_ prevModNmL_ modNm_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Number of definitions for 'main' exceeds limit" + ( "limit :" >#< nrAllowed_ + >-< "module :" >#< modNm_ + >-< (if null prevModNmL_ then empty else "previously defined in:" >#< ppCommas' prevModNmL_) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MayNotHaveMain :: Range -> + HsName -> + T_Err +sem_Err_MayNotHaveMain range_ modNm_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "May not have a 'main'" + ("module:" >#< modNm_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MustHaveMain :: Range -> + T_Err +sem_Err_MustHaveMain range_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "No 'main' defined" + empty + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_ModNameMismatch :: Range -> + HsName -> + HsName -> + T_Err +sem_Err_ModNameMismatch range_ nmOfFile_ nmFromSrc_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Module names do not match" + ( "filename :" >#< nmOfFile_ + >-< "name from source:" >#< nmFromSrc_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_AmbiguousNameRef :: Range -> + String -> + String -> + HsName -> + ([HsName]) -> + T_Err +sem_Err_AmbiguousNameRef range_ kindName_ kind_ nm_ nmAlts_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Ambiguous " ++ kind_ ++ " name reference") + ( (take 12 (kindName_ ++ repeat ' ') ++ + ":") >#< nm_ + >-< "may refer to:" >#< vlist (map pp nmAlts_) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MutRecModules :: Range -> + ([[HsName]]) -> + T_Err +sem_Err_MutRecModules range_ mutRecL_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr "Mutually recursive modules" + ( "modules:" >#< vlist (map ppCommas' mutRecL_) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_MalformedTy :: Range -> + String -> + String -> + Ty -> + T_Err +sem_Err_MalformedTy range_ kind_ purpose_ ty_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Malformed " ++ kind_ ++ " for " ++ purpose_) + ( kind_ >|< ":" >#< ppTy ty_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NoDerivFor :: Range -> + PP_Doc -> + T_Err +sem_Err_NoDerivFor range_ pred_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("No deriving for") + ( "predicate:" >#< pred_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_NoDerivForData :: Range -> + Ty -> + HsName -> + String -> + T_Err +sem_Err_NoDerivForData range_ ty_ clNm_ reason_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Data type has wrong structure for deriving") + ( "data type :" >#< ty_ + >-< "class name:" >#< clNm_ + >-< "because :" >#< reason_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_FusionBuildInverse :: Range -> + Ty -> + Ty -> + T_Err +sem_Err_FusionBuildInverse range_ ty1_ ty2_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr ("Fusion build/unbuild pair are not each others type level inverse") + ( "type 1 :" >#< ty1_ + >-< "type 2 inverse:" >#< ty2_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_InconsistentHI :: Range -> + String -> + String -> + ([String]) -> + ([String]) -> + T_Err +sem_Err_InconsistentHI range_ modNm_ file_ expected_ inHI_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr (".hi file cannot be used with this compiler") + ( "module :" >#< modNm_ + >-< "file :" >#< file_ + >-< "this compiler :" >#< (concat $ intersperse " / " expected_) + >-< "compiler of .hi file:" >#< (concat $ intersperse " / " inHI_ ) + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +sem_Err_WrongMagic :: Range -> + String -> + String -> + T_Err +sem_Err_WrongMagic range_ modNm_ file_ = + (\ _lhsInestDepth -> + (case (False) of + { _lhsOisNestPP -> + (case (ppMsgErr (".hi file has wrong magic number") + ( "module :" >#< modNm_ + >-< "file :" >#< file_ + ) + range_) of + { _lhsOpp -> + ( _lhsOisNestPP,_lhsOpp) }) })) +-- ErrL -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + isEmpty : Bool + visit 1: + inherited attribute: + nestDepth : Int + synthesized attributes: + isNestPP : Bool + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : Err + child tl : ErrL + alternative Nil: +-} +-- cata +sem_ErrL :: ErrL -> + T_ErrL +sem_ErrL list = + (Prelude.foldr sem_ErrL_Cons sem_ErrL_Nil (Prelude.map sem_Err list)) +-- semantic domain +type T_ErrL = ( Bool,T_ErrL_1) +type T_ErrL_1 = Int -> + ( Bool,([PP_Doc])) +sem_ErrL_Cons :: T_Err -> + T_ErrL -> + T_ErrL +sem_ErrL_Cons hd_ tl_ = + (case (False) of + { _lhsOisEmpty -> + (case ((let sem_ErrL_Cons_1 :: T_ErrL_1 + sem_ErrL_Cons_1 = + (\ _lhsInestDepth -> + (case (tl_) of + { ( _tlIisEmpty,tl_1) -> + (case (_lhsInestDepth) of + { _tlOnestDepth -> + (case (tl_1 _tlOnestDepth) of + { ( _tlIisNestPP,_tlIppL) -> + (case (_lhsInestDepth) of + { _hdOnestDepth -> + (case (hd_ _hdOnestDepth) of + { ( _hdIisNestPP,_hdIpp) -> + (case (_hdIisNestPP && _tlIisNestPP) of + { _lhsOisNestPP -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOisNestPP,_lhsOppL) }) }) }) }) }) }) })) + in sem_ErrL_Cons_1)) of + { ( sem_ErrL_1) -> + ( _lhsOisEmpty,sem_ErrL_1) }) }) +sem_ErrL_Nil :: T_ErrL +sem_ErrL_Nil = + (case (True) of + { _lhsOisEmpty -> + (case ((let sem_ErrL_Nil_1 :: T_ErrL_1 + sem_ErrL_Nil_1 = + (\ _lhsInestDepth -> + (case (True) of + { _lhsOisNestPP -> + (case ([]) of + { _lhsOppL -> + ( _lhsOisNestPP,_lhsOppL) }) })) + in sem_ErrL_Nil_1)) of + { ( sem_ErrL_1) -> + ( _lhsOisEmpty,sem_ErrL_1) }) }) diff --git a/src/UHC/Light/Compiler/FinalEnv.hs b/src/UHC/Light/Compiler/FinalEnv.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/FinalEnv.hs @@ -0,0 +1,21 @@ +module UHC.Light.Compiler.FinalEnv +( ToSysfEnv (..), emptyToSysfEnv ) +where +import UHC.Light.Compiler.Gam.Base +import UHC.Light.Compiler.Gam.TyKiGam +import UHC.Light.Compiler.Gam.ClGam + + +{-# LINE 31 "src/ehc/FinalEnv.chs" #-} +data ToSysfEnv + = ToSysfEnv + { sysfenvTyKiGam :: TyKiGam + , sysfenvClGam :: ClGam + } + +emptyToSysfEnv :: ToSysfEnv +emptyToSysfEnv + = ToSysfEnv + emptyGam + emptyGam + diff --git a/src/UHC/Light/Compiler/Foreign.hs b/src/UHC/Light/Compiler/Foreign.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Foreign.hs @@ -0,0 +1,250 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Foreign.ag) +module UHC.Light.Compiler.Foreign(ForeignEnt (..), CCall (..), PlainCall (..), PrimCall (..), JavaScriptCall (..) +, ForeignExpr (..), ForeignExprs +, ForeignExprAGItf (..), ForeignAGItf (..) +, foreignexprEval +, ForeignDirection (..)) where + +import UHC.Light.Compiler.Base.Common +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Util.Utils +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Typeable (Typeable) +import Data.Generics (Data) + + + + + + + + + + + + + + + + + + + +-- | evaluation of a ForeignExpr has arguments, known by index [1..], and a foreign entity + +data IE e + = IE { ieArgs :: [e] + } + +data OE e + = OE { oeEL :: [e] + , oeUsed :: Set.Set Int + } + +mkOE :: e -> Set.Set Int -> OE e +mkOE e s = OE [e] s + +oeE :: OE e -> e +oeE = head . oeEL + +foreignexprEval + :: -- the (partial) algebra for constructing an e + ( e -> e -> e -- select + , e -> e -> e -- index + , e -> [e] -> e -- call + , e -> e -- as var/ptr + , [e] -> e -- object + , e -> e -- new object + , String -> e -- name + , String -> e -- string + ) + -> ForeignExpr + -> e -- ent + -> [e] -- args + -> e +foreignexprEval + (mkSel,mkInx,mkCall,mkPtr,mkObj,mkNewObj,mkNm,mkStr) + fexpr ent args + = oeE oe + where argl = zip [1..] args + env = Map.fromList argl + oe = ev fexpr (IE [a | (i,a) <- argl, not $ i `Set.member` oeUsed oe]) + ev (ForeignExpr_Ent ) ie = let + in mkOE ent + ( Set.empty ) + ev (ForeignExpr_EntNm n) ie = let + in mkOE ( mkNm n ) + ( Set.empty ) + ev (ForeignExpr_Str s) ie = let + in mkOE ( mkStr s ) + ( Set.empty ) + ev (ForeignExpr_Arg a ) ie = let + in mkOE ( Map.findWithDefault (panic "foreignexprEval.Arg") a env ) + ( Set.singleton a ) + ev (ForeignExpr_AllArg ) ie = let + in OE ( ieArgs ie ) + ( Set.empty ) + ev (ForeignExpr_Sel e s) ie = let eo = ev e ie + so = ev s ie + in mkOE ( mkSel (oeE eo) (oeE so) ) + ( oeUsed eo `Set.union` oeUsed so ) + ev (ForeignExpr_Inx e i) ie = let eo = ev e ie + io = ev i ie + in mkOE ( mkInx (oeE eo) (oeE io) ) + ( oeUsed eo `Set.union` oeUsed io ) + ev (ForeignExpr_Ptr e ) ie = let eo = ev e ie + in eo {oeEL = [mkPtr $ oeE eo]} + ev (ForeignExpr_Call e ) ie = let eo = ev e ie + in eo {oeEL = [mkCall (oeE eo) (ieArgs ie)]} + ev (ForeignExpr_CallArgs f a) + ie = let fo = ev f ie + ao = evs a ie + in mkOE ( mkCall (oeE fo) (concatMap oeEL ao) ) + ( Set.unions $ oeUsed fo : map oeUsed ao ) + ev (ForeignExpr_ObjData) ie = let + in mkOE ( mkObj (ieArgs ie) ) + ( Set.empty ) + ev (ForeignExpr_NewObj e) ie = let eo = ev e ie + in eo { oeEL = [mkNewObj $ oeE eo] } + + evs feL ie = map (\e -> ev e ie) feL + + + +data ForeignDirection + = ForeignDirection_Import + | ForeignDirection_Export + deriving (Eq,Ord) + + + +instance Serialize ForeignExpr where + sput (ForeignExpr_Ent ) = sputWord8 0 + sput (ForeignExpr_EntNm a ) = sputWord8 1 >> sput a + sput (ForeignExpr_Arg a ) = sputWord8 2 >> sput a + sput (ForeignExpr_Sel a b) = sputWord8 3 >> sput a >> sput b + sput (ForeignExpr_Inx a b) = sputWord8 4 >> sput a >> sput b + sput (ForeignExpr_Ptr a ) = sputWord8 5 >> sput a + sput (ForeignExpr_Call a ) = sputWord8 6 >> sput a + sput (ForeignExpr_CallArgs a b) = sputWord8 7 >> sput a >> sput b + sput (ForeignExpr_AllArg ) = sputWord8 8 + sput (ForeignExpr_Str a ) = sputWord8 9 >> sput a + sput (ForeignExpr_ObjData ) = sputWord8 10 + sput (ForeignExpr_NewObj a ) = sputWord8 11 >> sput a + sget = do + t <- sgetWord8 + case t of + 0 -> return ForeignExpr_Ent + 1 -> liftM ForeignExpr_EntNm sget + 2 -> liftM ForeignExpr_Arg sget + 3 -> liftM2 ForeignExpr_Sel sget sget + 4 -> liftM2 ForeignExpr_Inx sget sget + 5 -> liftM ForeignExpr_Ptr sget + 6 -> liftM ForeignExpr_Call sget + 7 -> liftM2 ForeignExpr_CallArgs sget sget + 8 -> return ForeignExpr_AllArg + 9 -> liftM ForeignExpr_Str sget + 10 -> return ForeignExpr_ObjData + 11 -> liftM ForeignExpr_NewObj sget + + +instance Serialize ForeignEnt where + sput (ForeignEnt_CCall a) = sputWord8 0 >> sput a + sput (ForeignEnt_PlainCall a) = sputWord8 1 >> sput a + sput (ForeignEnt_PrimCall a) = sputWord8 2 >> sput a + sput (ForeignEnt_JavaScriptCall a) = sputWord8 3 >> sput a + sget = do t <- sgetWord8 + case t of + 0 -> liftM ForeignEnt_CCall sget + 1 -> liftM ForeignEnt_PlainCall sget + 2 -> liftM ForeignEnt_PrimCall sget + 3 -> liftM ForeignEnt_JavaScriptCall sget + +instance Serialize CCall where + sput (CCall_Id a b c d) = sputWord8 0 >> sput a >> sput b >> sput c >> sput d + sput (CCall_Dynamic ) = sputWord8 1 + sput (CCall_Wrapper ) = sputWord8 2 + sget = do t <- sgetWord8 + case t of + 0 -> liftM4 CCall_Id sget sget sget sget + 1 -> return CCall_Dynamic + 2 -> return CCall_Wrapper + +instance Serialize PlainCall where + sput (PlainCall_Id a) = sputWord8 0 >> sput a + sget = do t <- sgetWord8 + case t of + 0 -> liftM PlainCall_Id sget + +instance Serialize PrimCall where + sput (PrimCall_Id a b) = sputWord8 0 >> sput a >> sput b + sget = do t <- sgetWord8 + case t of + 0 -> liftM2 PrimCall_Id sget sget + +{- +instance Serialize JavaScriptCall where + sput (JavaScriptCall_Id a b c d) = sputWord8 0 >> sput a >> sput b >> sput c >> sput d + sget = do t <- sgetWord8 + case t of + 0 -> liftM4 JavaScriptCall_Id sget sget sget sget +-} +instance Serialize JavaScriptCall where + sput (JavaScriptCall_Id a b c) = sputWord8 0 >> sput a >> sput b >> sput c + sput (JavaScriptCall_Dynamic ) = sputWord8 1 + sput (JavaScriptCall_Wrapper ) = sputWord8 2 + sget = do t <- sgetWord8 + case t of + 0 -> liftM3 JavaScriptCall_Id sget sget sget + 1 -> return JavaScriptCall_Dynamic + 2 -> return JavaScriptCall_Wrapper + + +-- CCall ------------------------------------------------------- +data CCall = CCall_Id {isStatic_CCall_Id :: !(Bool),mbInclude_CCall_Id :: !((Maybe String)),asPointer_CCall_Id :: !(Bool),nm_CCall_Id :: !(String)} + | CCall_Dynamic {} + | CCall_Wrapper {} + deriving ( Data,Eq,Show,Typeable) +-- ForeignAGItf ------------------------------------------------ +data ForeignAGItf = ForeignAGItf_AGItf {ent_ForeignAGItf_AGItf :: !(ForeignEnt)} +-- ForeignEnt -------------------------------------------------- +data ForeignEnt = ForeignEnt_CCall {ent_ForeignEnt_CCall :: !(CCall)} + | ForeignEnt_PlainCall {ent_ForeignEnt_PlainCall :: !(PlainCall)} + | ForeignEnt_PrimCall {ent_ForeignEnt_PrimCall :: !(PrimCall)} + | ForeignEnt_JavaScriptCall {ent_ForeignEnt_JavaScriptCall :: !(JavaScriptCall)} + deriving ( Data,Eq,Show,Typeable) +-- ForeignExpr ------------------------------------------------- +data ForeignExpr = ForeignExpr_Call {expr_ForeignExpr_Call :: !(ForeignExpr)} + | ForeignExpr_CallArgs {expr_ForeignExpr_CallArgs :: !(ForeignExpr),args_ForeignExpr_CallArgs :: !(ForeignExprs)} + | ForeignExpr_Ptr {expr_ForeignExpr_Ptr :: !(ForeignExpr)} + | ForeignExpr_Sel {expr_ForeignExpr_Sel :: !(ForeignExpr),sel_ForeignExpr_Sel :: !(ForeignExpr)} + | ForeignExpr_Inx {expr_ForeignExpr_Inx :: !(ForeignExpr),inx_ForeignExpr_Inx :: !(ForeignExpr)} + | ForeignExpr_Ent {} + | ForeignExpr_EntNm {nm_ForeignExpr_EntNm :: !(String)} + | ForeignExpr_Arg {nr_ForeignExpr_Arg :: !(Int)} + | ForeignExpr_AllArg {} + | ForeignExpr_Empty {} + | ForeignExpr_Str {str_ForeignExpr_Str :: !(String)} + | ForeignExpr_ObjData {} + | ForeignExpr_NewObj {expr_ForeignExpr_NewObj :: !(ForeignExpr)} + deriving ( Data,Eq,Show,Typeable) +-- ForeignExprAGItf -------------------------------------------- +data ForeignExprAGItf = ForeignExprAGItf_AGItf {expr_ForeignExprAGItf_AGItf :: !(ForeignExpr)} +-- ForeignExprs ------------------------------------------------ +type ForeignExprs = [ForeignExpr] +-- JavaScriptCall ---------------------------------------------- +data JavaScriptCall = JavaScriptCall_Id {nm_JavaScriptCall_Id :: !(String),mbInclude_JavaScriptCall_Id :: !((Maybe String)),mbForeignExpr_JavaScriptCall_Id :: !((Maybe ForeignExpr))} + | JavaScriptCall_Dynamic {} + | JavaScriptCall_Wrapper {} + deriving ( Data,Eq,Show,Typeable) +-- PlainCall --------------------------------------------------- +data PlainCall = PlainCall_Id {nm_PlainCall_Id :: !(String)} + deriving ( Data,Eq,Show,Typeable) +-- PrimCall ---------------------------------------------------- +data PrimCall = PrimCall_Id {nm_PrimCall_Id :: !(String),mbKnownPrim_PrimCall_Id :: !((Maybe KnownPrim))} + deriving ( Data,Eq,Show,Typeable) diff --git a/src/UHC/Light/Compiler/Foreign/Boxing.hs b/src/UHC/Light/Compiler/Foreign/Boxing.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Foreign/Boxing.hs @@ -0,0 +1,186 @@ +module UHC.Light.Compiler.Foreign.Boxing +( UnboxedTy (..) +, Boxing (..) +, tyNmIsFFIOpaque, tyNmIsFFIEnumable +, tyNm2Boxing ) +where +import Control.Applicative +import qualified Data.Map as Map +import Data.Maybe +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.CodeGen.BuiltinSizeInfo +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam.DataGam +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 40 "src/ehc/Foreign/Boxing.chs" #-} +data UnboxedTy = + -- bitsize implicit variants + UnboxedTy_Int + | UnboxedTy_Node -- the default uniform boxed representation + | UnboxedTy_Word + | UnboxedTy_Ptr + -- Word variants, bitsize explicit + | UnboxedTy_Word8 + | UnboxedTy_Word16 + | UnboxedTy_Word32 + | UnboxedTy_Word64 + -- Int variants, bitsize explicit + | UnboxedTy_Int8 + | UnboxedTy_Int16 + | UnboxedTy_Int32 + | UnboxedTy_Int64 + -- Char variants, bitsize explicit + | UnboxedTy_Char8 -- non unicode char + -- String variants, bitsize explicit + | UnboxedTy_String8 -- non unicode char + -- Float variants + | UnboxedTy_Float + | UnboxedTy_Double + deriving (Eq,Ord,Enum) + +{-# LINE 67 "src/ehc/Foreign/Boxing.chs" #-} +instance Show UnboxedTy where + show UnboxedTy_Int = "i" + show UnboxedTy_Node = "n" + show UnboxedTy_Word = "w" + show UnboxedTy_Ptr = "p" + show UnboxedTy_Word8 = "w08" + show UnboxedTy_Word16 = "w16" + show UnboxedTy_Word32 = "w32" + show UnboxedTy_Word64 = "w64" + show UnboxedTy_Int8 = "i08" + show UnboxedTy_Int16 = "i16" + show UnboxedTy_Int32 = "i32" + show UnboxedTy_Int64 = "i64" + show UnboxedTy_Char8 = "c08" + show UnboxedTy_String8 = "s08" + show UnboxedTy_Float = "f32" + show UnboxedTy_Double = "d64" + +{-# LINE 87 "src/ehc/Foreign/Boxing.chs" #-} +instance PP UnboxedTy where + pp = pp . show + +{-# LINE 96 "src/ehc/Foreign/Boxing.chs" #-} +-- | How to (un)box +data Boxing + = Boxing_UnboxedTy -- explicit unboxed ty + { bxUnboxedTy :: UnboxedTy + } + | Boxing_Enum -- encoding for Enum -- ?? necessary + | Boxing_Opaque -- don't know anything, leave as is + deriving Eq + +{-# LINE 107 "src/ehc/Foreign/Boxing.chs" #-} +instance Show Boxing where + show (Boxing_UnboxedTy t) = "#B" ++ show t + show Boxing_Enum = "#Be" + show Boxing_Opaque = "#Bo" + +instance PP Boxing where + pp = pp . show + +{-# LINE 121 "src/ehc/Foreign/Boxing.chs" #-} +-- | is type (name) living opaque w.r.t. ffi? +tyNmIsFFIOpaque :: DataGam -> HsName -> Bool +tyNmIsFFIOpaque dataGam t = maybe True null (dataGamTagsOfTyNm t dataGam) + +-- | is type (name) Enumable, that is, representable by an Int? +tyNmIsFFIEnumable :: DataGam -> HsName -> Bool +tyNmIsFFIEnumable dataGam tn = maybe False dgiIsEnumable (dataGamLookup tn dataGam) + +{-# LINE 131 "src/ehc/Foreign/Boxing.chs" #-} +-- | Get the boxing representation of a type +tyNm2Boxing :: EHCOpts -> DataGam -> HsName -> Boxing +tyNm2Boxing opts dataGam tyNm + | tyNmIsFFIEnumable dataGam tyNm = Boxing_Enum + | isJust mbUnbTy = Boxing_UnboxedTy unbTy + | tyNmIsFFIOpaque dataGam tyNm = Boxing_Opaque + | otherwise = Boxing_UnboxedTy UnboxedTy_Node + where mbUnbTy@(~(Just unbTy)) = Map.lookup tyNm unboxedTyMp1 <|> Map.lookup tyNm (unboxedTyMp2 opts) + +{-# LINE 142 "src/ehc/Foreign/Boxing.chs" #-} +unboxedTyMp1 :: Map.Map HsName UnboxedTy +unboxedTyMp1 + = Map.fromList + [ ( hsnInt + , UnboxedTy_Int + ) + , ( hsnChar + , UnboxedTy_Char8 + ) + ] + +unboxedTyMp2 :: EHCOpts -> Map.Map HsName UnboxedTy +unboxedTyMp2 opts + = Map.fromList + [ ( ehcOptBuiltin opts ehbnPackedString + , UnboxedTy_String8 + ) + , ( ehcOptBuiltin opts ehbnWord + , UnboxedTy_Word + ) + , ( ehcOptBuiltin opts ehbnInt8 + , UnboxedTy_Int8 + ) + , ( ehcOptBuiltin opts ehbnInt16 + , UnboxedTy_Int16 + ) + , ( ehcOptBuiltin opts ehbnInt32 + , UnboxedTy_Int32 + ) + , ( ehcOptBuiltin opts ehbnInt64 + , UnboxedTy_Int64 + ) + , ( ehcOptBuiltin opts ehbnWord8 + , UnboxedTy_Word8 + ) + , ( ehcOptBuiltin opts ehbnWord16 + , UnboxedTy_Word16 + ) + , ( ehcOptBuiltin opts ehbnWord32 + , UnboxedTy_Word32 + ) + , ( ehcOptBuiltin opts ehbnWord64 + , UnboxedTy_Word64 + ) + , ( ehcOptBuiltin opts ehbnDouble + , UnboxedTy_Double + ) + , ( ehcOptBuiltin opts ehbnAddr + , UnboxedTy_Ptr + ) + ] + +{-# LINE 204 "src/ehc/Foreign/Boxing.chs" #-} +deriving instance Typeable UnboxedTy +deriving instance Data UnboxedTy + +deriving instance Typeable Boxing +deriving instance Data Boxing + +{-# LINE 212 "src/ehc/Foreign/Boxing.chs" #-} +instance Serialize Boxing where + sput (Boxing_UnboxedTy a) = sputWord8 0 >> sput a + sput (Boxing_Enum ) = sputWord8 1 + sput (Boxing_Opaque ) = sputWord8 2 + sget = do + t <- sgetWord8 + case t of + 0 -> liftM Boxing_UnboxedTy sget + 1 -> return Boxing_Enum + 2 -> return Boxing_Opaque + +instance Serialize UnboxedTy where + sput = sputEnum8 + sget = sgetEnum8 + + diff --git a/src/UHC/Light/Compiler/Foreign/Extract.hs b/src/UHC/Light/Compiler/Foreign/Extract.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Foreign/Extract.hs @@ -0,0 +1,442 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Foreign/Extrac) +module UHC.Light.Compiler.Foreign.Extract(ForeignExtraction (..), forextractMbEnt +, foreignEntExtract) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Foreign +import Data.Maybe + + + + + + + + + +-- | all relevant info for all calling conventions is gathered in one place, for backends to choose from +data ForeignExtraction + = ForeignExtraction_Plain + { forextractIncludes :: ![String] -- ccall: include files + , forextractEnt :: !String -- all: name of function/... + , forextractMbKnownPrim :: !(Maybe KnownPrim) -- prim: known semantics + , forextractMbThisArgNr :: !(Maybe Int) -- javascript: which arg acts as this/receiver of call + , forextractMbIndexArgNr :: !(Maybe Int) -- javascript: combination with indexing an array + , forextractOptIsStatic :: !Bool -- ccall: static + , forextractOptIsPtr :: !Bool -- ccall: pointer + , forextractForeignExpr :: !ForeignExpr -- the AST for building the FFI call in terms of the target language (20101020 AD: soon replaces flags above) + } + | ForeignExtraction_Wrapper + | ForeignExtraction_Dynamic + +instance Show ForeignExtraction where + show (ForeignExtraction_Plain {forextractEnt=e}) = show e + show ForeignExtraction_Wrapper = "wrapper" + show ForeignExtraction_Dynamic = "dynamic" + +emptyForeignExtraction = ForeignExtraction_Plain [] "??" Nothing Nothing Nothing False False (ForeignExpr_Call ForeignExpr_Ent) + +forextractMbEnt :: ForeignExtraction -> Maybe String +forextractMbEnt (ForeignExtraction_Plain{forextractEnt=e}) = Just e +forextractMbEnt _ = Nothing + + + +foreignEntExtract :: ForeignEnt -> ForeignExtraction +foreignEntExtract ty + = let t = wrap_ForeignAGItf + (sem_ForeignAGItf (ForeignAGItf_AGItf ty)) + Inh_ForeignAGItf + in extr_Syn_ForeignAGItf t + +-- CCall ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative Id: + child isStatic : {Bool} + child mbInclude : {Maybe String} + child asPointer : {Bool} + child nm : {String} + alternative Dynamic: + alternative Wrapper: +-} +-- cata +sem_CCall :: CCall -> + T_CCall +sem_CCall (CCall_Id _isStatic _mbInclude _asPointer _nm) = + (sem_CCall_Id _isStatic _mbInclude _asPointer _nm) +sem_CCall (CCall_Dynamic) = + (sem_CCall_Dynamic) +sem_CCall (CCall_Wrapper) = + (sem_CCall_Wrapper) +-- semantic domain +type T_CCall = ( ForeignExtraction) +sem_CCall_Id :: Bool -> + (Maybe String) -> + Bool -> + String -> + T_CCall +sem_CCall_Id isStatic_ mbInclude_ asPointer_ nm_ = + (case (emptyForeignExtraction + { forextractIncludes = maybeToList mbInclude_ + , forextractEnt = nm_ + , forextractOptIsStatic = isStatic_ + , forextractOptIsPtr = asPointer_ + }) of + { _lhsOextr -> + ( _lhsOextr) }) +sem_CCall_Dynamic :: T_CCall +sem_CCall_Dynamic = + (case (ForeignExtraction_Dynamic) of + { _lhsOextr -> + ( _lhsOextr) }) +sem_CCall_Wrapper :: T_CCall +sem_CCall_Wrapper = + (case (ForeignExtraction_Wrapper) of + { _lhsOextr -> + ( _lhsOextr) }) +-- ForeignAGItf ------------------------------------------------ +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative AGItf: + child ent : ForeignEnt +-} +-- cata +sem_ForeignAGItf :: ForeignAGItf -> + T_ForeignAGItf +sem_ForeignAGItf (ForeignAGItf_AGItf _ent) = + (sem_ForeignAGItf_AGItf (sem_ForeignEnt _ent)) +-- semantic domain +type T_ForeignAGItf = ( ForeignExtraction) +data Inh_ForeignAGItf = Inh_ForeignAGItf {} +data Syn_ForeignAGItf = Syn_ForeignAGItf {extr_Syn_ForeignAGItf :: !(ForeignExtraction)} +wrap_ForeignAGItf :: T_ForeignAGItf -> + Inh_ForeignAGItf -> + Syn_ForeignAGItf +wrap_ForeignAGItf sem (Inh_ForeignAGItf) = + (let ( _lhsOextr) = sem + in (Syn_ForeignAGItf _lhsOextr)) +sem_ForeignAGItf_AGItf :: T_ForeignEnt -> + T_ForeignAGItf +sem_ForeignAGItf_AGItf ent_ = + (case (ent_) of + { ( _entIextr) -> + (case (_entIextr) of + { _lhsOextr -> + ( _lhsOextr) }) }) +-- ForeignEnt -------------------------------------------------- +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative CCall: + child ent : CCall + alternative PlainCall: + child ent : PlainCall + alternative PrimCall: + child ent : PrimCall + alternative JavaScriptCall: + child ent : JavaScriptCall +-} +-- cata +sem_ForeignEnt :: ForeignEnt -> + T_ForeignEnt +sem_ForeignEnt (ForeignEnt_CCall _ent) = + (sem_ForeignEnt_CCall (sem_CCall _ent)) +sem_ForeignEnt (ForeignEnt_PlainCall _ent) = + (sem_ForeignEnt_PlainCall (sem_PlainCall _ent)) +sem_ForeignEnt (ForeignEnt_PrimCall _ent) = + (sem_ForeignEnt_PrimCall (sem_PrimCall _ent)) +sem_ForeignEnt (ForeignEnt_JavaScriptCall _ent) = + (sem_ForeignEnt_JavaScriptCall (sem_JavaScriptCall _ent)) +-- semantic domain +type T_ForeignEnt = ( ForeignExtraction) +sem_ForeignEnt_CCall :: T_CCall -> + T_ForeignEnt +sem_ForeignEnt_CCall ent_ = + (case (ent_) of + { ( _entIextr) -> + (case (_entIextr) of + { _lhsOextr -> + ( _lhsOextr) }) }) +sem_ForeignEnt_PlainCall :: T_PlainCall -> + T_ForeignEnt +sem_ForeignEnt_PlainCall ent_ = + (case (ent_) of + { ( _entIextr) -> + (case (_entIextr) of + { _lhsOextr -> + ( _lhsOextr) }) }) +sem_ForeignEnt_PrimCall :: T_PrimCall -> + T_ForeignEnt +sem_ForeignEnt_PrimCall ent_ = + (case (ent_) of + { ( _entIextr) -> + (case (_entIextr) of + { _lhsOextr -> + ( _lhsOextr) }) }) +sem_ForeignEnt_JavaScriptCall :: T_JavaScriptCall -> + T_ForeignEnt +sem_ForeignEnt_JavaScriptCall ent_ = + (case (ent_) of + { ( _entIextr) -> + (case (_entIextr) of + { _lhsOextr -> + ( _lhsOextr) }) }) +-- ForeignExpr ------------------------------------------------- +{- + alternatives: + alternative Call: + child expr : ForeignExpr + alternative CallArgs: + child expr : ForeignExpr + child args : ForeignExprs + alternative Ptr: + child expr : ForeignExpr + alternative Sel: + child expr : ForeignExpr + child sel : ForeignExpr + alternative Inx: + child expr : ForeignExpr + child inx : ForeignExpr + alternative Ent: + alternative EntNm: + child nm : {String} + alternative Arg: + child nr : {Int} + alternative AllArg: + alternative Empty: + alternative Str: + child str : {String} + alternative ObjData: + alternative NewObj: + child expr : ForeignExpr +-} +-- cata +sem_ForeignExpr :: ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr (ForeignExpr_Call _expr) = + (sem_ForeignExpr_Call (sem_ForeignExpr _expr)) +sem_ForeignExpr (ForeignExpr_CallArgs _expr _args) = + (sem_ForeignExpr_CallArgs (sem_ForeignExpr _expr) (sem_ForeignExprs _args)) +sem_ForeignExpr (ForeignExpr_Ptr _expr) = + (sem_ForeignExpr_Ptr (sem_ForeignExpr _expr)) +sem_ForeignExpr (ForeignExpr_Sel _expr _sel) = + (sem_ForeignExpr_Sel (sem_ForeignExpr _expr) (sem_ForeignExpr _sel)) +sem_ForeignExpr (ForeignExpr_Inx _expr _inx) = + (sem_ForeignExpr_Inx (sem_ForeignExpr _expr) (sem_ForeignExpr _inx)) +sem_ForeignExpr (ForeignExpr_Ent) = + (sem_ForeignExpr_Ent) +sem_ForeignExpr (ForeignExpr_EntNm _nm) = + (sem_ForeignExpr_EntNm _nm) +sem_ForeignExpr (ForeignExpr_Arg _nr) = + (sem_ForeignExpr_Arg _nr) +sem_ForeignExpr (ForeignExpr_AllArg) = + (sem_ForeignExpr_AllArg) +sem_ForeignExpr (ForeignExpr_Empty) = + (sem_ForeignExpr_Empty) +sem_ForeignExpr (ForeignExpr_Str _str) = + (sem_ForeignExpr_Str _str) +sem_ForeignExpr (ForeignExpr_ObjData) = + (sem_ForeignExpr_ObjData) +sem_ForeignExpr (ForeignExpr_NewObj _expr) = + (sem_ForeignExpr_NewObj (sem_ForeignExpr _expr)) +-- semantic domain +type T_ForeignExpr = ( ) +sem_ForeignExpr_Call :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Call expr_ = + ( ) +sem_ForeignExpr_CallArgs :: T_ForeignExpr -> + T_ForeignExprs -> + T_ForeignExpr +sem_ForeignExpr_CallArgs expr_ args_ = + ( ) +sem_ForeignExpr_Ptr :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Ptr expr_ = + ( ) +sem_ForeignExpr_Sel :: T_ForeignExpr -> + T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Sel expr_ sel_ = + ( ) +sem_ForeignExpr_Inx :: T_ForeignExpr -> + T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Inx expr_ inx_ = + ( ) +sem_ForeignExpr_Ent :: T_ForeignExpr +sem_ForeignExpr_Ent = + ( ) +sem_ForeignExpr_EntNm :: String -> + T_ForeignExpr +sem_ForeignExpr_EntNm nm_ = + ( ) +sem_ForeignExpr_Arg :: Int -> + T_ForeignExpr +sem_ForeignExpr_Arg nr_ = + ( ) +sem_ForeignExpr_AllArg :: T_ForeignExpr +sem_ForeignExpr_AllArg = + ( ) +sem_ForeignExpr_Empty :: T_ForeignExpr +sem_ForeignExpr_Empty = + ( ) +sem_ForeignExpr_Str :: String -> + T_ForeignExpr +sem_ForeignExpr_Str str_ = + ( ) +sem_ForeignExpr_ObjData :: T_ForeignExpr +sem_ForeignExpr_ObjData = + ( ) +sem_ForeignExpr_NewObj :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_NewObj expr_ = + ( ) +-- ForeignExprAGItf -------------------------------------------- +{- + alternatives: + alternative AGItf: + child expr : ForeignExpr +-} +-- cata +sem_ForeignExprAGItf :: ForeignExprAGItf -> + T_ForeignExprAGItf +sem_ForeignExprAGItf (ForeignExprAGItf_AGItf _expr) = + (sem_ForeignExprAGItf_AGItf (sem_ForeignExpr _expr)) +-- semantic domain +type T_ForeignExprAGItf = ( ) +sem_ForeignExprAGItf_AGItf :: T_ForeignExpr -> + T_ForeignExprAGItf +sem_ForeignExprAGItf_AGItf expr_ = + ( ) +-- ForeignExprs ------------------------------------------------ +{- + alternatives: + alternative Cons: + child hd : ForeignExpr + child tl : ForeignExprs + alternative Nil: +-} +-- cata +sem_ForeignExprs :: ForeignExprs -> + T_ForeignExprs +sem_ForeignExprs list = + (Prelude.foldr sem_ForeignExprs_Cons sem_ForeignExprs_Nil (Prelude.map sem_ForeignExpr list)) +-- semantic domain +type T_ForeignExprs = ( ) +sem_ForeignExprs_Cons :: T_ForeignExpr -> + T_ForeignExprs -> + T_ForeignExprs +sem_ForeignExprs_Cons hd_ tl_ = + ( ) +sem_ForeignExprs_Nil :: T_ForeignExprs +sem_ForeignExprs_Nil = + ( ) +-- JavaScriptCall ---------------------------------------------- +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative Id: + child nm : {String} + child mbInclude : {Maybe String} + child mbForeignExpr : {Maybe ForeignExpr} + alternative Dynamic: + alternative Wrapper: +-} +-- cata +sem_JavaScriptCall :: JavaScriptCall -> + T_JavaScriptCall +sem_JavaScriptCall (JavaScriptCall_Id _nm _mbInclude _mbForeignExpr) = + (sem_JavaScriptCall_Id _nm _mbInclude _mbForeignExpr) +sem_JavaScriptCall (JavaScriptCall_Dynamic) = + (sem_JavaScriptCall_Dynamic) +sem_JavaScriptCall (JavaScriptCall_Wrapper) = + (sem_JavaScriptCall_Wrapper) +-- semantic domain +type T_JavaScriptCall = ( ForeignExtraction) +sem_JavaScriptCall_Id :: String -> + (Maybe String) -> + (Maybe ForeignExpr) -> + T_JavaScriptCall +sem_JavaScriptCall_Id nm_ mbInclude_ mbForeignExpr_ = + (case (emptyForeignExtraction + { forextractEnt = nm_ + , forextractIncludes = maybeToList mbInclude_ + , forextractForeignExpr = maybe (forextractForeignExpr emptyForeignExtraction) id mbForeignExpr_ + }) of + { _lhsOextr -> + ( _lhsOextr) }) +sem_JavaScriptCall_Dynamic :: T_JavaScriptCall +sem_JavaScriptCall_Dynamic = + (case (ForeignExtraction_Dynamic) of + { _lhsOextr -> + ( _lhsOextr) }) +sem_JavaScriptCall_Wrapper :: T_JavaScriptCall +sem_JavaScriptCall_Wrapper = + (case (ForeignExtraction_Wrapper) of + { _lhsOextr -> + ( _lhsOextr) }) +-- PlainCall --------------------------------------------------- +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative Id: + child nm : {String} +-} +-- cata +sem_PlainCall :: PlainCall -> + T_PlainCall +sem_PlainCall (PlainCall_Id _nm) = + (sem_PlainCall_Id _nm) +-- semantic domain +type T_PlainCall = ( ForeignExtraction) +sem_PlainCall_Id :: String -> + T_PlainCall +sem_PlainCall_Id nm_ = + (case (emptyForeignExtraction + { forextractEnt = nm_ + }) of + { _lhsOextr -> + ( _lhsOextr) }) +-- PrimCall ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + extr : ForeignExtraction + alternatives: + alternative Id: + child nm : {String} + child mbKnownPrim : {Maybe KnownPrim} +-} +-- cata +sem_PrimCall :: PrimCall -> + T_PrimCall +sem_PrimCall (PrimCall_Id _nm _mbKnownPrim) = + (sem_PrimCall_Id _nm _mbKnownPrim) +-- semantic domain +type T_PrimCall = ( ForeignExtraction) +sem_PrimCall_Id :: String -> + (Maybe KnownPrim) -> + T_PrimCall +sem_PrimCall_Id nm_ mbKnownPrim_ = + (case (emptyForeignExtraction + { forextractEnt = nm_ + , forextractMbKnownPrim = mbKnownPrim_ + }) of + { _lhsOextr -> + ( _lhsOextr) }) diff --git a/src/UHC/Light/Compiler/Foreign/Parser.hs b/src/UHC/Light/Compiler/Foreign/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Foreign/Parser.hs @@ -0,0 +1,75 @@ +module UHC.Light.Compiler.Foreign.Parser +( parseForeignEnt ) +where +import UU.Scanner.GenToken +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Foreign +import UHC.Util.ParseUtils +import UU.Parsing +import UHC.Util.Utils +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.Base.Target + +{-# LINE 44 "src/ehc/Foreign/Parser.chs" #-} +parseForeignEnt :: ForeignDirection -> FFIWay -> Maybe String -> String -> (ForeignEnt,ErrL) +parseForeignEnt dir way dfltNm s + = (res,errs) + where tokens = scan (foreignEntScanOpts way) (initPos s) s + (res,msgs) = parseToResMsgs (pForeignEnt dir way dfltNm) tokens + errs = map (rngLift emptyRange mkPPErr) msgs + +{-# LINE 60 "src/ehc/Foreign/Parser.chs" #-} +type ForeignParser ep = PlainParser Token ep + +{-# LINE 64 "src/ehc/Foreign/Parser.chs" #-} +pForeignEnt :: ForeignDirection -> FFIWay -> Maybe String -> ForeignParser ForeignEnt +pForeignEnt dir way dfltNm + = case (dir,way) of + (_ ,FFIWay_CCall ) -> ForeignEnt_CCall <$> pCCall dfltNm + (_ ,FFIWay_Prim ) -> ForeignEnt_PrimCall <$> pPrimCall dfltNm + _ -> ForeignEnt_PlainCall <$> pPlainCall dfltNm + +pCCall :: Maybe String -> ForeignParser CCall +pCCall dfltNm + = (True <$ pSTATIC) <**> pAfterStatic + <|> ($ False) <$> pAfterStatic + <|> CCall_Dynamic <$ pDYNAMIC + <|> CCall_Wrapper <$ pWRAPPER + where nm = maybe "" id dfltNm + pPtrForeignVar + = pAMPERSAND + <**> ( const <$> pForeignVar + `opt` (const nm) + ) + pAfterStatic + = pForeignVar + <**> ( (pDOT <* pH) + <**> ( (\nm _ incl st -> CCall_Id st (mkincl incl) True nm) <$> pPtrForeignVar + <|> (\nm _ incl st -> CCall_Id st (mkincl incl) False nm) <$> pForeignVar + `opt` (\_ incl st -> CCall_Id st (mkincl incl) False nm) + ) + `opt` (\nm st -> CCall_Id st Nothing False nm) + ) + <|> (\nm st -> CCall_Id st Nothing True nm) <$> pPtrForeignVar + `opt` (\st -> CCall_Id st Nothing False nm) + where mkincl i = Just (i ++ ".h") + +pPlainCall :: Maybe String -> ForeignParser PlainCall +pPlainCall dfltNm + = PlainCall_Id <$> pForeignVar + `opt` PlainCall_Id nm + where nm = maybe "" id dfltNm + +pPrimCall :: Maybe String -> ForeignParser PrimCall +pPrimCall dfltNm + = PrimCall_Id <$> (pForeignVar `opt` nm) <*> pKnownPrim + where nm = maybe "" id dfltNm + pKnownPrim = pMb (pAnyFromMap pKeyTk allKnownPrimMp) + +pForeignVar :: ForeignParser String +pForeignVar = tokGetVal <$> (pVARID <|> pCONID) + + diff --git a/src/UHC/Light/Compiler/Foreign/Pretty.hs b/src/UHC/Light/Compiler/Foreign/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Foreign/Pretty.hs @@ -0,0 +1,535 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Foreign/Pretty) +module UHC.Light.Compiler.Foreign.Pretty(ppForeignEnt +, ppForeignExpr) where + +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Foreign + + + + + +ppForeignEnt :: ForeignEnt -> PP_Doc +ppForeignEnt ent + = let t = wrap_ForeignAGItf + (sem_ForeignAGItf (ForeignAGItf_AGItf ent)) + Inh_ForeignAGItf + in pp_Syn_ForeignAGItf t + +instance PP ForeignEnt where + pp t = ppForeignEnt t + + + +ppForeignExpr :: String -> ForeignExpr -> PP_Doc +ppForeignExpr nm e + = let t = wrap_ForeignExprAGItf + (sem_ForeignExprAGItf (ForeignExprAGItf_AGItf e)) + (Inh_ForeignExprAGItf + { entNm_Inh_ForeignExprAGItf = nm + }) + in pp_Syn_ForeignExprAGItf t + +-- CCall ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Id: + child isStatic : {Bool} + child mbInclude : {Maybe String} + child asPointer : {Bool} + child nm : {String} + alternative Dynamic: + alternative Wrapper: +-} +-- cata +sem_CCall :: CCall -> + T_CCall +sem_CCall (CCall_Id _isStatic _mbInclude _asPointer _nm) = + (sem_CCall_Id _isStatic _mbInclude _asPointer _nm) +sem_CCall (CCall_Dynamic) = + (sem_CCall_Dynamic) +sem_CCall (CCall_Wrapper) = + (sem_CCall_Wrapper) +-- semantic domain +type T_CCall = ( PP_Doc) +sem_CCall_Id :: Bool -> + (Maybe String) -> + Bool -> + String -> + T_CCall +sem_CCall_Id isStatic_ mbInclude_ asPointer_ nm_ = + (case ((if isStatic_ then pp "static" else empty) + >#< (maybe empty pp mbInclude_) + >#< (if asPointer_ then pp "&" else empty) + >#< nm_) of + { _lhsOpp -> + ( _lhsOpp) }) +sem_CCall_Dynamic :: T_CCall +sem_CCall_Dynamic = + (case (pp "dynamic") of + { _lhsOpp -> + ( _lhsOpp) }) +sem_CCall_Wrapper :: T_CCall +sem_CCall_Wrapper = + (case (pp "wrapper") of + { _lhsOpp -> + ( _lhsOpp) }) +-- ForeignAGItf ------------------------------------------------ +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative AGItf: + child ent : ForeignEnt +-} +-- cata +sem_ForeignAGItf :: ForeignAGItf -> + T_ForeignAGItf +sem_ForeignAGItf (ForeignAGItf_AGItf _ent) = + (sem_ForeignAGItf_AGItf (sem_ForeignEnt _ent)) +-- semantic domain +type T_ForeignAGItf = ( PP_Doc) +data Inh_ForeignAGItf = Inh_ForeignAGItf {} +data Syn_ForeignAGItf = Syn_ForeignAGItf {pp_Syn_ForeignAGItf :: !(PP_Doc)} +wrap_ForeignAGItf :: T_ForeignAGItf -> + Inh_ForeignAGItf -> + Syn_ForeignAGItf +wrap_ForeignAGItf sem (Inh_ForeignAGItf) = + (let ( _lhsOpp) = sem + in (Syn_ForeignAGItf _lhsOpp)) +sem_ForeignAGItf_AGItf :: T_ForeignEnt -> + T_ForeignAGItf +sem_ForeignAGItf_AGItf ent_ = + (case (ent_) of + { ( _entIpp) -> + (case (_entIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) +-- ForeignEnt -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative CCall: + child ent : CCall + alternative PlainCall: + child ent : PlainCall + alternative PrimCall: + child ent : PrimCall + alternative JavaScriptCall: + child ent : JavaScriptCall +-} +-- cata +sem_ForeignEnt :: ForeignEnt -> + T_ForeignEnt +sem_ForeignEnt (ForeignEnt_CCall _ent) = + (sem_ForeignEnt_CCall (sem_CCall _ent)) +sem_ForeignEnt (ForeignEnt_PlainCall _ent) = + (sem_ForeignEnt_PlainCall (sem_PlainCall _ent)) +sem_ForeignEnt (ForeignEnt_PrimCall _ent) = + (sem_ForeignEnt_PrimCall (sem_PrimCall _ent)) +sem_ForeignEnt (ForeignEnt_JavaScriptCall _ent) = + (sem_ForeignEnt_JavaScriptCall (sem_JavaScriptCall _ent)) +-- semantic domain +type T_ForeignEnt = ( PP_Doc) +sem_ForeignEnt_CCall :: T_CCall -> + T_ForeignEnt +sem_ForeignEnt_CCall ent_ = + (case (ent_) of + { ( _entIpp) -> + (case (_entIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) +sem_ForeignEnt_PlainCall :: T_PlainCall -> + T_ForeignEnt +sem_ForeignEnt_PlainCall ent_ = + (case (ent_) of + { ( _entIpp) -> + (case (_entIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) +sem_ForeignEnt_PrimCall :: T_PrimCall -> + T_ForeignEnt +sem_ForeignEnt_PrimCall ent_ = + (case (ent_) of + { ( _entIpp) -> + (case (_entIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) +sem_ForeignEnt_JavaScriptCall :: T_JavaScriptCall -> + T_ForeignEnt +sem_ForeignEnt_JavaScriptCall ent_ = + (case (ent_) of + { ( _entIpp) -> + (case (_entIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) +-- ForeignExpr ------------------------------------------------- +{- + visit 0: + inherited attribute: + entNm : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Call: + child expr : ForeignExpr + alternative CallArgs: + child expr : ForeignExpr + child args : ForeignExprs + alternative Ptr: + child expr : ForeignExpr + alternative Sel: + child expr : ForeignExpr + child sel : ForeignExpr + alternative Inx: + child expr : ForeignExpr + child inx : ForeignExpr + alternative Ent: + alternative EntNm: + child nm : {String} + alternative Arg: + child nr : {Int} + alternative AllArg: + alternative Empty: + alternative Str: + child str : {String} + alternative ObjData: + alternative NewObj: + child expr : ForeignExpr +-} +-- cata +sem_ForeignExpr :: ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr (ForeignExpr_Call _expr) = + (sem_ForeignExpr_Call (sem_ForeignExpr _expr)) +sem_ForeignExpr (ForeignExpr_CallArgs _expr _args) = + (sem_ForeignExpr_CallArgs (sem_ForeignExpr _expr) (sem_ForeignExprs _args)) +sem_ForeignExpr (ForeignExpr_Ptr _expr) = + (sem_ForeignExpr_Ptr (sem_ForeignExpr _expr)) +sem_ForeignExpr (ForeignExpr_Sel _expr _sel) = + (sem_ForeignExpr_Sel (sem_ForeignExpr _expr) (sem_ForeignExpr _sel)) +sem_ForeignExpr (ForeignExpr_Inx _expr _inx) = + (sem_ForeignExpr_Inx (sem_ForeignExpr _expr) (sem_ForeignExpr _inx)) +sem_ForeignExpr (ForeignExpr_Ent) = + (sem_ForeignExpr_Ent) +sem_ForeignExpr (ForeignExpr_EntNm _nm) = + (sem_ForeignExpr_EntNm _nm) +sem_ForeignExpr (ForeignExpr_Arg _nr) = + (sem_ForeignExpr_Arg _nr) +sem_ForeignExpr (ForeignExpr_AllArg) = + (sem_ForeignExpr_AllArg) +sem_ForeignExpr (ForeignExpr_Empty) = + (sem_ForeignExpr_Empty) +sem_ForeignExpr (ForeignExpr_Str _str) = + (sem_ForeignExpr_Str _str) +sem_ForeignExpr (ForeignExpr_ObjData) = + (sem_ForeignExpr_ObjData) +sem_ForeignExpr (ForeignExpr_NewObj _expr) = + (sem_ForeignExpr_NewObj (sem_ForeignExpr _expr)) +-- semantic domain +type T_ForeignExpr = String -> + ( PP_Doc) +sem_ForeignExpr_Call :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Call expr_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp >|< ppParens empty) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_ForeignExpr_CallArgs :: T_ForeignExpr -> + T_ForeignExprs -> + T_ForeignExpr +sem_ForeignExpr_CallArgs expr_ args_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _argsOentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (args_ _argsOentNm) of + { ( _argsIppL) -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp >|< ppParensCommas _argsIppL) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_ForeignExpr_Ptr :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Ptr expr_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case ("&" >|< _exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +sem_ForeignExpr_Sel :: T_ForeignExpr -> + T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Sel expr_ sel_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _selOentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (sel_ _selOentNm) of + { ( _selIpp) -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp >|< "." >|< _selIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_ForeignExpr_Inx :: T_ForeignExpr -> + T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_Inx expr_ inx_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _inxOentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (inx_ _inxOentNm) of + { ( _inxIpp) -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp >|< "[" >|< _inxIpp >|< "]") of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) })) +sem_ForeignExpr_Ent :: T_ForeignExpr +sem_ForeignExpr_Ent = + (\ _lhsIentNm -> + (case (pp _lhsIentNm) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_EntNm :: String -> + T_ForeignExpr +sem_ForeignExpr_EntNm nm_ = + (\ _lhsIentNm -> + (case (pp nm_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_Arg :: Int -> + T_ForeignExpr +sem_ForeignExpr_Arg nr_ = + (\ _lhsIentNm -> + (case ("%" >|< nr_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_AllArg :: T_ForeignExpr +sem_ForeignExpr_AllArg = + (\ _lhsIentNm -> + (case (pp "%*") of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_Empty :: T_ForeignExpr +sem_ForeignExpr_Empty = + (\ _lhsIentNm -> + (case (empty) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_Str :: String -> + T_ForeignExpr +sem_ForeignExpr_Str str_ = + (\ _lhsIentNm -> + (case (pp $ show str_) of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_ObjData :: T_ForeignExpr +sem_ForeignExpr_ObjData = + (\ _lhsIentNm -> + (case (pp "{}") of + { _lhsOpp -> + ( _lhsOpp) })) +sem_ForeignExpr_NewObj :: T_ForeignExpr -> + T_ForeignExpr +sem_ForeignExpr_NewObj expr_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +-- ForeignExprAGItf -------------------------------------------- +{- + visit 0: + inherited attribute: + entNm : String + synthesized attribute: + pp : PP_Doc + alternatives: + alternative AGItf: + child expr : ForeignExpr +-} +-- cata +sem_ForeignExprAGItf :: ForeignExprAGItf -> + T_ForeignExprAGItf +sem_ForeignExprAGItf (ForeignExprAGItf_AGItf _expr) = + (sem_ForeignExprAGItf_AGItf (sem_ForeignExpr _expr)) +-- semantic domain +type T_ForeignExprAGItf = String -> + ( PP_Doc) +data Inh_ForeignExprAGItf = Inh_ForeignExprAGItf {entNm_Inh_ForeignExprAGItf :: !(String)} +data Syn_ForeignExprAGItf = Syn_ForeignExprAGItf {pp_Syn_ForeignExprAGItf :: !(PP_Doc)} +wrap_ForeignExprAGItf :: T_ForeignExprAGItf -> + Inh_ForeignExprAGItf -> + Syn_ForeignExprAGItf +wrap_ForeignExprAGItf sem (Inh_ForeignExprAGItf _lhsIentNm) = + (let ( _lhsOpp) = sem _lhsIentNm + in (Syn_ForeignExprAGItf _lhsOpp)) +sem_ForeignExprAGItf_AGItf :: T_ForeignExpr -> + T_ForeignExprAGItf +sem_ForeignExprAGItf_AGItf expr_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _exprOentNm -> + (case (expr_ _exprOentNm) of + { ( _exprIpp) -> + (case (_exprIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) })) +-- ForeignExprs ------------------------------------------------ +{- + visit 0: + inherited attribute: + entNm : String + synthesized attribute: + ppL : [PP_Doc] + alternatives: + alternative Cons: + child hd : ForeignExpr + child tl : ForeignExprs + alternative Nil: +-} +-- cata +sem_ForeignExprs :: ForeignExprs -> + T_ForeignExprs +sem_ForeignExprs list = + (Prelude.foldr sem_ForeignExprs_Cons sem_ForeignExprs_Nil (Prelude.map sem_ForeignExpr list)) +-- semantic domain +type T_ForeignExprs = String -> + ( ([PP_Doc])) +sem_ForeignExprs_Cons :: T_ForeignExpr -> + T_ForeignExprs -> + T_ForeignExprs +sem_ForeignExprs_Cons hd_ tl_ = + (\ _lhsIentNm -> + (case (_lhsIentNm) of + { _tlOentNm -> + (case (_lhsIentNm) of + { _hdOentNm -> + (case (tl_ _tlOentNm) of + { ( _tlIppL) -> + (case (hd_ _hdOentNm) of + { ( _hdIpp) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOppL) }) }) }) }) })) +sem_ForeignExprs_Nil :: T_ForeignExprs +sem_ForeignExprs_Nil = + (\ _lhsIentNm -> + (case ([]) of + { _lhsOppL -> + ( _lhsOppL) })) +-- JavaScriptCall ---------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Id: + child nm : {String} + child mbInclude : {Maybe String} + child mbForeignExpr : {Maybe ForeignExpr} + alternative Dynamic: + alternative Wrapper: +-} +-- cata +sem_JavaScriptCall :: JavaScriptCall -> + T_JavaScriptCall +sem_JavaScriptCall (JavaScriptCall_Id _nm _mbInclude _mbForeignExpr) = + (sem_JavaScriptCall_Id _nm _mbInclude _mbForeignExpr) +sem_JavaScriptCall (JavaScriptCall_Dynamic) = + (sem_JavaScriptCall_Dynamic) +sem_JavaScriptCall (JavaScriptCall_Wrapper) = + (sem_JavaScriptCall_Wrapper) +-- semantic domain +type T_JavaScriptCall = ( PP_Doc) +sem_JavaScriptCall_Id :: String -> + (Maybe String) -> + (Maybe ForeignExpr) -> + T_JavaScriptCall +sem_JavaScriptCall_Id nm_ mbInclude_ mbForeignExpr_ = + (case (maybe (pp nm_) (ppForeignExpr nm_) mbForeignExpr_) of + { _lhsOpp -> + ( _lhsOpp) }) +sem_JavaScriptCall_Dynamic :: T_JavaScriptCall +sem_JavaScriptCall_Dynamic = + (case (pp "dynamic") of + { _lhsOpp -> + ( _lhsOpp) }) +sem_JavaScriptCall_Wrapper :: T_JavaScriptCall +sem_JavaScriptCall_Wrapper = + (case (pp "wrapper") of + { _lhsOpp -> + ( _lhsOpp) }) +-- PlainCall --------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Id: + child nm : {String} +-} +-- cata +sem_PlainCall :: PlainCall -> + T_PlainCall +sem_PlainCall (PlainCall_Id _nm) = + (sem_PlainCall_Id _nm) +-- semantic domain +type T_PlainCall = ( PP_Doc) +sem_PlainCall_Id :: String -> + T_PlainCall +sem_PlainCall_Id nm_ = + (case (pp nm_) of + { _lhsOpp -> + ( _lhsOpp) }) +-- PrimCall ---------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative Id: + child nm : {String} + child mbKnownPrim : {Maybe KnownPrim} +-} +-- cata +sem_PrimCall :: PrimCall -> + T_PrimCall +sem_PrimCall (PrimCall_Id _nm _mbKnownPrim) = + (sem_PrimCall_Id _nm _mbKnownPrim) +-- semantic domain +type T_PrimCall = ( PP_Doc) +sem_PrimCall_Id :: String -> + (Maybe KnownPrim) -> + T_PrimCall +sem_PrimCall_Id nm_ mbKnownPrim_ = + (case (pp nm_ >#< maybe empty pp mbKnownPrim_) of + { _lhsOpp -> + ( _lhsOpp) }) diff --git a/src/UHC/Light/Compiler/Gam.hs b/src/UHC/Light/Compiler/Gam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam.hs @@ -0,0 +1,160 @@ +module UHC.Light.Compiler.Gam +( module UHC.Light.Compiler.Gam.Base +, ppGam, ppGamDup +, IdDefOccGam, IdDefOccAsc +, idDefOccGamUnion +, gamDoTyWithVarMp +, SoGam, SoGamInfo (..) +, initSoGam +, idDefOccGamPartitionByKind +, idDefOccGamByKind +, idDefOccGamStrip +, IdQualGam +, idGam2QualGam, idQualGamReplacement ) +where +import UHC.Light.Compiler.Gam.Base +import Data.List +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.NameAspect +import UHC.Light.Compiler.Error +import UHC.Util.Pretty +import UHC.Light.Compiler.Ty.Pretty +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Opts.Base +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Core +import UHC.Util.ScopeMapGam +import UHC.Light.Compiler.Base.Debug +import UHC.Light.Compiler.Core.Subst +import UHC.Light.Compiler.VarLookup + + + + + + + + + + + + + + + + +{-# LINE 95 "src/ehc/Gam.chs" #-} +-- Do something with each Ty in a Gam. +-- The global VarMp is kept separately so a new tyvar binding can be computed, which is threaded separatedly and also returned. +-- This allows the retainment of the original tyvar in the Gam, which is required when used twice with different VarMp's. +gamDoTyWithVarMp + :: Ord key => + (info -> Ty,Ty -> info -> info) -- get/set from/into info in Gam + -- do whatever must be done given + -> (key -- name in gam + -> (Ty,VarMp) -- Ty + cycles + -> VarMp -- new subst + -> thr -- thread + -> (Ty,VarMp,thr)) -- result: new Ty, new subst, thread + -> VarMp -- subst for Gam entries + -> thr -- initial value for thread + -> Gam key info -- the Gam (env) + -> (Gam key info,VarMp,thr) -- result: new gam, new subst, thread +gamDoTyWithVarMp (get,set) f gamVarMp thr gam + = (g,c,thr') + where (g,(thr',c)) + = gamMapThr + (\(n,gi) (thr,c) + -> let t = get gi + (t',c',thr') = f n (gamVarMp `varUpdCyc` t) c thr + (tg,cg) = case (tyUnAnn t,tyUnAnn t') of + (Ty_Var v1 _ ,Ty_Var v2 _) | v1 == v2 + -> dflt + (Ty_Var v cat,_ ) | not (tvCatIsFixed cat) + -> (t ,v `varmpTyUnit` t') + _ -> dflt + where dflt = (t',emptyVarMp) + in ((n,set ({- tr "gamDoTyWithVarMp.set" (ppTy tg) $ -} tg) gi) + ,(thr',{- (\v -> tr "gamDoTyWithVarMp" (pp v) v) $ -} cg `varmpPlus` c') + ) + ) + (thr,emptyVarMp) gam + +{-# LINE 145 "src/ehc/Gam.chs" #-} +data SoGamInfo + = SoGamInfo + { sgiSo :: Ty } + deriving Show + +type SoGam = Gam HsName SoGamInfo + +{-# LINE 158 "src/ehc/Gam.chs" #-} +type IdDefOccGam = Gam IdOcc IdDefOcc +type IdDefOccAsc = AssocL IdOcc [IdDefOcc] + +{-# LINE 163 "src/ehc/Gam.chs" #-} +-- | Union gam, but tailored to maintaining duplicate definition info +idDefOccGamUnion :: IdDefOccGam -> IdDefOccGam -> IdDefOccGam +idDefOccGamUnion = gamUnionWith idDefOccLCmb +{-# INLINE idDefOccGamUnion #-} + +{-# LINE 174 "src/ehc/Gam.chs" #-} +idDefOccGamPartitionByKind :: [IdOccKind] -> IdDefOccGam -> (IdDefOccAsc,IdDefOccAsc) +idDefOccGamPartitionByKind ks + = partition (\(IdOcc n k',_) -> k' `elem` ks) . gamToAssocDupL + +{-# LINE 180 "src/ehc/Gam.chs" #-} +idDefOccGamByKind :: IdOccKind -> IdDefOccGam -> AssocL HsName IdDefOcc +idDefOccGamByKind k g = [ (n,head i) | (IdOcc n _,i) <- fst (idDefOccGamPartitionByKind [k] g) ] + +{-# LINE 185 "src/ehc/Gam.chs" #-} +-- | Strip references to original source file location +idDefOccGamStrip :: IdDefOccGam -> IdDefOccGam +idDefOccGamStrip g = gamMap (\(k,v) -> (k,doccStrip v)) g + +{-# LINE 206 "src/ehc/Gam.chs" #-} +type IdQualGam = Gam IdOcc HsName + +{-# LINE 210 "src/ehc/Gam.chs" #-} +idGam2QualGam :: IdDefOccGam -> IdQualGam +idGam2QualGam = gamMap (\(iocc,docc) -> (iocc {ioccNm = hsnQualified $ ioccNm iocc},ioccNm $ doccOcc $ docc)) + +idQualGamReplacement :: IdQualGam -> IdOccKind -> HsName -> HsName +idQualGamReplacement g k n = maybe n id $ gamLookup (IdOcc n k) g +{-# INLINE idQualGamReplacement #-} + +{-# LINE 235 "src/ehc/Gam.chs" #-} +instance (Ord tk,VarUpdatable vv subst) => VarUpdatable (SGam tk vv) subst where + s `varUpd` g = gamMapElts (s `varUpd`) g + s `varUpdCyc` g = (g',varmpUnions $ gamElts gm) + where (g',gm) = sgamUnzip $ gamMapElts (s `varUpdCyc`) g + +instance (Ord tk,Ord k,VarExtractable vv k) => VarExtractable (SGam tk vv) k where + varFreeSet g = Set.unions $ map varFreeSet $ gamElts g + +{-# LINE 251 "src/ehc/Gam.chs" #-} +ppGam :: (Ord k, PP k, PP v) => Gam k v -> PP_Doc +ppGam g = ppAssocL (gamToAssocL g) + +{-# LINE 256 "src/ehc/Gam.chs" #-} +ppGamDup :: (Ord k,PP k, PP v) => Gam k v -> PP_Doc +ppGamDup g = ppAssocL $ map (\(k,v) -> (k,ppBracketsCommas v)) $ gamToAssocDupL $ g + +{-# LINE 266 "src/ehc/Gam.chs" #-} +instance (Ord k, PP k, PP v) => PP (SGam k v) where + pp g = ppGam g + +{-# LINE 275 "src/ehc/Gam.chs" #-} +initSoGam :: SoGam +initSoGam + = assocLToGam + [ (hsnKindStar, SoGamInfo kiStar) + ] + diff --git a/src/UHC/Light/Compiler/Gam/AppSpineGam.hs b/src/UHC/Light/Compiler/Gam/AppSpineGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/AppSpineGam.hs @@ -0,0 +1,12 @@ +module UHC.Light.Compiler.Gam.AppSpineGam +( AppSpineGam ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Gam + + +{-# LINE 20 "src/ehc/Gam/AppSpineGam.chs" #-} +type AppSpineGam = Gam HsName AppSpineInfo + diff --git a/src/UHC/Light/Compiler/Gam/Base.hs b/src/UHC/Light/Compiler/Gam/Base.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/Base.hs @@ -0,0 +1,185 @@ +module UHC.Light.Compiler.Gam.Base +( emptyGam, gamMap, gamLookup, gamLookupDup, gamPushNew, gamPop, gamTop, gamAddGam, gamAdd, gamPushGam, gamToAssocL, gamToAssocDupL, assocLToGam, assocDupLToGam, gamKeys +, gamSingleton, gamInsert, gamUnion, gamUnions, gamFromAssocL +, assocLToGamWithDups +, gamToOnlyDups +, gamPartition +, gamMapElts +, gamMapThr +, gamUnzip +, gamElts +, gamNoDups +, Gam +, gamLookupMetaLev +, gamMetaLevSingleton +, gamUnionWith ) +where +import Data.List +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.NameAspect +import qualified Data.Set as Set +import UHC.Light.Compiler.Opts.Base +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.ScopeMapGam + + + + + + + +{-# LINE 47 "src/ehc/Gam/Base.chs" #-} +type Gam k v = SGam k v + +{-# LINE 51 "src/ehc/Gam/Base.chs" #-} +emptyGam :: Gam k v +gamSingleton :: k -> v -> Gam k v +gamLookup :: Ord k => k -> Gam k v -> Maybe v +gamToAssocL :: Ord k => Gam k v -> AssocL k v +gamPushNew :: Gam k v -> Gam k v +gamPushGam :: Ord k => Gam k v -> Gam k v -> Gam k v +gamPop :: Ord k => Gam k v -> (Gam k v,Gam k v) +gamAddGam :: Ord k => Gam k v -> Gam k v -> Gam k v +gamAdd :: Ord k => k -> v -> Gam k v -> Gam k v + +{-# LINE 76 "src/ehc/Gam/Base.chs" #-} +gamLookupMetaLev :: Ord k => MetaLev -> k -> Gam k v -> Maybe v +gamLookupMetaLev mlev k g = fmap head $ gamLookupMetaLevDup mlev k g + +{-# LINE 81 "src/ehc/Gam/Base.chs" #-} +gamToAssocL g = [ (k,v) | (k,(v:_)) <- gamToAssocDupL g ] + +gamLookup k g = fmap head $ gamLookupDup k g +{-# INLINE gamLookup #-} + +assocLToGam = gamUnions . map (uncurry gamSingleton) + +{-# LINE 90 "src/ehc/Gam/Base.chs" #-} +emptyGam = emptySGam +{-# INLINE emptyGam #-} + +gamSingleton = sgamSingleton +{-# INLINE gamSingleton #-} + +gamPushNew = sgamPushNew +{-# INLINE gamPushNew #-} + +gamPushGam = sgamPushGam +{-# INLINE gamPushGam #-} + +gamPop = sgamPop +{-# INLINE gamPop #-} + +gamAddGam = sgamUnion +{-# INLINE gamAddGam #-} + +gamAdd k v g = sgamUnion (sgamSingleton k v) g +{-# INLINE gamAdd #-} + +{-# LINE 113 "src/ehc/Gam/Base.chs" #-} +gamTop :: Ord k => Gam k v -> Gam k v +assocLToGam :: Ord k => AssocL k v -> Gam k v + +{-# LINE 123 "src/ehc/Gam/Base.chs" #-} +gamTop = sgamTop +{-# INLINE gamTop #-} + +{-# LINE 128 "src/ehc/Gam/Base.chs" #-} +gamMetaLevSingleton = sgamMetaLevSingleton +{-# INLINE gamMetaLevSingleton #-} + +{-# LINE 138 "src/ehc/Gam/Base.chs" #-} +assocDupLToGam :: Ord k => AssocL k [v] -> Gam k v +assocDupLToGam = sgamFromAssocDupL +{-# INLINE assocDupLToGam #-} + +{-# LINE 144 "src/ehc/Gam/Base.chs" #-} +assocLToGamWithDups :: Ord k => AssocL k v -> Gam k v +assocLToGamWithDups = assocDupLToGam . assocLGroupSort +{-# INLINE assocLToGamWithDups #-} + +{-# LINE 156 "src/ehc/Gam/Base.chs" #-} +gamToAssocDupL :: Ord k => Gam k v -> AssocL k [v] +gamToAssocDupL = sgamToAssocDupL +{-# INLINE gamToAssocDupL #-} + +{-# LINE 162 "src/ehc/Gam/Base.chs" #-} +gamToOnlyDups :: Ord k => Gam k v -> AssocL k [v] +gamToOnlyDups g = [ x | x@(n,(_:_:_)) <- gamToAssocDupL g ] + +{-# LINE 172 "src/ehc/Gam/Base.chs" #-} +gamNoDups :: Ord k => Gam k v -> Gam k v +gamNoDups = sgamNoDups +{-# INLINE gamNoDups #-} + +{-# LINE 183 "src/ehc/Gam/Base.chs" #-} +gamMap :: (Ord k,Ord k') => ((k,v) -> (k',v')) -> Gam k v -> Gam k' v' +gamMap = sgamMap +{-# INLINE gamMap #-} + +{-# LINE 189 "src/ehc/Gam/Base.chs" #-} +gamMapElts :: Ord k => (v -> v') -> Gam k v -> Gam k v' +gamMapElts f = gamMap (\(n,v) -> (n,f v)) +{-# INLINE gamMapElts #-} + +{-# LINE 203 "src/ehc/Gam/Base.chs" #-} +gamPartition :: Ord k => (k -> v -> Bool) -> Gam k v -> (Gam k v,Gam k v) +gamPartition = sgamPartitionWithKey +{-# INLINE gamPartition #-} + +{-# LINE 224 "src/ehc/Gam/Base.chs" #-} +gamMapThr :: (Ord k,Ord k') => ((k,v) -> t -> ((k',v'),t)) -> t -> Gam k v -> (Gam k' v',t) +gamMapThr = sgamMapThr +{-# INLINE gamMapThr #-} + +{-# LINE 230 "src/ehc/Gam/Base.chs" #-} +gamKeys :: Ord k => Gam k v -> [k] +gamKeys = assocLKeys . gamToAssocL +{-# INLINE gamKeys #-} + +{-# LINE 236 "src/ehc/Gam/Base.chs" #-} +gamElts :: Ord k => Gam k v -> [v] +gamElts = assocLElts . gamToAssocL +{-# INLINE gamElts #-} + +{-# LINE 247 "src/ehc/Gam/Base.chs" #-} +gamLookupMetaLevDup :: Ord k => MetaLev -> k -> Gam k v -> Maybe [v] +gamLookupMetaLevDup = sgamLookupMetaLevDup +{-# INLINE gamLookupMetaLevDup #-} + +gamLookupDup :: Ord k => k -> Gam k v -> Maybe [v] +gamLookupDup = gamLookupMetaLevDup metaLevVal +{-# INLINE gamLookupDup #-} + +{-# LINE 264 "src/ehc/Gam/Base.chs" #-} +gamUnzip :: Ord k => Gam k (v1,v2) -> (Gam k v1,Gam k v2) +gamUnzip g = sgamUnzip g +{-# INLINE gamUnzip #-} + +{-# LINE 274 "src/ehc/Gam/Base.chs" #-} +gamInsert :: Ord k => k -> v -> Gam k v -> Gam k v +gamInsert = gamAdd +{-# INLINE gamInsert #-} + +gamUnion :: Ord k => Gam k v -> Gam k v -> Gam k v +gamUnion = gamAddGam +{-# INLINE gamUnion #-} + +gamFromAssocL :: Ord k => AssocL k v -> Gam k v +gamFromAssocL = assocLToGam +{-# INLINE gamFromAssocL #-} + +{-# LINE 288 "src/ehc/Gam/Base.chs" #-} +gamUnionWith :: Ord k => (v -> [v] -> [v]) -> Gam k v -> Gam k v -> Gam k v +gamUnionWith cmb = sgamUnionWith (Just cmb) +{-# INLINE gamUnionWith #-} + +{-# LINE 294 "src/ehc/Gam/Base.chs" #-} +gamUnions :: Ord k => [Gam k v] -> Gam k v +gamUnions [] = emptyGam +gamUnions gs = foldr1 gamUnion gs + diff --git a/src/UHC/Light/Compiler/Gam/ClGam.hs b/src/UHC/Light/Compiler/Gam/ClGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/ClGam.hs @@ -0,0 +1,58 @@ +module UHC.Light.Compiler.Gam.ClGam +( ClGamInfo (..), ClGam, emptyCLGI +, initClGam ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + +{-# LINE 37 "src/ehc/Gam/ClGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data ClGamInfo + = ClGamInfo + { clgiPrToEvidTy :: !Ty -- mapping from predicate type -> dictionary structure record, encoded as function + , clgiRuleTy :: !Ty + , clgiDfltDictNm :: !HsName -- dictionary name of default instance fields constructing function + , clgiDictTag :: !CTag -- tag of dictionary + , clgiGenerDerivableL :: [(HsName,HsName)] -- list of fields with default value which can be derived using generic deriving + } + deriving Show + +type ClGam = Gam HsName ClGamInfo + +emptyCLGI + = ClGamInfo + Ty_Any Ty_Any hsnUnknown CTagRec + [] + +{-# LINE 69 "src/ehc/Gam/ClGam.chs" #-} +deriving instance Typeable ClGamInfo +deriving instance Data ClGamInfo + +{-# LINE 74 "src/ehc/Gam/ClGam.chs" #-} +instance PP ClGamInfo where + pp clgi = pp (clgiDfltDictNm clgi) >#< "::" >#< ppTy (clgiRuleTy clgi) >#< "::" >#< ppTy (clgiPrToEvidTy clgi) + +{-# LINE 79 "src/ehc/Gam/ClGam.chs" #-} +initClGam + = assocLToGam + [ (hsnPrArrow, emptyCLGI) + ] + +{-# LINE 94 "src/ehc/Gam/ClGam.chs" #-} +instance Serialize ClGamInfo where + sput (ClGamInfo a b c d e) = sput a >> sput b >> sput c >> sput d >> sput e + sget = liftM5 ClGamInfo sget sget sget sget sget + diff --git a/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs b/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs @@ -0,0 +1,54 @@ +module UHC.Light.Compiler.Gam.ClassDefaultGam +( ClassDefaultGamInfo (..) +, ClassDefaultGam +, clDfGamLookupDefault ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FitsIn +import Data.Maybe +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 32 "src/ehc/Gam/ClassDefaultGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data ClassDefaultGamInfo + = ClassDefaultGamInfo + { cldiDefaultTypes :: [Ty] + } + deriving (Data,Typeable) + +{-# LINE 43 "src/ehc/Gam/ClassDefaultGam.chs" #-} +type ClassDefaultGam = Gam HsName ClassDefaultGamInfo + +{-# LINE 51 "src/ehc/Gam/ClassDefaultGam.chs" #-} +-- | Lookup a matching default for a predicate +clDfGamLookupDefault + :: ( VarLookup gm TyVarId VarMpInfo + -- , VarLookup gm Ty VarMpInfo + , VarLookupCmb VarMp gm + ) + => FIIn' gm -> Pred -> ClassDefaultGam + -> Maybe VarMp +clDfGamLookupDefault fi pr clDfGam + = case pr of + Pred_Class t | isJust mbConArgs + -> do (ClassDefaultGamInfo {cldiDefaultTypes = (tg:_)}) <- gamLookup nm clDfGam + (_,tyVarMp) <- fitPredIntoPred fi pr (Pred_Class $ appCon1App nm tg) + return tyVarMp + where mbConArgs@(~(Just (nm,args))) = appMbConApp t + _ -> Nothing + +{-# LINE 74 "src/ehc/Gam/ClassDefaultGam.chs" #-} +instance Serialize ClassDefaultGamInfo where + sput (ClassDefaultGamInfo a) = sput a + sget = liftM ClassDefaultGamInfo sget + diff --git a/src/UHC/Light/Compiler/Gam/DataGam.hs b/src/UHC/Light/Compiler/Gam/DataGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/DataGam.hs @@ -0,0 +1,326 @@ +module UHC.Light.Compiler.Gam.DataGam +( DataFldMp, DataFldInfo (..), emptyDataFldInfo +, DataConFldAnnInfo (..), emptyDataConFldAnnInfo +, DataTagInfo (..), emptyDataTagInfo, DataConstrTagMp +, DataGamInfo (..) +, DataGam +, mkDGI +, mkDGIPlain +, emptyDataGamInfo, emptyDGI +, dgiDtiOfCon +, dataGamLookup, dataGamLookupErr +, dataGamDgiOfTy +, dtiOffsetOfFld +, DataFldInConstr (..), DataFldInConstrMp +, mkDGIForCodegenOnly +, dataGamDTIsOfTyNm, dataGamDTIsOfTy +, dataGamTagsOfTy, dataGamTagsOfTyNm +, dataGamLookupTag +, dataGamTagLookup +, dgiIsEnumable +, dgiConstrTagAssocL +, DataGamInfoVariant (..) +, dgiMbNewtype, dgiIsNewtype +, dgiIsRec ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import Data.Maybe + + + + + + +{-# LINE 48 "src/ehc/Gam/DataGam.chs" #-} +-- | per named field info +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataFldInfo + = DataFldInfo + { dfiOffset :: !Fld + } + deriving Show + +type DataFldMp = Map.Map HsName DataFldInfo + +emptyDataFldInfo + = DataFldInfo + noFld + +{-# LINE 68 "src/ehc/Gam/DataGam.chs" #-} +-- | per positional constructor field annotation like info +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataConFldAnnInfo + = DataConFldAnnInfo + { dcfaiStrictness :: !Strictness + } + deriving Show + +emptyDataConFldAnnInfo :: DataConFldAnnInfo +emptyDataConFldAnnInfo + = DataConFldAnnInfo + Strictness_NonStrict + +{-# LINE 87 "src/ehc/Gam/DataGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataTagInfo + = DataTagInfo + { dtiFldMp :: !DataFldMp -- map of field names to offset + , dtiFldTyL :: !FldTyL -- association list of maybe a field name with types + , dtiConFldAnnL :: ![DataConFldAnnInfo] -- per constructor field (with or without name) annotation info + , dtiConNm :: !HsName -- constructor name (duplicate of key of gamma leading to this info) + , dtiConTy :: !Ty -- type of constructor, without final tyVarMp applied + , dtiCTag :: !CTag -- tag of constructor + , dtiFldRefL :: ![Fld] -- list of offset/references positionally consistent with (e.g.) dtiFldTyL + , dtiMbFixityPrio :: !(Maybe (Int,Fixity)) -- if defined as infix, with priority + } deriving Show + +type DataConstrTagMp = Map.Map HsName DataTagInfo + +emptyDataTagInfo + = DataTagInfo + Map.empty [] [] hsnUnknown (appDbg "emptyDataTagInfo") + emptyCTag [] + Nothing + +{-# LINE 118 "src/ehc/Gam/DataGam.chs" #-} +dtiOffsetOfFld :: HsName -> DataTagInfo -> Fld +dtiOffsetOfFld fldNm dti = dfiOffset $ panicJust "dtiOffsetOfFld" $ Map.lookup fldNm $ dtiFldMp dti + +{-# LINE 123 "src/ehc/Gam/DataGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataFldInConstr + = DataFldInConstr + { dficInTagMp :: !(Map.Map CTag Fld) + } + +type DataFldInConstrMp = Map.Map HsName DataFldInConstr + +{-# LINE 133 "src/ehc/Gam/DataGam.chs" #-} +-- | specific info about what a DataGamInfo encodes +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataGamInfoVariant + = DataGamInfoVariant_Plain -- plain data type + | DataGamInfoVariant_Newtype -- newtype variation + Ty -- the type lambda corresponding to a newtype + | DataGamInfoVariant_Rec -- tuple, record + deriving Eq + +{-# LINE 146 "src/ehc/Gam/DataGam.chs" #-} + +-- If this changes, also change {%{EH}ConfigInternalVersions} +data DataGamInfo + = DataGamInfo + { dgiTyNm :: !HsName -- type name (duplicate of key of gamma leading to this info) + , dgiDataTy :: !Ty -- the type sum of product + , dgiDataKi :: !Ty -- the kind + , dgiConstrNmL :: ![HsName] -- all constructor names + , dgiConstrTagMp :: !DataConstrTagMp -- per constructor info + , dgiFldInConstrMp :: !DataFldInConstrMp -- map from field name to all constructors having the field + , dgiVariant :: !DataGamInfoVariant + , dgiMaxConstrArity :: !Int + , dgiMbGenerInfo :: !(Maybe Int) -- max kind arity for generic behavior, currently \in {0,1} + } + +instance Show DataGamInfo where + show _ = "DataGamInfo" + +{-# LINE 176 "src/ehc/Gam/DataGam.chs" #-} +dgiMbNewtype :: DataGamInfo -> Maybe Ty +dgiMbNewtype (DataGamInfo {dgiVariant = DataGamInfoVariant_Newtype t}) = Just t +dgiMbNewtype _ = Nothing + +dgiIsNewtype :: DataGamInfo -> Bool +dgiIsNewtype = isJust . dgiMbNewtype + +{-# LINE 185 "src/ehc/Gam/DataGam.chs" #-} +dgiIsRec :: DataGamInfo -> Bool +dgiIsRec dgi = dgiVariant dgi == DataGamInfoVariant_Rec + +{-# LINE 190 "src/ehc/Gam/DataGam.chs" #-} +type DataGam = Gam HsName DataGamInfo + +{-# LINE 194 "src/ehc/Gam/DataGam.chs" #-} +mkDGI + :: HsName + -> Ty -> Ty -> [HsName] -> DataConstrTagMp -> DataGamInfoVariant + -> Maybe Int + -> DataGamInfo +mkDGI tyNm dty ki cNmL m nt + mbGener + = DataGamInfo + tyNm + dty + ki + cNmL + m' + fm nt mx + mbGener + where fm = Map.map DataFldInConstr $ Map.unionsWith Map.union + $ [ Map.singleton f (Map.singleton (dtiCTag ci) (dfiOffset fi)) | ci <- Map.elems m', (f,fi) <- Map.toList $ dtiFldMp ci ] + mx = maximum + ( (if Map.null m then (-1) else (ctagMaxArity $ dtiCTag $ head $ Map.elems m)) + : [ ctagArity $ dtiCTag dti | dti <- Map.elems m ] + ) + m' = Map.map (\dti -> dti {dtiCTag = patchTyInfoCTag tyNm mx $ dtiCTag dti}) m + +{-# LINE 235 "src/ehc/Gam/DataGam.chs" #-} +mkDGIPlain :: HsName -> Ty -> Ty -> [HsName] -> DataConstrTagMp -> DataGamInfo +mkDGIPlain tyNm dty dki cNmL m + = mkDGI tyNm dty dki cNmL m + DataGamInfoVariant_Plain + Nothing + + +{-# LINE 250 "src/ehc/Gam/DataGam.chs" #-} +-- | Construct a datatype info as extracted from (e.g.) Core intended only for codegen (i.e. no type system stuff). +mkDGIForCodegenOnly :: HsName -> DataConstrTagMp -> DataGamInfo +mkDGIForCodegenOnly tyNm m + = mkDGIPlain tyNm Ty_Any Ty_Any (Map.keys m) m + +{-# LINE 257 "src/ehc/Gam/DataGam.chs" #-} +emptyDataGamInfo, emptyDGI :: DataGamInfo +emptyDataGamInfo = mkDGIPlain hsnUnknown (appDbg "emptyDataGamInfo") (appDbg "mkDGIPlain") [] Map.empty +emptyDGI = emptyDataGamInfo + +{-# LINE 263 "src/ehc/Gam/DataGam.chs" #-} +dgiConstrTagAssocL :: DataGamInfo -> AssocL HsName DataTagInfo +dgiConstrTagAssocL dgi = [ (cn,panicJust "dgiConstrTagAssocL" $ Map.lookup cn $ dgiConstrTagMp dgi) | cn <- dgiConstrNmL dgi ] + +{-# LINE 268 "src/ehc/Gam/DataGam.chs" #-} +dgiDtiOfCon :: HsName -> DataGamInfo -> DataTagInfo +dgiDtiOfCon conNm dgi = panicJust "dgiDtiOfCon" $ Map.lookup conNm $ dgiConstrTagMp dgi + +{-# LINE 273 "src/ehc/Gam/DataGam.chs" #-} +dataGamLookup :: HsName -> DataGam -> Maybe DataGamInfo +dataGamLookup nm g + = case gamLookup nm g of + Nothing + | hsnIsProd nm -- ??? should not be necessary, in variant 7 where tuples are represented by records + -> Just emptyDataGamInfo + Just dgi -> Just dgi + _ -> Nothing + +dataGamLookupErr :: HsName -> DataGam -> (DataGamInfo,ErrL) +dataGamLookupErr n g + = case dataGamLookup n g of + Nothing -> (emptyDGI,[rngLift emptyRange mkErr_NamesNotIntrod "data" [n]]) + Just tgi -> (tgi,[]) + +{-# LINE 290 "src/ehc/Gam/DataGam.chs" #-} +dataGamDgiOfTy :: Ty -> DataGam -> Maybe DataGamInfo +dataGamDgiOfTy conTy dg = dataGamLookup (tyAppFunConNm conTy) dg + +{-# LINE 295 "src/ehc/Gam/DataGam.chs" #-} +dataGamDTIsOfTyNm :: HsName -> DataGam -> Maybe [DataTagInfo] +dataGamDTIsOfTyNm tn g + = fmap + (assocLElts . dgiConstrTagAssocL) + $ gamLookup tn + $ g + +dataGamDTIsOfTy :: Ty -> DataGam -> Maybe [DataTagInfo] +dataGamDTIsOfTy = dataGamDTIsOfTyNm . tyDataTyNm +{-# INLINE dataGamDTIsOfTy #-} + +{-# LINE 312 "src/ehc/Gam/DataGam.chs" #-} +dataGamTagsOf :: (t -> DataGam -> Maybe [DataTagInfo]) -> t -> DataGam -> Maybe [CTag] +dataGamTagsOf lkup t g = fmap (map dtiCTag) (lkup t g) +{-# INLINE dataGamTagsOf #-} + +dataGamTagsOfTy :: Ty -> DataGam -> Maybe [CTag] +dataGamTagsOfTy = dataGamTagsOf dataGamDTIsOfTy + +dataGamTagsOfTyNm :: HsName -> DataGam -> Maybe [CTag] +dataGamTagsOfTyNm = dataGamTagsOf dataGamDTIsOfTyNm + +{-# LINE 324 "src/ehc/Gam/DataGam.chs" #-} +dataGamLookupTag :: HsName -> HsName -> DataGam -> Maybe CTag +dataGamLookupTag t c g + = do dgi <- dataGamLookup t g + dti <- Map.lookup c $ dgiConstrTagMp dgi + return $ dtiCTag dti + +{-# LINE 332 "src/ehc/Gam/DataGam.chs" #-} +dataGamTagLookup :: TagLike t => t -> DataGam -> Maybe (DataGamInfo,DataTagInfo) +dataGamTagLookup tag g + | tagIsData tag + = do dgi <- dataGamLookup (tagDataTypeNm tag) g + dti <- Map.lookup (tagDataConstrNm tag) $ dgiConstrTagMp dgi + return (dgi,dti) + | otherwise + = Nothing + +{-# LINE 345 "src/ehc/Gam/DataGam.chs" #-} +dgiIsEnumable :: DataGamInfo -> Bool +dgiIsEnumable dgi = dgiMaxConstrArity dgi == 0 + +{-# LINE 354 "src/ehc/Gam/DataGam.chs" #-} +deriving instance Typeable DataFldInfo +deriving instance Data DataFldInfo + +deriving instance Typeable DataConFldAnnInfo +deriving instance Data DataConFldAnnInfo + +deriving instance Typeable DataTagInfo +deriving instance Data DataTagInfo + +deriving instance Typeable DataFldInConstr +deriving instance Data DataFldInConstr + +deriving instance Typeable DataGamInfo +deriving instance Data DataGamInfo + +{-# LINE 371 "src/ehc/Gam/DataGam.chs" #-} +deriving instance Typeable DataGamInfoVariant +deriving instance Data DataGamInfoVariant + +{-# LINE 376 "src/ehc/Gam/DataGam.chs" #-} +instance Serialize DataGamInfoVariant where + sput (DataGamInfoVariant_Plain ) = sputWord8 0 + sput (DataGamInfoVariant_Newtype a) = sputWord8 1 >> sput a + sput (DataGamInfoVariant_Rec ) = sputWord8 2 + sget = do + t <- sgetWord8 + case t of + 0 -> return DataGamInfoVariant_Plain + 1 -> liftM DataGamInfoVariant_Newtype sget + 2 -> return DataGamInfoVariant_Rec + +{-# LINE 393 "src/ehc/Gam/DataGam.chs" #-} +instance Serialize DataFldInfo where + sput (DataFldInfo a) = sput a + sget = liftM DataFldInfo sget + +instance Serialize DataConFldAnnInfo where + sput (DataConFldAnnInfo a) = sput a + sget = liftM DataConFldAnnInfo sget + +instance Serialize DataTagInfo where + sput (DataTagInfo a b c d e f g h) = sput a >> sput b >> sput c >> sput d >> sput e >> sput f >> sput g >> sput h + sget = liftM8 DataTagInfo sget sget sget sget sget sget sget sget + +instance Serialize DataFldInConstr where + sput (DataFldInConstr a) = sput a + sget = liftM DataFldInConstr sget + +instance Serialize DataGamInfo where + sput (DataGamInfo a b c d e f g h i) = sput a >> sput b >> sput c >> sput d >> sput e >> sput f >> sput g >> sput h >> sput i + sget = liftM9 DataGamInfo sget sget sget sget sget sget sget sget sget diff --git a/src/UHC/Light/Compiler/Gam/FixityGam.hs b/src/UHC/Light/Compiler/Gam/FixityGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/FixityGam.hs @@ -0,0 +1,53 @@ +module UHC.Light.Compiler.Gam.FixityGam +( FixityGam, FixityGamInfo (..), defaultFixityGamInfo +, fixityGamLookup +, initFixityGam ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Quantify +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + +{-# LINE 40 "src/ehc/Gam/FixityGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data FixityGamInfo = FixityGamInfo { fgiPrio :: !Int, fgiFixity :: !Fixity } deriving Show + +defaultFixityGamInfo = FixityGamInfo fixityMaxPrio Fixity_Infixl + +type FixityGam = Gam HsName FixityGamInfo + +{-# LINE 49 "src/ehc/Gam/FixityGam.chs" #-} +deriving instance Typeable FixityGamInfo +deriving instance Data FixityGamInfo + + +{-# LINE 55 "src/ehc/Gam/FixityGam.chs" #-} +fixityGamLookup :: HsName -> FixityGam -> FixityGamInfo +fixityGamLookup nm fg = maybe defaultFixityGamInfo id $ gamLookup nm fg + +{-# LINE 64 "src/ehc/Gam/FixityGam.chs" #-} +initFixityGam :: FixityGam +initFixityGam + = assocLToGam + [ (hsnArrow , FixityGamInfo 1 Fixity_Infixr) + , (hsnPrArrow, FixityGamInfo 2 Fixity_Infixr) + , (hsnEqTilde, FixityGamInfo 3 Fixity_Infix ) + ] + +{-# LINE 90 "src/ehc/Gam/FixityGam.chs" #-} +instance Serialize FixityGamInfo where + sput (FixityGamInfo a b) = sput a >> sput b + sget = liftM2 FixityGamInfo sget sget diff --git a/src/UHC/Light/Compiler/Gam/Full.hs b/src/UHC/Light/Compiler/Gam/Full.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/Full.hs @@ -0,0 +1,33 @@ +module UHC.Light.Compiler.Gam.Full +( module UHC.Light.Compiler.Gam +, module UHC.Light.Compiler.Gam.FixityGam +, module UHC.Light.Compiler.Gam.ValGam +, module UHC.Light.Compiler.Gam.TyGam +, module UHC.Light.Compiler.Gam.Quantify +, module UHC.Light.Compiler.Gam.Instantiate +, module UHC.Light.Compiler.Gam.TyKiGam +, module UHC.Light.Compiler.Gam.KiGam +, module UHC.Light.Compiler.Gam.DataGam +, module UHC.Light.Compiler.Gam.PolGam ) +where +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.FixityGam +import UHC.Light.Compiler.Gam.ValGam +import UHC.Light.Compiler.Gam.TyGam +import UHC.Light.Compiler.Gam.Quantify +import UHC.Light.Compiler.Gam.Instantiate +import UHC.Light.Compiler.Gam.TyKiGam +import UHC.Light.Compiler.Gam.KiGam +import UHC.Light.Compiler.Gam.DataGam +import UHC.Light.Compiler.Gam.PolGam + + + + + + + + + +{-# LINE 33 "src/ehc/Gam/Full.chs" #-} +-- dummy diff --git a/src/UHC/Light/Compiler/Gam/Instantiate.hs b/src/UHC/Light/Compiler/Gam/Instantiate.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/Instantiate.hs @@ -0,0 +1,51 @@ +module UHC.Light.Compiler.Gam.Instantiate +( gamInst1Exists +, valGamInst1Exists +, tyKiGamInst1Exists +, gamInst1ExistsWithVarMp +, valGamInst1ExistsWithVarMp +, tyKiGamInst1ExistsWithVarMp ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.ValGam +import UHC.Light.Compiler.Gam.TyKiGam + + + +{-# LINE 26 "src/ehc/Gam/Instantiate.chs" #-} +gamInst1Exists :: Ord k => (v -> Ty,v -> Ty -> v) -> UID -> Gam k v -> Gam k v +gamInst1Exists (extr,upd) u + = fst . gamMapThr (\(n,t) u -> let (u',ue) = mkNewLevUID u in ((n,upd t (tyInst1Exists ue (extr t))),u')) u + +{-# LINE 32 "src/ehc/Gam/Instantiate.chs" #-} +gamInst1ExistsWithVarMp :: Ord key => (info -> Ty,Ty -> info -> info) -> VarMp -> UID -> Gam key info -> (Gam key info,VarMp) +gamInst1ExistsWithVarMp getset gamVarMp u g + = (g',m) + where (g',m,_) + = gamDoTyWithVarMp + getset + (\_ (t,_) m u -> let (u',ue) = mkNewLevUID u + in (tyInst1Exists ue t,m,u') + ) + gamVarMp u g + +{-# LINE 49 "src/ehc/Gam/Instantiate.chs" #-} +valGamInst1Exists :: UID -> ValGam -> ValGam +valGamInst1Exists = gamInst1Exists (vgiTy,(\vgi t -> vgi {vgiTy=t})) + +{-# LINE 54 "src/ehc/Gam/Instantiate.chs" #-} +valGamInst1ExistsWithVarMp :: VarMp -> UID -> ValGam -> (ValGam,VarMp) +valGamInst1ExistsWithVarMp = gamInst1ExistsWithVarMp vgiGetSet + +{-# LINE 63 "src/ehc/Gam/Instantiate.chs" #-} +tyKiGamInst1Exists :: UID -> TyKiGam -> TyKiGam +tyKiGamInst1Exists = gamInst1Exists (tkgiKi,(\i k -> i {tkgiKi=k})) + +{-# LINE 68 "src/ehc/Gam/Instantiate.chs" #-} +tyKiGamInst1ExistsWithVarMp :: VarMp -> UID -> TyKiGam -> (TyKiGam,VarMp) +tyKiGamInst1ExistsWithVarMp = gamInst1ExistsWithVarMp tkgiGetSet + diff --git a/src/UHC/Light/Compiler/Gam/KiGam.hs b/src/UHC/Light/Compiler/Gam/KiGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/KiGam.hs @@ -0,0 +1,41 @@ +module UHC.Light.Compiler.Gam.KiGam +( KiGam, KiGamInfo (..) +, initKiGam ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Quantify + + + + + + +{-# LINE 37 "src/ehc/Gam/KiGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data KiGamInfo + = KiGamInfo + { kgiKi :: Ty } + deriving Show + +type KiGam = Gam HsName KiGamInfo + +{-# LINE 53 "src/ehc/Gam/KiGam.chs" #-} +initKiGam :: KiGam +initKiGam + = assocLToGam + [ (hsnArrow , KiGamInfo (appCon hsnArrow)) + , (hsnKindStar, KiGamInfo kiStar) + , (hsnKindRow , KiGamInfo kiRow) + ] + diff --git a/src/UHC/Light/Compiler/Gam/PolGam.hs b/src/UHC/Light/Compiler/Gam/PolGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/PolGam.hs @@ -0,0 +1,100 @@ +module UHC.Light.Compiler.Gam.PolGam +( PolGamInfo (..), PolGam, mapPolGam, mkPGI +, polGamLookup, polGamLookupErr +, initPolGam ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + +{-# LINE 37 "src/ehc/Gam/PolGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data PolGamInfo = PolGamInfo { pgiPol :: Polarity } deriving Show + +mkPGI :: Ty -> PolGamInfo +mkPGI t = PolGamInfo t + +emptyPGI :: PolGamInfo +emptyPGI = mkPGI Ty_Any + +type PolGam = Gam HsName PolGamInfo + + +mapPolGam :: (Ty -> Ty) -> PolGam -> PolGam +mapPolGam f + = fst . gamMapThr (\(nm, PolGamInfo ty) thr -> ((nm, PolGamInfo $ f ty), thr)) () + +{-# LINE 55 "src/ehc/Gam/PolGam.chs" #-} +deriving instance Typeable PolGamInfo +deriving instance Data PolGamInfo + +{-# LINE 60 "src/ehc/Gam/PolGam.chs" #-} +polGamLookup :: HsName -> PolGam -> Maybe PolGamInfo +polGamLookup = gamLookup + +polGamLookupErr :: HsName -> PolGam -> (PolGamInfo,ErrL) +polGamLookupErr n g + = case polGamLookup n g of + Nothing -> (emptyPGI,[rngLift emptyRange mkErr_NamesNotIntrod "polarity" [n]]) + Just i -> (i,[]) + +{-# LINE 75 "src/ehc/Gam/PolGam.chs" #-} +initPolGam :: PolGam +initPolGam + = assocLToGam + [ (hsnArrow , mkPGI $ quant $ [mkPolNegate var, var] `appArr` var) + , (hsnInt , mkPGI quantvar) + , (hsnChar , mkPGI quantvar) + , (hsnRec , mkPGI $ quant $ [var] `appArr` var) + , (hsnInteger , mkPGI quantvar) + , (hsnInt8Unboxed , mkPGI quantvar) + , (hsnInt16Unboxed , mkPGI quantvar) + , (hsnInt32Unboxed , mkPGI quantvar) + , (hsnInt64Unboxed , mkPGI quantvar) + , (hsnWordUnboxed , mkPGI quantvar) + , (hsnWord8Unboxed , mkPGI quantvar) + , (hsnWord16Unboxed , mkPGI quantvar) + , (hsnWord32Unboxed , mkPGI quantvar) + , (hsnWord64Unboxed , mkPGI quantvar) + , (hsnAddrUnboxed , mkPGI quantvar) + ] + where + u = uidStart + quant = mkTyQu tyQu_Forall [(u,kiStar)] -- TBD + var = mkPolVar u + quantvar = quant var + +{-# LINE 114 "src/ehc/Gam/PolGam.chs" #-} +instance VarUpdatable PolGamInfo VarMp where + s `varUpd` pgi = pgi { pgiPol = s `varUpd` pgiPol pgi } + s `varUpdCyc` pgi = substLift pgiPol (\i x -> i {pgiPol = x}) varUpdCyc s pgi + +instance VarExtractable PolGamInfo TyVarId where + varFreeSet pgi = varFreeSet (pgiPol pgi) + +{-# LINE 123 "src/ehc/Gam/PolGam.chs" #-} +instance PP PolGamInfo where + pp i = ppTy (pgiPol i) + +{-# LINE 136 "src/ehc/Gam/PolGam.chs" #-} +instance Serialize PolGamInfo where + sput (PolGamInfo a) = sput a + sget = liftM PolGamInfo sget + diff --git a/src/UHC/Light/Compiler/Gam/Quantify.hs b/src/UHC/Light/Compiler/Gam/Quantify.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/Quantify.hs @@ -0,0 +1,62 @@ +module UHC.Light.Compiler.Gam.Quantify +( tyKiGamQuantifyWithVarMp +, valGamQuantify +, valGamQuantifyWithVarMp +, quantifyPolGam ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import qualified Data.Set as Set +import UHC.Light.Compiler.Ty.Trf.Quantify +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.ValGam +import UHC.Light.Compiler.Gam.TyKiGam +import UHC.Light.Compiler.Ty.Trf.MergePreds +import UHC.Light.Compiler.Gam.PolGam + + + + + + +{-# LINE 57 "src/ehc/Gam/Quantify.chs" #-} +valGamQuantify :: TyVarIdS -> [PredOcc] -> ValGam -> (ValGam,TQOGam) +valGamQuantify globTvS prL g + = let g' = gamMapElts (\vgi -> let tmpo = tyMergePreds prL (vgiTy vgi) + ty = valTyQuantify (const kiStar) (`Set.member` globTvS) (tmpoTy tmpo) + in (vgi {vgiTy = ty},tmpo {tmpoTy = ty}) + ) g + in gamUnzip g' + +{-# LINE 67 "src/ehc/Gam/Quantify.chs" #-} +valGamQuantifyWithVarMp :: Bool -> TyKiGam -> VarMp -> VarMp -> TyVarIdS -> [PredOcc] -> ValGam -> (ValGam,VarMp,(VarMp,TQOGam)) +valGamQuantifyWithVarMp doQuant tyKiGam tvKiVarMp gamVarMp globTvS prL valGam + = valGamDoWithVarMp quant gamVarMp (emptyVarMp,emptyGam) valGam + where quant nm (t,tyCycVarMp) newVarMp (cycVarMp,tmpoGam) + = ( ty + , newVarMp + , (tyCycVarMp `varUpd` cycVarMp + , gamAdd nm (tmpo {tmpoTy = ty}) tmpoGam + ) ) + where tmpo = tyMergePreds prL t + ty | doQuant = valTyQuantify (tvarKi tyKiGam tvKiVarMp gamVarMp) (`Set.member` globTvS) (tmpoTy tmpo) + | otherwise = tmpoTy tmpo + +{-# LINE 95 "src/ehc/Gam/Quantify.chs" #-} +tyKiGamQuantifyWithVarMp :: EHCOpts -> VarMp -> TyVarIdS -> TyKiGam -> (TyKiGam,VarMp,VarMp) +tyKiGamQuantifyWithVarMp opts {- tyKiGam tvKiVarMp -} gamVarMp globTvS gam + = tyKiGamDoWithVarMp + (\_ (t,tyCycMp) m cycMp -> (tyKiQuantify (ehcOptPolyKinds opts) {- (tvarKi tyKiGam tvKiVarMp gamVarMp) -} (`Set.member` globTvS) t,m,tyCycMp `varUpd` cycMp)) + gamVarMp emptyVarMp gam + +{-# LINE 107 "src/ehc/Gam/Quantify.chs" #-} +quantifyPolGam :: PolGam -> PolGam +quantifyPolGam gam + = let fvs = varFree gam + notElemFtvs tv = not $ elem tv fvs + in mapPolGam (tyQuantify notElemFtvs) gam + diff --git a/src/UHC/Light/Compiler/Gam/TyGam.hs b/src/UHC/Light/Compiler/Gam/TyGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/TyGam.hs @@ -0,0 +1,105 @@ +module UHC.Light.Compiler.Gam.TyGam +( TyGamInfo (..) +, emptyTGI +, TyGam +, tyGamLookupErr +, mkTGIData +, mkTGI +, initTyGam +, tyGamLookup ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Quantify +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + + +{-# LINE 40 "src/ehc/Gam/TyGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data TyGamInfo + = TyGamInfo + { tgiTy :: !Ty + } + deriving Show + +{-# LINE 51 "src/ehc/Gam/TyGam.chs" #-} +deriving instance Typeable TyGamInfo +deriving instance Data TyGamInfo + +{-# LINE 56 "src/ehc/Gam/TyGam.chs" #-} +mkTGIData :: Ty -> Ty -> TyGamInfo +mkTGIData t _ = TyGamInfo t + +{-# LINE 61 "src/ehc/Gam/TyGam.chs" #-} +mkTGI :: Ty -> TyGamInfo +mkTGI t = mkTGIData t Ty_Any + +{-# LINE 66 "src/ehc/Gam/TyGam.chs" #-} +emptyTGI :: TyGamInfo +emptyTGI + = TyGamInfo + Ty_Any + +{-# LINE 75 "src/ehc/Gam/TyGam.chs" #-} +type TyGam = Gam HsName TyGamInfo + +{-# LINE 93 "src/ehc/Gam/TyGam.chs" #-} +tyGamLookupErr :: HsName -> TyGam -> (TyGamInfo,ErrL) +tyGamLookupErr n g + = case tyGamLookup n g of + Nothing -> (emptyTGI,[rngLift emptyRange mkErr_NamesNotIntrod "type" [n]]) + Just tgi -> (tgi,[]) + +{-# LINE 116 "src/ehc/Gam/TyGam.chs" #-} +tyGamLookup :: HsName -> TyGam -> Maybe TyGamInfo +tyGamLookup = gamLookup + +{-# LINE 142 "src/ehc/Gam/TyGam.chs" #-} +initTyGam :: TyGam +initTyGam + = assocLToGam + [ (hsnArrow , mkTGI (appCon hsnArrow)) + , (hsnInt , mkTGI tyInt) + , (hsnChar , mkTGI tyChar) + , (hsnRow , mkTGI (appCon hsnUnknown)) + , (hsnRec , mkTGI (appCon hsnRec)) + , (hsnSum , mkTGI (appCon hsnSum)) + , (hsnPrArrow , mkTGI (appCon hsnPrArrow)) + , (hsnEqTilde , mkTGI (appCon hsnEqTilde)) + , (hsnInteger , mkTGI tyInteger ) + , (hsnAddrUnboxed , mkTGI (appCon hsnAddrUnboxed ) ) + ] + +{-# LINE 218 "src/ehc/Gam/TyGam.chs" #-} +instance VarUpdatable TyGamInfo VarMp where + s `varUpd` tgi = tgi { tgiTy = s `varUpd` tgiTy tgi } + s `varUpdCyc` tgi = substLift tgiTy (\i x -> i {tgiTy = x}) varUpdCyc s tgi + +instance VarExtractable TyGamInfo TyVarId where + varFreeSet tgi = varFreeSet (tgiTy tgi) + +{-# LINE 229 "src/ehc/Gam/TyGam.chs" #-} +instance PP TyGamInfo where + pp tgi = ppTy (tgiTy tgi) + +{-# LINE 242 "src/ehc/Gam/TyGam.chs" #-} +instance Serialize TyGamInfo where + sput (TyGamInfo a) = sput a + sget = liftM TyGamInfo sget diff --git a/src/UHC/Light/Compiler/Gam/TyKiGam.hs b/src/UHC/Light/Compiler/Gam/TyKiGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/TyKiGam.hs @@ -0,0 +1,160 @@ +module UHC.Light.Compiler.Gam.TyKiGam +( TyKiGamInfo (..), TyKiGam, emptyTKGI +, tyKiGamLookupByName +, tyKiGamLookup +, tyKiGamLookupErr, tyKiGamLookupKi +, tyKiGamLookupByNameErr +, tyKiGamVarSingleton +, tyKiGamNameSingleton +, tyKiGamSingleton +, tvarKi +, initTyKiGam +, tkgiGetSet +, tyKiGamDoWithVarMp ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + +{-# LINE 39 "src/ehc/Gam/TyKiGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data TyKiGamInfo + = TyKiGamInfo + { tkgiKi :: !Ty } + deriving Show + +emptyTKGI :: TyKiGamInfo +emptyTKGI + = TyKiGamInfo + kiStar + +type TyKiGam = Gam TyKiKey TyKiGamInfo + +{-# LINE 58 "src/ehc/Gam/TyKiGam.chs" #-} +deriving instance Typeable TyKiGamInfo +deriving instance Data TyKiGamInfo + +{-# LINE 63 "src/ehc/Gam/TyKiGam.chs" #-} +tkgiGetSet = (tkgiKi,(\x i -> i {tkgiKi = x})) + +{-# LINE 67 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamLookupByTyVar :: TyVarId -> TyKiGam -> Maybe TyKiGamInfo +tyKiGamLookupByTyVar v g = gamLookup (TyKiKey_TyVar v) g + +{-# LINE 72 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamLookupByName :: HsName -> TyKiGam -> Maybe TyKiGamInfo +tyKiGamLookupByName n g + = case gamLookup (TyKiKey_Name n) g of + Nothing + | hsnIsProd n + -> Just (TyKiGamInfo (replicate (hsnProdArity n) kiStar `appArr` kiStar)) + x -> x + +{-# LINE 86 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamLookup :: Ty -> TyKiGam -> Maybe TyKiGamInfo +tyKiGamLookup t g + = case tyMbVar t of + Just v -> tyKiGamLookupByTyVar v g + Nothing -> + case tyMbCon t of + Just n -> tyKiGamLookupByName n g + _ -> Nothing + +{-# LINE 97 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamLookupErr :: Ty -> TyKiGam -> (TyKiGamInfo,ErrL) +tyKiGamLookupErr t g + = case tyKiGamLookup t g of + Nothing -> (emptyTKGI,[rngLift emptyRange mkErr_NamesNotIntrod "kind" [mkHNm $ show t]]) + Just i -> (i,[]) + +tyKiGamLookupKi :: TyKiGam -> Ty -> Ty +tyKiGamLookupKi g t = tkgiKi $ fst $ tyKiGamLookupErr t g + +{-# LINE 108 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamLookupByNameErr :: HsName -> TyKiGam -> (TyKiGamInfo,ErrL) +tyKiGamLookupByNameErr n g = tyKiGamLookupErr (appCon n) g + +{-# LINE 113 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamVarSingleton :: TyVarId -> TyKiGamInfo -> TyKiGam +tyKiGamVarSingleton v k = gamSingleton (TyKiKey_TyVar v) k + +{-# LINE 118 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamNameSingleton :: HsName -> TyKiGamInfo -> TyKiGam +tyKiGamNameSingleton n k = gamSingleton (TyKiKey_Name n) k + +{-# LINE 123 "src/ehc/Gam/TyKiGam.chs" #-} +tyKiGamSingleton :: Ty -> TyKiGamInfo -> TyKiGam +tyKiGamSingleton t k + = case tyMbVar t of + Just v -> tyKiGamVarSingleton v k + Nothing -> case tyMbCon t of + Just n -> tyKiGamNameSingleton n k + _ -> panic "Gam.tyKiGamSingleton" + +{-# LINE 133 "src/ehc/Gam/TyKiGam.chs" #-} +-- Do something with each kind in a TyKiGam. +tyKiGamDoWithVarMp :: (TyKiKey -> (Ty,VarMp) -> VarMp -> thr -> (Ty,VarMp,thr)) -> VarMp -> thr -> TyKiGam -> (TyKiGam,VarMp,thr) +tyKiGamDoWithVarMp = gamDoTyWithVarMp tkgiGetSet + +{-# LINE 149 "src/ehc/Gam/TyKiGam.chs" #-} +tvarKi :: TyKiGam -> VarMp -> VarMp -> TyVarId -> Ty +tvarKi tyKiGam tvKiVarMp _ tv + = case tyKiGamLookup tv' tyKiGam of + Just tkgi -> tvKiVarMp `varUpd` tkgiKi tkgi + _ -> tvKiVarMp `varUpd` tv' + where tv' = {- tyVarMp `varUpd` -} mkTyVar tv + +{-# LINE 162 "src/ehc/Gam/TyKiGam.chs" #-} +initTyKiGam :: TyKiGam +initTyKiGam + = gamUnions + [ (tyKiGamNameSingleton hsnArrow (TyKiGamInfo ([kiStar,kiStar] `appArr` kiStar))) + , gamUnions + (zipWith tyKiGamNameSingleton + [ hsnInt, hsnChar + , hsnInteger + ] + (repeat star) + ) + , (tyKiGamNameSingleton hsnRow (TyKiGamInfo kiRow)) + , (tyKiGamNameSingleton hsnRec (TyKiGamInfo ([kiRow] `appArr` kiStar))) + , (tyKiGamNameSingleton hsnSum (TyKiGamInfo ([kiRow] `appArr` kiStar))) + , (tyKiGamNameSingleton hsnPrArrow (TyKiGamInfo ([kiStar,kiStar] `appArr` kiStar))) + , (tyKiGamNameSingleton hsnEqTilde (TyKiGamInfo ([kiStar,kiStar] `appArr` kiStar))) -- TBD: should be polykinded, but does not matter as already rewritten to explicit equality predicate at the time this info is used + ] + where star = TyKiGamInfo kiStar + +{-# LINE 221 "src/ehc/Gam/TyKiGam.chs" #-} +instance VarUpdatable TyKiGamInfo VarMp where + s `varUpd` tkgi = tkgi { tkgiKi = s `varUpd` tkgiKi tkgi } + s `varUpdCyc` tkgi = substLift tkgiKi (\i x -> i {tkgiKi = x}) varUpdCyc s tkgi + +instance VarExtractable TyKiGamInfo TyVarId where + varFreeSet tkgi = varFreeSet (tkgiKi tkgi) + +{-# LINE 230 "src/ehc/Gam/TyKiGam.chs" #-} +instance PP TyKiGamInfo where + pp i = ppTy (tkgiKi i) + +{-# LINE 243 "src/ehc/Gam/TyKiGam.chs" #-} +instance Serialize TyKiGamInfo where + sput (TyKiGamInfo a) = sput a + sget = liftM TyKiGamInfo sget + diff --git a/src/UHC/Light/Compiler/Gam/Utils.hs b/src/UHC/Light/Compiler/Gam/Utils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/Utils.hs @@ -0,0 +1,31 @@ +module UHC.Light.Compiler.Gam.Utils +( mentrelFilterMpExtendViaValGam ) +where +import Data.List +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsIn +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Light.Compiler.Ty.UsedNames +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Gam.ValGam + + +{-# LINE 66 "src/ehc/Gam/Utils.chs" #-} +-- | Lookup indirectly used identifiers, type constants from types of value bindings. +mentrelFilterMpExtendViaValGam :: HsName -> ValGam -> ModEntRelFilterMp -> ModEntRelFilterMp +mentrelFilterMpExtendViaValGam moduleNm valGam mentrelFilterMp + = mentrelFilterMpUnions + ( [ mentrelFilterMp ] + ++ [ maybe Map.empty (tyUsedNames moduleNm . vgiTy) $ valGamLookup n valGam + | n <- Set.toList $ Map.findWithDefault Set.empty IdOcc_Val mentrelFilterMp + ] + ) + diff --git a/src/UHC/Light/Compiler/Gam/ValGam.hs b/src/UHC/Light/Compiler/Gam/ValGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Gam/ValGam.hs @@ -0,0 +1,118 @@ +module UHC.Light.Compiler.Gam.ValGam +( ValGamInfo (..), ValGam +, valGamLookupTy +, valGamMapTy +, valGamLookup +, valGamTyOfDataCon +, valGamTyOfDataFld +, vgiGetSet +, valGamLookupTyDefault +, valGamDoWithVarMp ) +where +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Error +import qualified Data.Set as Set +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Quantify +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + + +{-# LINE 40 "src/ehc/Gam/ValGam.chs" #-} +-- If this changes, also change {%{EH}ConfigInternalVersions} +data ValGamInfo + = ValGamInfo + { vgiTy :: Ty } -- strictness has negative mem usage effect. Why?? + deriving Show + +type ValGam = Gam HsName ValGamInfo + +{-# LINE 52 "src/ehc/Gam/ValGam.chs" #-} +deriving instance Typeable ValGamInfo +deriving instance Data ValGamInfo + +{-# LINE 57 "src/ehc/Gam/ValGam.chs" #-} +vgiGetSet = (vgiTy,(\x i -> i {vgiTy = x})) + +{-# LINE 66 "src/ehc/Gam/ValGam.chs" #-} +valGamLookupTy :: HsName -> ValGam -> (Ty,ErrL) +valGamLookupTy n g + = case valGamLookup n g of + Nothing -> (Ty_Any,[rngLift emptyRange mkErr_NamesNotIntrod "value" [n]]) + Just vgi -> (vgiTy vgi,[]) + +{-# LINE 74 "src/ehc/Gam/ValGam.chs" #-} +-- | lookup Ty in ValGam, defaulting to Ty_Any +valGamLookupTyDefault :: HsName -> ValGam -> Ty +valGamLookupTyDefault n g = maybe (Ty_Dbg $ "valGamLookupTyDefault: " ++ show n) vgiTy $ valGamLookup n g + +{-# LINE 80 "src/ehc/Gam/ValGam.chs" #-} +valGamLookup :: HsName -> ValGam -> Maybe ValGamInfo +valGamLookup nm g + = case gamLookup nm g of + Nothing + | hsnIsProd nm + -> let pr = mkPr nm in mkRes (tyProdArgs pr `appArr` pr) + | hsnIsUn nm && hsnIsProd (hsnUnUn nm) + -> let pr = mkPr (hsnUnUn nm) in mkRes ([pr] `appArr` pr) + where mkPr nm = mkTyFreshProd (hsnProdArity nm) + mkRes t = Just (ValGamInfo (tyQuantifyClosed t)) + Just vgi -> Just vgi + _ -> Nothing + +{-# LINE 102 "src/ehc/Gam/ValGam.chs" #-} +valGamMapTy :: (Ty -> Ty) -> ValGam -> ValGam +valGamMapTy f = gamMapElts (\vgi -> vgi {vgiTy = f (vgiTy vgi)}) + +{-# LINE 107 "src/ehc/Gam/ValGam.chs" #-} +-- Do something with each ty in a ValGam. +valGamDoWithVarMp :: (HsName -> (Ty,VarMp) -> VarMp -> thr -> (Ty,VarMp,thr)) -> VarMp -> thr -> ValGam -> (ValGam,VarMp,thr) +valGamDoWithVarMp = gamDoTyWithVarMp vgiGetSet + +{-# LINE 118 "src/ehc/Gam/ValGam.chs" #-} +valGamTyOfDataCon :: HsName -> ValGam -> (Ty,Ty,ErrL) +valGamTyOfDataCon conNm g + = (t,rt,e) + where (t,e) = valGamLookupTy conNm g + (_,rt) = appUnArr t + +{-# LINE 126 "src/ehc/Gam/ValGam.chs" #-} +valGamTyOfDataFld :: HsName -> ValGam -> (Ty,Ty,ErrL) +valGamTyOfDataFld fldNm g + | null e = (t,rt,e) + | otherwise = (t,Ty_Any,e) + where (t,e) = valGamLookupTy fldNm g + ((rt:_),_) = appUnArr t + + +{-# LINE 145 "src/ehc/Gam/ValGam.chs" #-} +instance VarUpdatable ValGamInfo VarMp where + s `varUpd` vgi = vgi { vgiTy = s `varUpd` vgiTy vgi } + s `varUpdCyc` vgi = substLift vgiTy (\i x -> i {vgiTy = x}) varUpdCyc s vgi + +instance VarExtractable ValGamInfo TyVarId where + varFreeSet vgi = varFreeSet (vgiTy vgi) + +{-# LINE 156 "src/ehc/Gam/ValGam.chs" #-} +instance PP ValGamInfo where + pp vgi = ppTy (vgiTy vgi) + +{-# LINE 169 "src/ehc/Gam/ValGam.chs" #-} +instance Serialize ValGamInfo where + sput (ValGamInfo a) = sput a + sget = liftM ValGamInfo sget + diff --git a/src/UHC/Light/Compiler/Generics.hs b/src/UHC/Light/Compiler/Generics.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Generics.hs @@ -0,0 +1,252 @@ +module UHC.Light.Compiler.Generics +( Proj (..) +, projFrom +, projTo ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.AbstractCore.Utils +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Gam.DataGam +import UHC.Util.Utils + + + +{-# LINE 28 "src/ehc/Generics.chs" #-} +data Proj + = + -- unit for product, sum resp + Proj_U1 + | Proj_Void + + -- product field wrapper + | Proj_Rec1 + { projTyL :: !TyL -- singleton + , projN :: !Int + } + | Proj_Par1 + { projTyL :: !TyL -- singleton + , projN :: !Int + } + | Proj_K1 + { projTyL :: !TyL -- singleton + } + | Proj_Comp1 + { projTyL :: !TyL -- singleton + , projF1Ty :: !Ty + , projF2Proj :: !Proj + } + + -- sum alternative wrapper + | Proj_L1 -- left sum injection, wrapping a constructor Proj + { projProj :: !Proj + } + | Proj_R1 -- right sum injection, wrapping a constructor Proj + { projProj :: !Proj + } + + -- meta info wrapper, both for sum and outer layer of product + | Proj_M1 -- meta info + { projProj :: !Proj + } + | Proj_M1_S1 -- meta info, variant of M1, to be used inside product; is it really necessary? + { projProj :: !Proj + } + + -- special constructs + | Proj_Con -- the datatype alternative + { projCTag :: !CTag + , projProj :: !Proj + } + | Proj_Prod -- place holder for product + { proj1Proj :: !Proj + , proj2Proj :: !Proj + } + | Proj_Sum -- place holder for sum, components are Proj_L1 and Proj_R1 resp. + { proj1Proj :: !Proj + , proj2Proj :: !Proj + } + | Proj -- top constructor, a Proj_Sum + { projProjL :: !Proj + } + deriving (Show) + +{-# LINE 92 "src/ehc/Generics.chs" #-} +-- | get the constructor info +projCon :: Proj -> Proj +projCon (Proj_L1 p) = projCon p +projCon (Proj_R1 p) = projCon p +projCon (Proj_M1 p) = projCon p +projCon p = p + +{-# LINE 101 "src/ehc/Generics.chs" #-} +-- | get all sum alternatives +projSumAlts :: Proj -> [Proj] +projSumAlts (Proj_Sum l r) = projSumAlts l ++ projSumAlts r +projSumAlts (Proj_L1 p ) = map Proj_L1 $ projSumAlts p +projSumAlts (Proj_R1 p ) = map Proj_R1 $ projSumAlts p +projSumAlts (Proj_M1 p ) = map Proj_M1 $ projSumAlts p +projSumAlts Proj_Void = [] +projSumAlts p = [p] + +{-# LINE 116 "src/ehc/Generics.chs" #-} +-- | builtin name of constructor +projBuiltinNm :: EHCOpts -> Proj -> HsName +projBuiltinNm opts proj + = case proj of + Proj_U1 -> v ehbnGenerDataUnit1AltU1 + Proj_Void -> v ehbnUndefined + Proj_Rec1 _ _ -> v ehbnGenerDataRec1AltRec1 + Proj_Par1 _ _ -> v ehbnGenerDataPar1AltPar1 + Proj_K1 _ -> v ehbnGenerDataKonst1AltK1 + Proj_L1 _ -> v ehbnGenerDataSumAltLeft + Proj_R1 _ -> v ehbnGenerDataSumAltRight + Proj_M1 _ -> v ehbnGenerDataMeta1AltM1 + Proj_M1_S1 _ -> v ehbnGenerDataMeta1AltM1 + Proj_Comp1 _ _ _ -> v ehbnGenerDataComp1AltComp1 + Proj_Prod _ _ -> v ehbnGenerDataProdAltProd + _ -> panic ("projBuiltinNm: " ++ show proj) + where v f = ehcOptBuiltin opts f + +{-# LINE 136 "src/ehc/Generics.chs" #-} +-- | builtin var of constructor +projBuiltinVar :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> Proj -> e +projBuiltinVar opts proj + = acoreVar $ projBuiltinNm opts proj + +{-# LINE 147 "src/ehc/Generics.chs" #-} +-- | pattern names arg to acoreSatSelsCases +nmLForCase nL = zipWith (\n o -> (n,acoreTyErr $ "nmLForCase: " ++ show n,{-n,-}o)) nL [(0::Int) ..] + +{-# LINE 152 "src/ehc/Generics.chs" #-} +-- | from function, starting with a top level proj +projFrom + :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, Eq bcat) + => EHCOpts + -> RCEEnv' e m b ba t + -> Proj -- projection descriptor + -> e -- resulting function +projFrom + opts rceEnv + (Proj sum) + = acoreLamTy (acoreTyErrLift "Generics.projFrom.argNm" [argNm]) + $ acoreSatSelsCasesTy + rceEnv (Just (hsnUniqifyEval argNm,acoreTyErr "Generics.projFrom.sel")) (acoreVar argNm) + [ (tg, nmLForCase nL, Nothing, fst $ mkExp proj nL) + | proj <- projSumAlts sum + , let con = projCon proj + tg = projCTag con + nL = tgNms tg + ] + where -- argument name + argNm = mkHNm "x" + + -- field names + tgNms tg = take (ctagArity tg) $ hsnLclSupply + + -- make the rhs expr + mkExp proj nL@(~(n:nL')) + = case proj of + Proj_Prod l r -> (acoreApp (projBuiltinVar opts proj) [l',r'], nrL) + where (l',nlL) = mkExp l nL + (r',nrL) = mkExp r nlL + Proj_K1 _ -> var + Proj_Rec1 _ _ -> var + Proj_Par1 _ _ -> var + Proj_M1 _ -> wrap + Proj_M1_S1 _ -> wrap + Proj_L1 _ -> wrap + Proj_R1 _ -> wrap + Proj_Void -> unit + Proj_U1 -> unit + Proj_Comp1 _ _ _ -> var + Proj_Con _ _ -> skip + _ -> panic ("projFrom.mkExp: " ++ show proj) + where wrap = (acore1App (projBuiltinVar opts proj) x, nL') + where (x,nL') = mkExp (projProj proj) nL + unit = (projBuiltinVar opts proj, nL) + skip = mkExp (projProj proj) nL + var = (acore1App (projBuiltinVar opts proj) (acoreVar n), nL') + + + +{-# LINE 205 "src/ehc/Generics.chs" #-} +-- | from function, starting with a top level proj +projTo + :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a, Eq bcat) + => EHCOpts + -> RCEEnv' e m b ba t + -> Proj -- projection descriptor + -> e -- resulting function +projTo + opts rceEnv + (Proj sum) + = acoreLamTy (acoreTyErrLift "Generics.projTo.scrut" [scrut]) + $ mke (acoreVar scrut) -- ref to scrut is just dummy + where (mke,(scrut,_,_)) = mkExp sum [] (hsnLclSupplyWith $ mkHNm "proj") + + -- misc + dataGam = rceDataGam rceEnv + + -- make the full case expr, given the names to be bound + supply of scratch names used for intermediate scrutinizing case expressions + mkExp proj nL@(~(n:nL')) scrutL@(~(scrut:scrutL')) + = case proj of + -- product + Proj_Prod l r -> ( \e -> acoreSatSelsCasesTy rceEnv (Just (hsnUniqifyEval scrut,acoreTyErr "Generics.projTo.Prod.scrut")) (acoreVar scrut) + [ (prodTg ehbnGenerDataProdAltProd,nmLForCase [sl,sr],Nothing,l' $ r' e) ] + , (scrut, nr, ssr) + ) + where (l',(sl,nl,ssl)) = mkExp l nL scrutL' + (r',(sr,nr,ssr)) = mkExp r nl ssl + Proj_K1 _ -> var ehbnGenerDataKonst1 ehbnGenerDataKonst1AltK1 + Proj_Rec1 _ _ -> var ehbnGenerDataRec1 ehbnGenerDataRec1AltRec1 + Proj_Par1 _ _ -> var ehbnGenerDataPar1 ehbnGenerDataPar1AltPar1 + Proj_Comp1 _ _ _ -> var ehbnGenerDataComp1 ehbnGenerDataComp1AltComp1 + Proj_U1 -> unit ehbnGenerDataUnit1 ehbnGenerDataUnit1AltU1 + Proj_M1_S1 _ -> wrap ehbnGenerDataMeta1 ehbnGenerDataMeta1AltM1 + + -- sum + Proj_Sum l r -> ( \e -> acoreSatSelsCasesTy rceEnv (Just (hsnUniqifyEval scrut,acoreTyErr "Generics.projTo.Sum.scrut")) (acoreVar scrut) + [ (sumTg ehbnGenerDataSumAltLeft ,nmLForCase [sl],Nothing,l' e) + , (sumTg ehbnGenerDataSumAltRight,nmLForCase [sr],Nothing,r' e) + ] + , (scrut, nr, ssr) + ) + where (l',(sl,nl,ssl)) = mkExp l nL scrutL' + (r',(sr,nr,ssr)) = mkExp r nl ssl + Proj_M1 _ -> wrap ehbnGenerDataMeta1 ehbnGenerDataMeta1AltM1 + Proj_L1 _ -> skip + Proj_R1 _ -> skip + Proj_Void -> (const $ projBuiltinVar opts proj, (scrut, nL, scrutL')) + + -- glue on boundary from sum to product + Proj_Con tg p -> ( const $ p' $ acoreApp (acoreVar $ ctagNm tg) (map acoreVar nL) + , info + ) + where (p',info) = mkExp p nL scrutL + nL = take (ctagArity tg) $ hsnLclSupply + + -- should not happen + _ -> panic ("projTo.mkExp: " ++ show proj) + + where wrap ty con = mkC scrut [sp] np ssp p' ty con + where (p',(sp,np,ssp)) = mkExp (projProj proj) nL scrutL' + var = mkC scrut [n] nL' scrutL' id + unit = mkC scrut [] nL scrutL' id + mkC s nL nL' sL' mke ty con + = ( \e -> acoreSatSelsCasesTy rceEnv (Just (hsnUniqifyEval s,acoreTyErr "Generics.projTo.mkC.s")) (acoreVar s) + [ (tgOf ty con,nmLForCase nL,Nothing,mke e) ] + , (s, nL', sL') + ) + skip = mkExp (projProj proj) nL scrutL + + -- CTag for con of dataty combi + tgOf t c = panicJust ("projTo.tgOf: " ++ show c') $ dataGamLookupTag (ehcOptBuiltin opts t) c' dataGam + where c' = ehcOptBuiltin opts c + prodTg = tgOf ehbnGenerDataProd + sumTg = tgOf ehbnGenerDataSum + diff --git a/src/UHC/Light/Compiler/HI.hs b/src/UHC/Light/Compiler/HI.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/HI.hs @@ -0,0 +1,444 @@ +module UHC.Light.Compiler.HI +( Visible (..) +, HIInfoUsedModMp, HIInfo (..) +, emptyHIInfo +, hiiIsEmpty +, hiiIdDefOccGam +, mentrelToIdDefOccGam +, hiiIdDefOccGamToHIIdGam, hiiIdDefOccGamFromHIIdGam +, HIOrigin (..) +, HIValidity (..) +, sgetHIInfo +, ImpHIMp +, hiiUnion +, hiiIncludeCacheOfImport ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.NameAspect +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Gam.ClassDefaultGam +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.LamInfo +import UHC.Light.Compiler.Config +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Pred.ToCHR +import UHC.Light.Compiler.CHR.Solve +import qualified UHC.Light.Compiler.Gam.ClGam as Pr +import qualified Data.Set as Set +import qualified Data.Map as Map +import qualified UHC.Util.Rel as Rel +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import Control.Monad +import UHC.Util.Binary +import Data.Typeable (Typeable) +import Data.Generics (Data) +import UHC.Util.Serialize +import qualified UHC.Light.Compiler.Config as Cfg +import qualified UHC.Light.Compiler.ConfigInternalVersions as Cfg +import qualified UHC.Light.Compiler.SourceCodeSig as Sig +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty + + + + + + + + +{-# LINE 74 "src/ehc/HI.chs" #-} +data Visible + = VisibleNo | VisibleYes + deriving Eq + +instance Show Visible where + show VisibleNo = "visibleno" + show VisibleYes = "visibleyes" + +{-# LINE 88 "src/ehc/HI.chs" #-} +type HIInfoUsedModMp = (Map.Map HsName (Set.Set HsName)) + +-- | Encoding of info in .hi file, when changed also change {%{EH}ConfigInternalVersions} +data HIInfo + = HIInfo + { hiiValidity :: !HIValidity -- a valid HI info? + , hiiInternalVersions :: !( Cfg.InternalVersionHI -- internal version + , Cfg.InternalVersionCore + ) + , hiiOrigin :: !HIOrigin -- where did the HI come from + , hiiSrcSig :: !String -- compiler source signature (md5) + , hiiTarget :: !Target -- for which backend the hi is generated + , hiiTargetFlavor :: !TargetFlavor -- for which flavor the hi is generated + , hiiCompiler :: !String -- compiler version info + , hiiCompileFlags :: !String -- flags + , hiiHasMain :: !Bool -- has file a main? + , hiiModuleNm :: !HsName -- module name + , hiiSrcTimeStamp :: !String -- timestamp of compiler source + , hiiSrcVersionMajor :: !String -- major (etc) version numbers + , hiiSrcVersionMinor :: !String + , hiiSrcVersionMinorMinor :: !String + , hiiSrcVersionSvn :: !String -- svn version + + , hiiExps :: !ModEntRel -- exported stuff + , hiiHiddenExps :: !ModEntRel -- exported, but hidden otherwise (instances, optimized code variants, ...) + , hiiFixityGam :: !FixityGam -- fixity of identifiers + , hiiHIDeclImpModS :: !(Set.Set HsName) -- declared imports + , hiiHIUsedImpModS :: !(Set.Set HsName) -- used imports, usually indirectly via renaming + , hiiTransClosedUsedModMp :: !HIInfoUsedModMp -- used modules with their imports, required to be linked together, transitively closed/cached over imported modules + , hiiTransClosedOrphanModS:: !(Set.Set HsName) -- orphan modules, required to read its .hi file, transitively closed/cached over imported modules + , hiiMbOrphan :: !(Maybe (Set.Set HsName)) -- is orphan module, carrying the module names required + , hiiValGam :: !ValGam -- value identifier environment + , hiiTyGam :: !TyGam -- type identifier env + , hiiTyKiGam :: !TyKiGam -- type/tyvar kind env + , hiiPolGam :: !PolGam -- polarity env + , hiiDataGam :: !DataGam -- datatype info env + , hiiClGam :: !Pr.ClGam -- class env + , hiiClDfGam :: !ClassDefaultGam -- class defaults env + , hiiCHRStore :: !ScopedPredStore -- rule database + , hiiLamMp :: !LamMp -- codegen info for identifiers + , hiiImpHIMp :: !ImpHIMp -- cache of HIInfo's of imported modules, filtered for visibility + } + deriving (Typeable, Data) + +{-# LINE 147 "src/ehc/HI.chs" #-} +emptyHIInfo :: HIInfo +emptyHIInfo + = HIInfo HIValidity_Absent + (Cfg.internalVersionHI, Cfg.internalVersionCore) + HIOrigin_FromFile + "" defaultTarget defaultTargetFlavor "" "" False hsnUnknown "" "" "" "" "" + Rel.empty Rel.empty emptyGam + Set.empty Set.empty + Map.empty Set.empty + Nothing + emptyGam emptyGam emptyGam emptyGam emptyGam emptyGam emptyGam emptyCHRStore + Map.empty + Map.empty + +{-# LINE 174 "src/ehc/HI.chs" #-} +-- | not empty if ok +hiiIsEmpty :: HIInfo -> Bool +hiiIsEmpty hii = hiiValidity hii /= HIValidity_Ok + +{-# LINE 180 "src/ehc/HI.chs" #-} +hiiIdDefOccGam :: HIInfo -> IdDefOccGam +hiiIdDefOccGam hii = hiiIdDefOccGamFromHIIdGam $ mentrelToIdDefOccGam (hiiModuleNm hii) (hiiExps hii) + +{-# LINE 190 "src/ehc/HI.chs" #-} +instance Show HIInfo where + show _ = "HIInfo" + +instance PP HIInfo where + pp i = "HIInfo" >#< ( "ModNm =" >#< pp ( hiiModuleNm i) + >-< "DeclImp=" >#< ppCommas (Set.toList $ hiiHIDeclImpModS i) + >-< "UsedImp=" >#< ppCommas (Set.toList $ hiiHIUsedImpModS i) + >-< "AllUsed=" >#< ppAssocLV (assocLMapElt (ppCommas . Set.toList) $ Map.toList $ hiiTransClosedUsedModMp i) + >-< "AllOrph=" >#< ppCommas (Set.toList $ hiiTransClosedOrphanModS i) + >-< "MbOrph =" >#< ppCommas (maybe [] Set.toList $ hiiMbOrphan i) + -- >-< "Exps=" >#< pp (hiiExps i) + -- >-< "Exps(H)=" >#< pp (hiiHiddenExps i) + -- >-< "ValGam =" >#< pp (hiiValGam i) + -- >-< "TyGam =" >#< pp (hiiTyGam i) + -- >-< "Cached =" >#< ppAssocLV (assocLMapElt pp $ Map.toList $ hiiImpHIMp i) + ) + +{-# LINE 231 "src/ehc/HI.chs" #-} +type ImpHIMp = Map.Map HsName HIInfo + + +{-# LINE 236 "src/ehc/HI.chs" #-} +-- | combine HI info for a single module, as extracted from the cached hiiImpHIMp of the module importing these combined modules +hiiUnion :: HIInfo -> HIInfo -> HIInfo +hiiUnion m1 m2 + = m1 { hiiFixityGam = hiiFixityGam m1 `gamUnion` hiiFixityGam m2 + -- , hiiIdDefHIIdGam = hiiIdDefHIIdGam m1 `gamUnion` hiiIdDefHIIdGam m2 + , hiiValGam = hiiValGam m1 `gamUnion` hiiValGam m2 + , hiiTyGam = hiiTyGam m1 `gamUnion` hiiTyGam m2 + , hiiTyKiGam = hiiTyKiGam m1 `gamUnion` hiiTyKiGam m2 + , hiiPolGam = hiiPolGam m1 `gamUnion` hiiPolGam m2 + , hiiDataGam = hiiDataGam m1 `gamUnion` hiiDataGam m2 + , hiiClGam = hiiClGam m1 `gamUnion` hiiClGam m2 + , hiiClDfGam = hiiClDfGam m1 `gamUnion` hiiClDfGam m2 + , hiiCHRStore = hiiCHRStore m1 `chrStoreUnion` hiiCHRStore m2 + , hiiLamMp = hiiLamMp m1 `Map.union` hiiLamMp m2 + } + +{-# LINE 261 "src/ehc/HI.chs" #-} +-- | restrict envs to the ones being in the filter map, so only those visible relative to that map remain +hiiRestrictToFilterMp :: ModEntRelFilterMp -> HIInfo -> HIInfo +hiiRestrictToFilterMp mfm hii + = hii + { hiiFixityGam = fg expVT $ hiiFixityGam hii + -- , hiiIdDefHIIdGam = fg (\o -> exp (ioccKind o) (ioccNm o)) + -- $ hiiIdDefHIIdGam hii + , hiiValGam = fg expV $ hiiValGam hii + , hiiTyGam = fg expT $ hiiTyGam hii + , hiiTyKiGam = fg expT' $ hiiTyKiGam hii + , hiiPolGam = fg expT $ hiiPolGam hii + , hiiDataGam = fg expT $ hiiDataGam hii + , hiiClGam = fg expC $ hiiClGam hii + , hiiClDfGam = fg expC $ hiiClDfGam hii + , hiiLamMp = fm expV $ hiiLamMp hii + } + where exp k = (`Set.member` Map.findWithDefault Set.empty k mfm) + expV = exp IdOcc_Val + expT = exp IdOcc_Type + expT' = maybe False (exp IdOcc_Type) . tyKiKeyMbName + expVT x= expV x || expT x + expC = expT -- exp IdOcc_Class + fg p = fst . gamPartition (\k _ -> p k) + fm p = Map.filterWithKey (\k _ -> p k) + +{-# LINE 297 "src/ehc/HI.chs" #-} +-- | restrict envs to the ones being exported, so only the visible part remains +hiiRestrictToExported :: HIInfo -> HIInfo +hiiRestrictToExported hii = hiiRestrictToFilterMp (mentrelToFilterMp [] (hiiExps hii) `mentrelFilterMpUnion` mentrelToFilterMp [] (hiiHiddenExps hii)) hii + +{-# LINE 303 "src/ehc/HI.chs" #-} +-- | include the imported HIInfos in this one, restricted to their exports, to be done just before saving +hiiIncludeCacheOfImport :: (HsName -> HIInfo) -> ModEntRelFilterMp -> HIInfo -> HIInfo +hiiIncludeCacheOfImport imp mfm hii + = hii + { hiiImpHIMp = Map.map reset $ Map.unions [top, subtop] + } + where -- imports of this module + top = Map.unions [ Map.singleton i $ hiiRestrictToFilterMp mfm $ {- (\x -> tr "hiiIncludeCacheOfImport.1" (i >#< x) x) $ -} imp i | i <- Set.toList $ hiiHIDeclImpModS hii `Set.union` hiiHIUsedImpModS hii ] + + -- the closure of the imports w.r.t. import relationship + subtop = Map.map (hiiRestrictToFilterMp mfm) $ Map.unionsWith hiiUnion $ map hiiImpHIMp $ Map.elems top + + -- reset some info in cached hii's + reset hii = hii { hiiImpHIMp = Map.empty + , hiiExps = Rel.empty + , hiiHiddenExps = Rel.empty + , hiiHIDeclImpModS = Set.empty + , hiiHIUsedImpModS = Set.empty + , hiiCHRStore = emptyCHRStore -- this cannot be, but no solution for filtering this... + , hiiSrcSig = "" + , hiiCompiler = "" + , hiiSrcTimeStamp = "" + , hiiSrcVersionMajor = "" + , hiiSrcVersionMinor = "" + , hiiSrcVersionMinorMinor = "" + , hiiSrcVersionSvn = "" + } + +{-# LINE 339 "src/ehc/HI.chs" #-} +mentrelToIdDefOccGam :: HsName -> ModEntRel -> Gam IdOcc IdOcc -- IdDefOccGam +mentrelToIdDefOccGam modNm r + = gamFromAssocL + [ ( IdOcc n' k + -- , mkIdDefOcc (IdOcc (ioccNm $ mentIdOcc e) k) IdAsp_Any nmLevOutside emptyRange + , IdOcc (ioccNm $ mentIdOcc e) k + ) + | (n,e) <- Rel.toList r + , let k = ioccKind $ mentIdOcc e + n' = hsnSetQual modNm n + ] + +{-# LINE 357 "src/ehc/HI.chs" #-} +hiiIdDefOccGamToHIIdGam :: IdDefOccGam -> Gam IdOcc IdOcc +hiiIdDefOccGamToHIIdGam = gamMap (\(k,v) -> (k,doccOcc v)) + +hiiIdDefOccGamFromHIIdGam :: Gam IdOcc IdOcc -> IdDefOccGam +hiiIdDefOccGamFromHIIdGam = gamMap (\(k,v) -> (k,mkIdDefOcc v IdAsp_Any nmLevOutside emptyRange)) + +{-# LINE 369 "src/ehc/HI.chs" #-} +data HIOrigin + = HIOrigin_FromFile -- from .hi file + | HIOrigin_FromImportedBy HsNameS -- reconstructed from modules which imported this hi + deriving (Eq,Show,Typeable,Data) + +{-# LINE 376 "src/ehc/HI.chs" #-} +data HIValidity + = HIValidity_Ok -- ok + | HIValidity_WrongMagic -- wrong magic number + | HIValidity_Inconsistent -- inconsistent with compiler + | HIValidity_Absent -- not available + deriving (Eq,Enum,Show,Typeable,Data) + +{-# LINE 389 "src/ehc/HI.chs" #-} +gamFlatten :: Ord k => Gam k v -> Gam k v +gamFlatten = id -- gamFromAssocL . gamToAssocL + +{-# LINE 398 "src/ehc/HI.chs" #-} +instance Serialize HIValidity where + sput = sputEnum8 + sget = sgetEnum8 + +{-# LINE 404 "src/ehc/HI.chs" #-} +sgetHIInfo :: EHCOpts -> SGet HIInfo +sgetHIInfo opts = do + { hi_magic <- sequence $ replicate (length Cfg.magicNumberHI) sgetWord8 + ; if hi_magic == Cfg.magicNumberHI + then do { hi_sig <- sget + ; hi_ts <- sget + ; hi_iv <- sget + ; hi_t <- sget + ; hi_tv <- sget + ; hi_fl <- sget + ; hi_comp <- sget + ; if ( {- hi_sig == Sig.sig + && hi_ts == Sig.timestamp + && -} + hi_iv == hiiInternalVersions emptyHIInfo + && hi_t == ehcOptTarget opts + && hi_tv == ehcOptTargetFlavor opts + ) + || not (ehcOptHiValidityCheck opts) + then do { hi_nm <- sget + ; hi_hm <- sget + ; hi_m <- sget + ; hi_mm <- sget + ; hi_mmm <- sget + ; hi_svn <- sget + ; e <- sget + ; he <- sget + ; fg <- sget + ; impd <- sget + ; impu <- sget + ; tclused <- sget + ; tclorph <- sget + ; isorph <- sget + ; vg <- sget + ; tg <- sget + ; tkg <- sget + ; pg <- sget + ; dg <- sget + ; cg <- sget + ; cdg <- sget + ; cs <- sget + ; am <- sget + ; him <- sget + ; return + (emptyHIInfo + { hiiValidity = HIValidity_Ok + , hiiSrcSig = hi_sig + , hiiCompiler = hi_comp + , hiiCompileFlags = hi_fl + , hiiTarget = hi_t + , hiiTargetFlavor = hi_tv + , hiiHasMain = hi_hm + , hiiSrcTimeStamp = hi_ts + , hiiInternalVersions = hi_iv + , hiiModuleNm = hi_nm + , hiiSrcVersionMajor = hi_m + , hiiSrcVersionMinor = hi_mm + , hiiSrcVersionMinorMinor = hi_mmm + , hiiSrcVersionSvn = hi_svn + , hiiExps = e + , hiiHiddenExps = he + , hiiFixityGam = fg + , hiiHIDeclImpModS = impd + , hiiHIUsedImpModS = impu + , hiiTransClosedUsedModMp = tclused + , hiiTransClosedOrphanModS= tclorph + , hiiMbOrphan = isorph + , hiiValGam = vg + , hiiTyGam = tg + , hiiTyKiGam = tkg + , hiiPolGam = pg + , hiiDataGam = dg + , hiiClGam = cg + , hiiClDfGam = cdg + , hiiCHRStore = cs + , hiiLamMp = am + , hiiImpHIMp = him + }) + } + else return $ + emptyHIInfo + { hiiValidity = HIValidity_Inconsistent + , hiiSrcSig = hi_sig + , hiiSrcTimeStamp = hi_ts + , hiiInternalVersions = hi_iv + , hiiCompileFlags = hi_fl + , hiiCompiler = hi_comp + , hiiTarget = hi_t + , hiiTargetFlavor = hi_tv + } + } + else return $ + emptyHIInfo + { hiiValidity = HIValidity_WrongMagic + } + } + +{-# LINE 527 "src/ehc/HI.chs" #-} +instance Serialize HIInfo where + sput (HIInfo + { hiiSrcSig = hi_sig + , hiiTarget = hi_t + , hiiTargetFlavor = hi_tv + , hiiCompiler = hi_comp + , hiiCompileFlags = hi_fl + , hiiModuleNm = hi_nm + , hiiHasMain = hi_hm + , hiiSrcTimeStamp = hi_ts + , hiiInternalVersions = hi_iv + , hiiSrcVersionMajor = hi_m + , hiiSrcVersionMinor = hi_mm + , hiiSrcVersionMinorMinor = hi_mmm + , hiiSrcVersionSvn = hi_svn + , hiiExps = e + , hiiHiddenExps = he + , hiiFixityGam = fg + , hiiHIDeclImpModS = impd + , hiiHIUsedImpModS = impu + , hiiTransClosedUsedModMp = tclused + , hiiTransClosedOrphanModS= tclorph + , hiiMbOrphan = isorph + , hiiValGam = vg + , hiiTyGam = tg + , hiiTyKiGam = tkg + , hiiPolGam = pg + , hiiDataGam = dg + , hiiClGam = cg + , hiiClDfGam = cdg + , hiiCHRStore = cs + , hiiLamMp = am + , hiiImpHIMp = him + }) + = mapM sputWord8 Cfg.magicNumberHI + >> sput hi_sig + >> sput hi_ts + >> sput hi_iv + >> sput hi_t + >> sput hi_tv + >> sput hi_fl + >> sput hi_comp + >> sput hi_nm + >> sput hi_hm + >> sput hi_m + >> sput hi_mm + >> sput hi_mmm + >> sput hi_svn + >> sput e + >> sput he + >> sput (gamFlatten fg) + >> sput impd + >> sput impu + >> sput tclused + >> sput tclorph + >> sput isorph + >> sput (gamFlatten vg) + >> sput (gamFlatten tg) + >> sput (gamFlatten tkg) + >> sput (gamFlatten pg) + >> sput (gamFlatten dg) + >> sput (gamFlatten cg) + >> sput (gamFlatten cdg) + >> sput cs + >> sput am + >> sput him + + sget = sgetHIInfo (defaultEHCOpts + { ehcOptHiValidityCheck = False + } + ) + diff --git a/src/UHC/Light/Compiler/HS.hs b/src/UHC/Light/Compiler/HS.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/HS.hs @@ -0,0 +1,392 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/HS.ag) +module UHC.Light.Compiler.HS(module UU.Scanner.Position +, AGItf (..), Module (..), Body (..), Declaration (..), Declarations, MaybeDeclarations, Type (..), Types, MaybeType, Expression (..), Expressions, MaybeExpression, FunctionBinding (..), FunctionBindings, LeftHandSide (..), RightHandSide (..), Pattern (..), Patterns, Literal (..), Name, Names, MaybeName, MaybeNames, Strings, Range (..), Fixity (..) +, TypeAnnotation (..), ExpressionAnnotation (..), PatternAnnotation (..) +, mkRngNm, mkRngNm', mkRngStr +, TypeLeftHandSide (..), TypePattern (..), TypePatterns +, Constructor (..), Constructors +, GuardedExpression (..), GuardedExpressions, Alternative (..), Alternatives, Qualifier (..), Qualifiers +, Kind (..), Kinds, KindAnnotation (..) +, FieldDeclaration (..), FieldDeclarations +, RecordPatternBinding (..), RecordPatternBindings +, RecordExpressionBinding (..), RecordExpressionBindings +, RowRecordExpressionUpdate (..), RowRecordExpressionUpdates, RowRecordPatternBinding (..), RowRecordPatternBindings, RowTypeUpdate (..), RowTypeUpdates +, module UHC.Light.Compiler.Base.Target +, ContextItem (..), ContextItems +, Statement (..), Statements +, ContextedExpression (..), ContextedExpressions, ContextedPattern (..), ContextedPatterns +, FunctionalDependency (..), FunctionalDependencies +, Export (..), Exports, MaybeExports, ImportDeclaration (..), ImportDeclarations, ImportSpecification (..), MaybeImportSpecification, Import (..), Imports +, Deriving (..), Derivings +, Pragma (..), Pragmas) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UU.Scanner.Position +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Token +import UHC.Light.Compiler.Base.Target (FFIWay) + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +type Name = HsName +type Names = [Name] +type MaybeName = Maybe Name +type MaybeNames = Maybe Names + + + + + +mkRngNm' :: (Position t,HSNM t) => (Range -> HsName -> r) -> t -> (r,Range) +mkRngNm' ast t + = (ast r (mkHNm t),r) + where r = mkRange1 t + +mkRngNm :: (Position t,HSNM t) => (Range -> HsName -> r) -> t -> r +mkRngNm ast t = fst (mkRngNm' ast t) + +mkRngStr :: (Range -> String -> r) -> Token -> r +mkRngStr ast t = ast (mkRange1 t) (tokMkStr t) + + + + + +instance AppLike Type () {- TypeAnnotation () -} where + app1App = \e1 e2 -> Type_NormalApplication emptyRange e1 [e2] + appTop = id + appCon = mkRngNm Type_Constructor + appPar = Type_Parenthesized emptyRange + appTopApp (a:as) = if null as then a else Type_NormalApplication emptyRange a as + appRngCon r n = Type_Constructor r (mkHNm n) + + + appRngVar r n = Type_Variable r (mkHNm n) + + + +instance AppLike Expression () {- ExpressionAnnotation () -} where + app1App = \e1 e2 -> Expression_NormalApplication emptyRange e1 [e2] + appTop = id + appCon = mkRngNm Expression_Constructor + appPar = Expression_Parenthesized emptyRange + appTopApp (a:as) = if null as then a else Expression_NormalApplication emptyRange a as + appRngCon r n = Expression_Constructor r (mkHNm n) + appRngVar r n = Expression_Variable r (mkHNm n) + +-- AGItf ------------------------------------------------------- +data AGItf = AGItf_AGItf {module_AGItf_AGItf :: !(Module)} +-- Alternative ------------------------------------------------- +data Alternative = Alternative_Alternative {range_Alternative_Alternative :: !(Range),pattern_Alternative_Alternative :: !(Pattern),righthandside_Alternative_Alternative :: !(RightHandSide)} + | Alternative_Empty {range_Alternative_Empty :: !(Range)} +-- Alternatives ------------------------------------------------ +type Alternatives = [Alternative] +-- Body -------------------------------------------------------- +data Body = Body_Body {range_Body_Body :: !(Range),importdeclarations_Body_Body :: !(ImportDeclarations),declarations_Body_Body :: !(Declarations)} +-- Constructor ------------------------------------------------- +data Constructor = Constructor_Constructor {range_Constructor_Constructor :: !(Range),constructor_Constructor_Constructor :: !(Name),types_Constructor_Constructor :: !(Types)} + | Constructor_Infix {range_Constructor_Infix :: !(Range),leftType_Constructor_Infix :: !(Type),constructorOperator_Constructor_Infix :: !(Name),rightType_Constructor_Infix :: !(Type)} + | Constructor_Record {range_Constructor_Record :: !(Range),constructor_Constructor_Record :: !(Name),fieldDeclarations_Constructor_Record :: !(FieldDeclarations)} + | Constructor_Contexted {range_Constructor_Contexted :: !(Range),context_Constructor_Contexted :: !(ContextItems),constructor_Constructor_Contexted :: !(Constructor)} + | Constructor_GADTFunction {range_Constructor_GADTFunction :: !(Range),constructor_Constructor_GADTFunction :: !(Name),type_Constructor_GADTFunction :: !(Type)} +-- Constructors ------------------------------------------------ +type Constructors = [Constructor] +-- ContextItem ------------------------------------------------- +data ContextItem = ContextItem_Class {range_ContextItem_Class :: !(Range),name_ContextItem_Class :: !(Name),types_ContextItem_Class :: !(Types)} + | ContextItem_Forall {range_ContextItem_Forall :: !(Range),typevariables_ContextItem_Forall :: !(Names),context_ContextItem_Forall :: !(ContextItem)} + | ContextItem_Arrow {range_ContextItem_Arrow :: !(Range),argument_ContextItem_Arrow :: !(ContextItem),result_ContextItem_Arrow :: !(ContextItem)} + | ContextItem_Implicits {range_ContextItem_Implicits :: !(Range)} + | ContextItem_NoImplicits {range_ContextItem_NoImplicits :: !(Range)} + | ContextItem_RowLacksLabel {range_ContextItem_RowLacksLabel :: !(Range),rowvariable_ContextItem_RowLacksLabel :: !(Name),name_ContextItem_RowLacksLabel :: !(Name)} + | ContextItem_Equal {range_ContextItem_Equal :: !(Range),type1_ContextItem_Equal :: !(Type),type2_ContextItem_Equal :: !(Type)} +-- ContextItems ------------------------------------------------ +type ContextItems = [ContextItem] +-- ContextedExpression ----------------------------------------- +data ContextedExpression = ContextedExpression_Contexted {range_ContextedExpression_Contexted :: !(Range),expression_ContextedExpression_Contexted :: !(Expression),context_ContextedExpression_Contexted :: !(ContextItem)} +-- ContextedExpressions ---------------------------------------- +type ContextedExpressions = [ContextedExpression] +-- ContextedPattern -------------------------------------------- +data ContextedPattern = ContextedPattern_Contexted {range_ContextedPattern_Contexted :: !(Range),pattern_ContextedPattern_Contexted :: !(Pattern),context_ContextedPattern_Contexted :: !(ContextItem)} +-- ContextedPatterns ------------------------------------------- +type ContextedPatterns = [ContextedPattern] +-- Declaration ------------------------------------------------- +data Declaration = Declaration_FunctionBindings {range_Declaration_FunctionBindings :: !(Range),bindings_Declaration_FunctionBindings :: !(FunctionBindings)} + | Declaration_PatternBinding {range_Declaration_PatternBinding :: !(Range),pattern_Declaration_PatternBinding :: !(Pattern),righthandside_Declaration_PatternBinding :: !(RightHandSide)} + | Declaration_TypeSignature {range_Declaration_TypeSignature :: !(Range),names_Declaration_TypeSignature :: !(Names),type_Declaration_TypeSignature :: !(Type)} + | Declaration_Fixity {range_Declaration_Fixity :: !(Range),fixity_Declaration_Fixity :: !(Fixity),priority_Declaration_Fixity :: !((Maybe Int)),operators_Declaration_Fixity :: !(Names)} + | Declaration_FusionDeclaration {range_Declaration_FusionDeclaration :: !(Range),fusename_Declaration_FusionDeclaration :: !(Name)} + | Declaration_FusionConversion {range_Declaration_FusionConversion :: !(Range),absname_Declaration_FusionConversion :: !(Name),conname_Declaration_FusionConversion :: !(Name)} + | Declaration_Empty {range_Declaration_Empty :: !(Range)} + | Declaration_Data {range_Declaration_Data :: !(Range),context_Declaration_Data :: !(ContextItems),typelefthandside_Declaration_Data :: !(TypeLeftHandSide),constructors_Declaration_Data :: !(Constructors),derivings_Declaration_Data :: !(Derivings)} + | Declaration_Newtype {range_Declaration_Newtype :: !(Range),context_Declaration_Newtype :: !(ContextItems),typelefthandside_Declaration_Newtype :: !(TypeLeftHandSide),constructors_Declaration_Newtype :: !(Constructor),derivings_Declaration_Newtype :: !(Derivings)} + | Declaration_GADT {range_Declaration_GADT :: !(Range),context_Declaration_GADT :: !(ContextItems),typelefthandside_Declaration_GADT :: !(TypeLeftHandSide),constructors_Declaration_GADT :: !(Constructors),derivings_Declaration_GADT :: !(Derivings)} + | Declaration_KindSignature {range_Declaration_KindSignature :: !(Range),names_Declaration_KindSignature :: !(Names),kind_Declaration_KindSignature :: !(Kind)} + | Declaration_ForeignImport {range_Declaration_ForeignImport :: !(Range),callconvention_Declaration_ForeignImport :: !(FFIWay),safety_Declaration_ForeignImport :: !((Maybe String)),importname_Declaration_ForeignImport :: !((Maybe String)),name_Declaration_ForeignImport :: !(Name),type_Declaration_ForeignImport :: !(Type)} + | Declaration_ForeignExport {range_Declaration_ForeignExport :: !(Range),callconvention_Declaration_ForeignExport :: !(FFIWay),exportname_Declaration_ForeignExport :: !((Maybe String)),name_Declaration_ForeignExport :: !(Name),type_Declaration_ForeignExport :: !(Type)} + | Declaration_Class {range_Declaration_Class :: !(Range),context_Declaration_Class :: !(ContextItems),typelefthandside_Declaration_Class :: !(TypeLeftHandSide),dependencies_Declaration_Class :: !(FunctionalDependencies),where_Declaration_Class :: !(MaybeDeclarations)} + | Declaration_Instance {range_Declaration_Instance :: !(Range),instVariant_Declaration_Instance :: !(InstVariant),maybeinstancename_Declaration_Instance :: !(MaybeName),useimplicitly_Declaration_Instance :: !(Bool),context_Declaration_Instance :: !(ContextItems),type_Declaration_Instance :: !(Type),where_Declaration_Instance :: !(MaybeDeclarations)} + | Declaration_InstanceUseImplicitly {range_Declaration_InstanceUseImplicitly :: !(Range),expression_Declaration_InstanceUseImplicitly :: !(Expression),name_Declaration_InstanceUseImplicitly :: !(Name),types_Declaration_InstanceUseImplicitly :: !(Types)} + | Declaration_Default {range_Declaration_Default :: !(Range),name_Declaration_Default :: !(MaybeName),types_Declaration_Default :: !(Types)} + | Declaration_Type {range_Declaration_Type :: !(Range),typelefthandside_Declaration_Type :: !(TypeLeftHandSide),type_Declaration_Type :: !(Type)} + | Declaration_Pragma {range_Declaration_Pragma :: !(Range),pragma_Declaration_Pragma :: !(Pragma)} + | Declaration_Module {range_Declaration_Module :: !(Range),name_Declaration_Module :: !(MaybeName),exports_Declaration_Module :: !(MaybeExports)} +-- Declarations ------------------------------------------------ +type Declarations = [Declaration] +-- Deriving ---------------------------------------------------- +data Deriving = Deriving_Deriving {range_Deriving_Deriving :: !(Range),maybeinstancename_Deriving_Deriving :: !(MaybeName),useimplicitly_Deriving_Deriving :: !(Bool),name_Deriving_Deriving :: !(Name)} +-- Derivings --------------------------------------------------- +type Derivings = [Deriving] +-- Export ------------------------------------------------------ +data Export = Export_Variable {range_Export_Variable :: !(Range),name_Export_Variable :: !(Name)} + | Export_TypeOrClass {range_Export_TypeOrClass :: !(Range),name_Export_TypeOrClass :: !(Name),names_Export_TypeOrClass :: !(MaybeNames)} + | Export_TypeOrClassComplete {range_Export_TypeOrClassComplete :: !(Range),name_Export_TypeOrClassComplete :: !(Name)} + | Export_Module {range_Export_Module :: !(Range),name_Export_Module :: !(Name)} +-- Exports ----------------------------------------------------- +type Exports = [Export] +-- Expression -------------------------------------------------- +data Expression = Expression_Literal {range_Expression_Literal :: !(Range),literal_Expression_Literal :: !(Literal)} + | Expression_Variable {range_Expression_Variable :: !(Range),name_Expression_Variable :: !(Name)} + | Expression_Constructor {range_Expression_Constructor :: !(Range),name_Expression_Constructor :: !(Name)} + | Expression_TupleConstructor {range_Expression_TupleConstructor :: !(Range),arity_Expression_TupleConstructor :: !(Int)} + | Expression_Parenthesized {range_Expression_Parenthesized :: !(Range),expression_Expression_Parenthesized :: !(Expression)} + | Expression_NormalApplication {range_Expression_NormalApplication :: !(Range),function_Expression_NormalApplication :: !(Expression),arguments_Expression_NormalApplication :: !(Expressions)} + | Expression_SectionApplication {range_Expression_SectionApplication :: !(Range),leftExpression_Expression_SectionApplication :: !(MaybeExpression),operator_Expression_SectionApplication :: !(Expression),rightExpression_Expression_SectionApplication :: !(MaybeExpression)} + | Expression_InfixApplication {range_Expression_InfixApplication :: !(Range),leftExpression_Expression_InfixApplication :: !(Expression),operator_Expression_InfixApplication :: !(Expression),rightExpression_Expression_InfixApplication :: !(Expression)} + | Expression_InfixApplicationChainTop {range_Expression_InfixApplicationChainTop :: !(Range),expression_Expression_InfixApplicationChainTop :: !(Expression)} + | Expression_Lambda {range_Expression_Lambda :: !(Range),patterns_Expression_Lambda :: !(Patterns),expression_Expression_Lambda :: !(Expression)} + | Expression_Let {range_Expression_Let :: !(Range),isStrict_Expression_Let :: !(Bool),declarations_Expression_Let :: !(Declarations),expression_Expression_Let :: !(Expression)} + | Expression_Tuple {range_Expression_Tuple :: !(Range),expressions_Expression_Tuple :: !(Expressions)} + | Expression_Typed {range_Expression_Typed :: !(Range),expression_Expression_Typed :: !(Expression),type_Expression_Typed :: !(Type)} + | Expression_Negate {range_Expression_Negate :: !(Range),expression_Expression_Negate :: !(Expression)} + | Expression_Annotate {range_Expression_Annotate :: !(Range),annotation_Expression_Annotate :: !(ExpressionAnnotation),expression_Expression_Annotate :: !(Expression)} + | Expression_ImpredicativeApplication {range_Expression_ImpredicativeApplication :: !(Range),function_Expression_ImpredicativeApplication :: !(Expression),arguments_Expression_ImpredicativeApplication :: !(Expressions)} + | Expression_If {range_Expression_If :: !(Range),guardExpression_Expression_If :: !(Expression),thenExpression_Expression_If :: !(Expression),elseExpression_Expression_If :: !(Expression)} + | Expression_Case {range_Expression_Case :: !(Range),expression_Expression_Case :: !(Expression),alternatives_Expression_Case :: !(Alternatives)} + | Expression_List {range_Expression_List :: !(Range),expressions_Expression_List :: !(Expressions)} + | Expression_Enum {range_Expression_Enum :: !(Range),from_Expression_Enum :: !(Expression),then_Expression_Enum :: !(MaybeExpression),to_Expression_Enum :: !(MaybeExpression)} + | Expression_Comprehension {range_Expression_Comprehension :: !(Range),expression_Expression_Comprehension :: !(Expression),qualifiers_Expression_Comprehension :: !(Qualifiers)} + | Expression_RecordConstruction {range_Expression_RecordConstruction :: !(Range),name_Expression_RecordConstruction :: !(Name),recordExpressionBindings_Expression_RecordConstruction :: !(RecordExpressionBindings)} + | Expression_RecordUpdate {range_Expression_RecordUpdate :: !(Range),expression_Expression_RecordUpdate :: !(Expression),recordExpressionBindings_Expression_RecordUpdate :: !(RecordExpressionBindings)} + | Expression_RowRecordUpdate {range_Expression_RowRecordUpdate :: !(Range),expression_Expression_RowRecordUpdate :: !(Expression),rowRecordExpressionUpdates_Expression_RowRecordUpdate :: !(RowRecordExpressionUpdates)} + | Expression_RowRecordEmpty {range_Expression_RowRecordEmpty :: !(Range)} + | Expression_RowRecordSelect {range_Expression_RowRecordSelect :: !(Range),expression_Expression_RowRecordSelect :: !(Expression),name_Expression_RowRecordSelect :: !(Name)} + | Expression_Do {range_Expression_Do :: !(Range),statements_Expression_Do :: !(Statements)} + | Expression_ImplicitApplication {range_Expression_ImplicitApplication :: !(Range),function_Expression_ImplicitApplication :: !(Expression),arguments_Expression_ImplicitApplication :: !(ContextedExpressions)} + | Expression_ImplicitLambda {range_Expression_ImplicitLambda :: !(Range),patterns_Expression_ImplicitLambda :: !(ContextedPatterns),expression_Expression_ImplicitLambda :: !(Expression)} +-- ExpressionAnnotation ---------------------------------------- +data ExpressionAnnotation = ExpressionAnnotation_Empty {} +-- Expressions ------------------------------------------------- +type Expressions = [Expression] +-- FieldDeclaration -------------------------------------------- +data FieldDeclaration = FieldDeclaration_FieldDeclaration {range_FieldDeclaration_FieldDeclaration :: !(Range),names_FieldDeclaration_FieldDeclaration :: !(Names),type_FieldDeclaration_FieldDeclaration :: !(Type)} +-- FieldDeclarations ------------------------------------------- +type FieldDeclarations = [FieldDeclaration] +-- FunctionBinding --------------------------------------------- +data FunctionBinding = FunctionBinding_FunctionBinding {range_FunctionBinding_FunctionBinding :: !(Range),lefthandside_FunctionBinding_FunctionBinding :: !(LeftHandSide),righthandside_FunctionBinding_FunctionBinding :: !(RightHandSide)} +-- FunctionBindings -------------------------------------------- +type FunctionBindings = [FunctionBinding] +-- FunctionalDependencies -------------------------------------- +type FunctionalDependencies = [FunctionalDependency] +-- FunctionalDependency ---------------------------------------- +data FunctionalDependency = FunctionalDependency_Dependency {range_FunctionalDependency_Dependency :: !(Range),fromtypevariables_FunctionalDependency_Dependency :: !(Names),totypevariables_FunctionalDependency_Dependency :: !(Names)} +-- GuardedExpression ------------------------------------------- +data GuardedExpression = GuardedExpression_GuardedExpression {range_GuardedExpression_GuardedExpression :: !(Range),guard_GuardedExpression_GuardedExpression :: !(Expression),expression_GuardedExpression_GuardedExpression :: !(Expression)} +-- GuardedExpressions ------------------------------------------ +type GuardedExpressions = [GuardedExpression] +-- Import ------------------------------------------------------ +data Import = Import_Variable {range_Import_Variable :: !(Range),name_Import_Variable :: !(Name)} + | Import_TypeOrClass {range_Import_TypeOrClass :: !(Range),name_Import_TypeOrClass :: !(Name),names_Import_TypeOrClass :: !(MaybeNames)} + | Import_TypeOrClassComplete {range_Import_TypeOrClassComplete :: !(Range),name_Import_TypeOrClassComplete :: !(Name)} +-- ImportDeclaration ------------------------------------------- +data ImportDeclaration = ImportDeclaration_Import {range_ImportDeclaration_Import :: !(Range),qualified_ImportDeclaration_Import :: !(Bool),name_ImportDeclaration_Import :: !(Name),asname_ImportDeclaration_Import :: !(MaybeName),importspecification_ImportDeclaration_Import :: !(MaybeImportSpecification)} + | ImportDeclaration_Empty {range_ImportDeclaration_Empty :: !(Range)} +-- ImportDeclarations ------------------------------------------ +type ImportDeclarations = [ImportDeclaration] +-- ImportSpecification ----------------------------------------- +data ImportSpecification = ImportSpecification_Import {range_ImportSpecification_Import :: !(Range),hiding_ImportSpecification_Import :: !(Bool),imports_ImportSpecification_Import :: !(Imports)} +-- Imports ----------------------------------------------------- +type Imports = [Import] +-- Kind -------------------------------------------------------- +data Kind = Kind_NormalApplication {range_Kind_NormalApplication :: !(Range),function_Kind_NormalApplication :: !(Kind),arguments_Kind_NormalApplication :: !(Kinds)} + | Kind_InfixApplication {range_Kind_InfixApplication :: !(Range),leftKind_Kind_InfixApplication :: !(Kind),operator_Kind_InfixApplication :: !(Kind),rightKind_Kind_InfixApplication :: !(Kind)} + | Kind_Constructor {range_Kind_Constructor :: !(Range),name_Kind_Constructor :: !(Name)} + | Kind_Parenthesized {range_Kind_Parenthesized :: !(Range),kind_Kind_Parenthesized :: !(Kind)} + | Kind_Variable {range_Kind_Variable :: !(Range),name_Kind_Variable :: !(Name)} + | Kind_Forall {range_Kind_Forall :: !(Range),kindvariables_Kind_Forall :: !(Names),kind_Kind_Forall :: !(Kind)} + | Kind_Annotate {range_Kind_Annotate :: !(Range),annotation_Kind_Annotate :: !(KindAnnotation),kind_Kind_Annotate :: !(Kind)} +-- KindAnnotation ---------------------------------------------- +data KindAnnotation = KindAnnotation_Empty {} +-- Kinds ------------------------------------------------------- +type Kinds = [Kind] +-- LeftHandSide ------------------------------------------------ +data LeftHandSide = LeftHandSide_Function {range_LeftHandSide_Function :: !(Range),name_LeftHandSide_Function :: !(Name),patterns_LeftHandSide_Function :: !(Patterns)} + | LeftHandSide_Infix {range_LeftHandSide_Infix :: !(Range),leftPattern_LeftHandSide_Infix :: !(Pattern),operator_LeftHandSide_Infix :: !(Name),rightPattern_LeftHandSide_Infix :: !(Pattern)} + | LeftHandSide_Parenthesized {range_LeftHandSide_Parenthesized :: !(Range),lefthandside_LeftHandSide_Parenthesized :: !(LeftHandSide),patterns_LeftHandSide_Parenthesized :: !(Patterns)} + | LeftHandSide_Typed {range_LeftHandSide_Typed :: !(Range),lefthandside_LeftHandSide_Typed :: !(LeftHandSide),type_LeftHandSide_Typed :: !(Type)} +-- Literal ----------------------------------------------------- +data Literal = Literal_Int {range_Literal_Int :: !(Range),base_Literal_Int :: !(Int),value_Literal_Int :: !(String)} + | Literal_Char {range_Literal_Char :: !(Range),value_Literal_Char :: !(String)} + | Literal_String {range_Literal_String :: !(Range),value_Literal_String :: !(String)} + | Literal_Float {range_Literal_Float :: !(Range),value_Literal_Float :: !(String)} +-- MaybeDeclarations ------------------------------------------- +type MaybeDeclarations = Maybe (Declarations) +-- MaybeExports ------------------------------------------------ +type MaybeExports = Maybe (Exports) +-- MaybeExpression --------------------------------------------- +type MaybeExpression = Maybe (Expression) +-- MaybeImportSpecification ------------------------------------ +type MaybeImportSpecification = Maybe (ImportSpecification) +-- MaybeType --------------------------------------------------- +type MaybeType = Maybe (Type) +-- Module ------------------------------------------------------ +data Module = Module_Module {range_Module_Module :: !(Range),name_Module_Module :: !(MaybeName),fileheaderpragmas_Module_Module :: !(Pragmas),exports_Module_Module :: !(MaybeExports),body_Module_Module :: !(Body)} +-- Pattern ----------------------------------------------------- +data Pattern = Pattern_Literal {range_Pattern_Literal :: !(Range),sign_Pattern_Literal :: !(Int),literal_Pattern_Literal :: !(Literal)} + | Pattern_Variable {range_Pattern_Variable :: !(Range),name_Pattern_Variable :: !(Name)} + | Pattern_Constructor {range_Pattern_Constructor :: !(Range),name_Pattern_Constructor :: !(Name),patterns_Pattern_Constructor :: !(Patterns)} + | Pattern_Parenthesized {range_Pattern_Parenthesized :: !(Range),pattern_Pattern_Parenthesized :: !(Pattern)} + | Pattern_As {range_Pattern_As :: !(Range),name_Pattern_As :: !(Name),pattern_Pattern_As :: !(Pattern)} + | Pattern_Wildcard {range_Pattern_Wildcard :: !(Range)} + | Pattern_Tuple {range_Pattern_Tuple :: !(Range),arity_Pattern_Tuple :: !(Int),patterns_Pattern_Tuple :: !(Patterns)} + | Pattern_Annotate {range_Pattern_Annotate :: !(Range),annotation_Pattern_Annotate :: !(PatternAnnotation),pattern_Pattern_Annotate :: !(Pattern)} + | Pattern_Typed {range_Pattern_Typed :: !(Range),pattern_Pattern_Typed :: !(Pattern),type_Pattern_Typed :: !(Type)} + | Pattern_InfixConstructor {range_Pattern_InfixConstructor :: !(Range),leftPattern_Pattern_InfixConstructor :: !(Pattern),constructorOperator_Pattern_InfixConstructor :: !(Name),rightPattern_Pattern_InfixConstructor :: !(Pattern)} + | Pattern_List {range_Pattern_List :: !(Range),patterns_Pattern_List :: !(Patterns)} + | Pattern_Record {range_Pattern_Record :: !(Range),name_Pattern_Record :: !(Name),recordPatternBindings_Pattern_Record :: !(RecordPatternBindings)} + | Pattern_RowRecordBinding {range_Pattern_RowRecordBinding :: !(Range),pattern_Pattern_RowRecordBinding :: !(Pattern),rowRecordPattternBindings_Pattern_RowRecordBinding :: !(RowRecordPatternBindings)} + | Pattern_RowRecordEmpty {range_Pattern_RowRecordEmpty :: !(Range)} + | Pattern_Irrefutable {range_Pattern_Irrefutable :: !(Range),pattern_Pattern_Irrefutable :: !(Pattern)} + | Pattern_Bang {range_Pattern_Bang :: !(Range),pattern_Pattern_Bang :: !(Pattern)} +-- PatternAnnotation ------------------------------------------- +data PatternAnnotation = PatternAnnotation_Empty {} +-- Patterns ---------------------------------------------------- +type Patterns = [Pattern] +-- Pragma ------------------------------------------------------ +data Pragma = Pragma_Language {range_Pragma_Language :: !(Range),pragmas_Pragma_Language :: !(Names)} + | Pragma_OptionsUHC {range_Pragma_OptionsUHC :: !(Range),options_Pragma_OptionsUHC :: !(String)} + | Pragma_Derivable {range_Pragma_Derivable :: !(Range),className_Pragma_Derivable :: !(Name),fieldName_Pragma_Derivable :: !(Name),defaultName_Pragma_Derivable :: !(Name)} + | Pragma_ExcludeIfTarget {range_Pragma_ExcludeIfTarget :: !(Range),targetNames_Pragma_ExcludeIfTarget :: !(([String]))} +-- Pragmas ----------------------------------------------------- +type Pragmas = [Pragma] +-- Qualifier --------------------------------------------------- +data Qualifier = Qualifier_Guard {range_Qualifier_Guard :: !(Range),guard_Qualifier_Guard :: !(Expression)} + | Qualifier_Let {range_Qualifier_Let :: !(Range),declarations_Qualifier_Let :: !(Declarations)} + | Qualifier_Generator {range_Qualifier_Generator :: !(Range),pattern_Qualifier_Generator :: !(Pattern),expression_Qualifier_Generator :: !(Expression)} + | Qualifier_Empty {range_Qualifier_Empty :: !(Range)} +-- Qualifiers -------------------------------------------------- +type Qualifiers = [Qualifier] +-- RecordExpressionBinding ------------------------------------- +data RecordExpressionBinding = RecordExpressionBinding_Binding {range_RecordExpressionBinding_Binding :: !(Range),name_RecordExpressionBinding_Binding :: !(Name),expression_RecordExpressionBinding_Binding :: !(Expression)} +-- RecordExpressionBindings ------------------------------------ +type RecordExpressionBindings = [RecordExpressionBinding] +-- RecordPatternBinding ---------------------------------------- +data RecordPatternBinding = RecordPatternBinding_Binding {range_RecordPatternBinding_Binding :: !(Range),name_RecordPatternBinding_Binding :: !(Name),pattern_RecordPatternBinding_Binding :: !(Pattern)} + | RecordPatternBinding_Pun {range_RecordPatternBinding_Pun :: !(Range),name_RecordPatternBinding_Pun :: !(Name)} +-- RecordPatternBindings --------------------------------------- +type RecordPatternBindings = [RecordPatternBinding] +-- RightHandSide ----------------------------------------------- +data RightHandSide = RightHandSide_Expression {range_RightHandSide_Expression :: !(Range),expression_RightHandSide_Expression :: !(Expression),where_RightHandSide_Expression :: !(MaybeDeclarations)} + | RightHandSide_Guarded {range_RightHandSide_Guarded :: !(Range),guardedexpressions_RightHandSide_Guarded :: !(GuardedExpressions),where_RightHandSide_Guarded :: !(MaybeDeclarations)} +-- RowRecordExpressionUpdate ----------------------------------- +data RowRecordExpressionUpdate = RowRecordExpressionUpdate_Update {range_RowRecordExpressionUpdate_Update :: !(Range),name_RowRecordExpressionUpdate_Update :: !(Name),expression_RowRecordExpressionUpdate_Update :: !(Expression)} + | RowRecordExpressionUpdate_Extends {range_RowRecordExpressionUpdate_Extends :: !(Range),name_RowRecordExpressionUpdate_Extends :: !(MaybeName),expression_RowRecordExpressionUpdate_Extends :: !(Expression)} +-- RowRecordExpressionUpdates ---------------------------------- +type RowRecordExpressionUpdates = [RowRecordExpressionUpdate] +-- RowRecordPatternBinding ------------------------------------- +data RowRecordPatternBinding = RowRecordPatternBinding_Binding {range_RowRecordPatternBinding_Binding :: !(Range),name_RowRecordPatternBinding_Binding :: !(MaybeName),pattern_RowRecordPatternBinding_Binding :: !(Pattern)} +-- RowRecordPatternBindings ------------------------------------ +type RowRecordPatternBindings = [RowRecordPatternBinding] +-- RowTypeUpdate ----------------------------------------------- +data RowTypeUpdate = RowTypeUpdate_Extends {range_RowTypeUpdate_Extends :: !(Range),name_RowTypeUpdate_Extends :: !(MaybeName),type_RowTypeUpdate_Extends :: !(Type)} +-- RowTypeUpdates ---------------------------------------------- +type RowTypeUpdates = [RowTypeUpdate] +-- Statement --------------------------------------------------- +data Statement = Statement_Expression {range_Statement_Expression :: !(Range),expression_Statement_Expression :: !(Expression)} + | Statement_Let {range_Statement_Let :: !(Range),declarations_Statement_Let :: !(Declarations)} + | Statement_Generator {range_Statement_Generator :: !(Range),pattern_Statement_Generator :: !(Pattern),expression_Statement_Generator :: !(Expression)} + | Statement_Empty {range_Statement_Empty :: !(Range)} +-- Statements -------------------------------------------------- +type Statements = [Statement] +-- Strings ----------------------------------------------------- +type Strings = [(String)] +-- Type -------------------------------------------------------- +data Type = Type_NormalApplication {range_Type_NormalApplication :: !(Range),function_Type_NormalApplication :: !(Type),arguments_Type_NormalApplication :: !(Types)} + | Type_InfixApplication {range_Type_InfixApplication :: !(Range),leftType_Type_InfixApplication :: !(Type),operator_Type_InfixApplication :: !(Type),rightType_Type_InfixApplication :: !(Type)} + | Type_InfixApplicationChainTop {range_Type_InfixApplicationChainTop :: !(Range),type_Type_InfixApplicationChainTop :: !(Type)} + | Type_Constructor {range_Type_Constructor :: !(Range),name_Type_Constructor :: !(Name)} + | Type_Parenthesized {range_Type_Parenthesized :: !(Range),type_Type_Parenthesized :: !(Type)} + | Type_SectionApplication {range_Type_SectionApplication :: !(Range),leftType_Type_SectionApplication :: !(MaybeType),operator_Type_SectionApplication :: !(Type),rightType_Type_SectionApplication :: !(MaybeType)} + | Type_Annotate {range_Type_Annotate :: !(Range),annotation_Type_Annotate :: !(TypeAnnotation),type_Type_Annotate :: !(Type)} + | Type_Wildcard {range_Type_Wildcard :: !(Range)} + | Type_MonoWildcard {range_Type_MonoWildcard :: !(Range)} + | Type_Variable {range_Type_Variable :: !(Range),name_Type_Variable :: !(Name)} + | Type_NamedWildcard {range_Type_NamedWildcard :: !(Range),name_Type_NamedWildcard :: !(Name)} + | Type_Forall {range_Type_Forall :: !(Range),typevariables_Type_Forall :: !(Names),type_Type_Forall :: !(Type)} + | Type_Exists {range_Type_Exists :: !(Range),typevariables_Type_Exists :: !(Names),type_Type_Exists :: !(Type)} + | Type_RowUpdate {range_Type_RowUpdate :: !(Range),type_Type_RowUpdate :: !(Type),rowTypeUpdates_Type_RowUpdate :: !(RowTypeUpdates)} + | Type_RowEmpty {range_Type_RowEmpty :: !(Range)} + | Type_RowRecUpdate {range_Type_RowRecUpdate :: !(Range),type_Type_RowRecUpdate :: !(Type),rowTypeUpdates_Type_RowRecUpdate :: !(RowTypeUpdates)} + | Type_RowRecEmpty {range_Type_RowRecEmpty :: !(Range)} + | Type_RowSumUpdate {range_Type_RowSumUpdate :: !(Range),type_Type_RowSumUpdate :: !(Type),rowTypeUpdates_Type_RowSumUpdate :: !(RowTypeUpdates)} + | Type_RowSumEmpty {range_Type_RowSumEmpty :: !(Range)} + | Type_Qualified {range_Type_Qualified :: !(Range),context_Type_Qualified :: !(ContextItems),type_Type_Qualified :: !(Type)} + | Type_TupleConstructor {range_Type_TupleConstructor :: !(Range),arity_Type_TupleConstructor :: !(Int)} +-- TypeAnnotation ---------------------------------------------- +data TypeAnnotation = TypeAnnotation_Strict {} + | TypeAnnotation_AnnotationName {name_TypeAnnotation_AnnotationName :: !(Name)} + | TypeAnnotation_AnnotationVar {name_TypeAnnotation_AnnotationVar :: !(Name),var_TypeAnnotation_AnnotationVar :: !(Name)} +-- TypeLeftHandSide -------------------------------------------- +data TypeLeftHandSide = TypeLeftHandSide_Function {range_TypeLeftHandSide_Function :: !(Range),name_TypeLeftHandSide_Function :: !(Name),patterns_TypeLeftHandSide_Function :: !(TypePatterns)} + | TypeLeftHandSide_Infix {range_TypeLeftHandSide_Infix :: !(Range),leftPattern_TypeLeftHandSide_Infix :: !(TypePattern),operator_TypeLeftHandSide_Infix :: !(Name),rightPattern_TypeLeftHandSide_Infix :: !(TypePattern)} + | TypeLeftHandSide_Parenthesized {range_TypeLeftHandSide_Parenthesized :: !(Range),lefthandside_TypeLeftHandSide_Parenthesized :: !(TypeLeftHandSide),patterns_TypeLeftHandSide_Parenthesized :: !(TypePatterns)} +-- TypePattern ------------------------------------------------- +data TypePattern = TypePattern_Variable {range_TypePattern_Variable :: !(Range),name_TypePattern_Variable :: !(Name)} +-- TypePatterns ------------------------------------------------ +type TypePatterns = [TypePattern] +-- Types ------------------------------------------------------- +type Types = [Type] diff --git a/src/UHC/Light/Compiler/HS/MainAG.hs b/src/UHC/Light/Compiler/HS/MainAG.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/HS/MainAG.hs @@ -0,0 +1,35671 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag) +module UHC.Light.Compiler.HS.MainAG(Inh_AGItf (..), Syn_AGItf (..), sem_AGItf, wrap_AGItf +, tyGam2IdDefOccGam, kiGam2IdDefOccGam +, clGam2IdDefOccGam) where + +import Data.Char +import Data.Maybe +import Data.List as List +import qualified Data.Map as Map +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.HS +import UHC.Light.Compiler.NameAspect +import UHC.Util.DependencyGraph +import qualified UHC.Util.FastSeq as Seq +import UHC.Util.Utils +import qualified UHC.Light.Compiler.EH as EH +import qualified Data.Set as Set +import UHC.Light.Compiler.Ty (tyQu_Forall,tyQu_Exists) +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Gam.ClGam +import qualified UHC.Util.Rel as Rel +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Foreign +import UHC.Light.Compiler.Foreign.Parser +import Data.Ratio +import UHC.Light.Compiler.Scanner.Common(floatDenot2NomDenom,intDenot2Integer) +import UHC.Light.Compiler.Base.Debug as Debug +import qualified UHC.Light.Compiler.Base.Pragma as Pragma + + +doccForUse ::Maybe IdDefOcc -> IdIsDef +doccForUse md + = case md of + Just d -> IdIsDef (doccLev d) + Nothing -> IdIsNotDef + + + +mkBuiltinIdDefOcc :: HsName -> IdOccKind -> (IdOcc,IdDefOcc) +mkBuiltinIdDefOcc n k + = (o,emptyIdDefOcc {doccOcc = o, doccLev = nmLevBuiltin, doccRange = builtinRange}) + where o = IdOcc n k + +tyGam2IdDefOccGam :: TyGam -> IdDefOccGam +tyGam2IdDefOccGam = gamMap (\(n,_) -> mkBuiltinIdDefOcc n IdOcc_Type) + +kiGam2IdDefOccGam :: KiGam -> IdDefOccGam +kiGam2IdDefOccGam = gamMap (\(n,_) -> mkBuiltinIdDefOcc n IdOcc_Kind) + +clGam2IdDefOccGam :: ClGam -> IdDefOccGam +clGam2IdDefOccGam = gamMap (\(n,_) -> mkBuiltinIdDefOcc n IdOcc_Class) + + + +data IdIsDef + = IdIsDef { idIsDefLev :: NmLev } + | IdIsNotDef + | IdIsInWrongModule IdOcc + deriving (Show) + +idIsDef :: IdIsDef -> Bool +idIsDef (IdIsDef _) = True +idIsDef _ = False + +instance PP IdIsDef where + pp (IdIsDef _) = pp "Def'd" + pp IdIsNotDef = pp "Undef'd" + pp (IdIsInWrongModule o) = "Wrong" >#< o + + + +data IdUseOcc + = IdUseOcc + { uoccOcc :: IdOcc + , uoccAsp :: IdAspect + , uoccRange :: Range + , uoccIsDef :: IdIsDef + } + deriving (Show) + +instance PP IdUseOcc where + pp o = uoccOcc o >|< "/" >|< uoccIsDef o + +type IdUseOccGam = Gam IdOcc IdUseOcc +type IdUseOccAsc = AssocL IdOcc [IdUseOcc] + + + +splitIdUseOccGam :: Int -> IdUseOccGam -> (IdUseOccGam, IdUseOccAsc, IdUseOccAsc, IdUseOccGam) +splitIdUseOccGam level g + = (assocDupLToGam o,h,i,assocDupLToGam e) + where (o,h,i,e) + = foldr + (\x@(k,occs) (o,h,i,e) + -> case partition (idIsDef . uoccIsDef) occs of + (occ:_,[]) -> case compare (idIsDefLev $ uoccIsDef $ occ) level of + LT -> (x:o, h, i, e) + EQ -> ( o,x:h, i, e) + GT -> ( o, h,x:i, e) + (_,(_:_)) -> ( o, h, i,x:e) + ) + ([],[],[],[]) + (gamToAssocDupL g) + + + +mkDefOccGam'' :: NmLev -> Range -> (x -> IdOcc -> IdAspect) -> AssocL x IdOcc -> IdDefOccGam +mkDefOccGam'' l r mka os + = assocLToGamWithDups [ (o,mkIdDefOcc o (mka x o) l r) | (x,o) <- os ] + +mkDefOccGam' :: NmLev -> Range -> (IdOcc -> IdAspect) -> [IdOcc] -> IdDefOccGam +mkDefOccGam' l r mka os + = mkDefOccGam'' l r (\_ -> mka) (zip (repeat undefined) os) +{-# INLINE mkDefOccGam' #-} + +mkDefOccGam :: NmLev -> Range -> IdAspect -> [IdOcc] -> IdDefOccGam +mkDefOccGam l r a os + = mkDefOccGam' l r (const a) os +{-# INLINE mkDefOccGam #-} + + + +varL2IdDefOccGam :: IdOccKind -> IdAspect -> NmLev -> Range -> [HsName] -> IdDefOccGam +varL2IdDefOccGam k a l r ns + = mkDefOccGam l r a [ IdOcc n k | n <- ns ] + +tvarL2IdDefOccGam :: NmLev -> Range -> [HsName] -> IdDefOccGam +tvarL2IdDefOccGam + = varL2IdDefOccGam IdOcc_Type IdAsp_Type_Var + +varS2IdDefOccGam :: IdOccKind -> IdAspect -> NmLev -> Range -> HsNameS -> IdDefOccGam +varS2IdDefOccGam k a l r ns + = varL2IdDefOccGam k a l r (Set.toList ns) + +tvarS2IdDefOccGam :: NmLev -> Range -> HsNameS -> IdDefOccGam +tvarS2IdDefOccGam + = varS2IdDefOccGam IdOcc_Type IdAsp_Type_Var + + + +kvarL2IdDefOccGam :: NmLev -> Range -> [HsName] -> IdDefOccGam +kvarL2IdDefOccGam + = varL2IdDefOccGam IdOcc_Kind IdAsp_Kind_Var + +kvarS2IdDefOccGam :: NmLev -> Range -> HsNameS -> IdDefOccGam +kvarS2IdDefOccGam + = varS2IdDefOccGam IdOcc_Kind IdAsp_Kind_Var + + + +-- | Get the names used by the literals +-- Note: don't change the order in returned lists, only append new values, as position is assumed to be fixed +litNames :: EHCOpts -> Literal -> Bool -> Int -> [([HsName],IdOccKind,IdAspect)] +litNames opts lit isPat sign + = case lit of + Literal_String r s -> mk' (if isPat then IdAsp_Val_Con else IdAsp_Val_Var) [hsnDataListAltCons,hsnDataListAltNil] + ++ (if ehcOptOverloadedStrings opts then mk [hsnDataStringFromString] else []) + Literal_Int _ _ _ + | sign < 0 -> mk [hsnFromInteger,hsnNegate] + | otherwise -> mk [hsnFromInteger] + Literal_Float _ _ + | sign < 0 -> mk [hsnMkRatio,hsnFromRational,hsnNegate] + | otherwise -> mk [hsnMkRatio,hsnFromRational] + _ -> [] + where mk' a ns = [(ns,IdOcc_Val,a)] + mk = mk' IdAsp_Val_Var + + + +mkUseOccGam :: EHCOpts -> IdDefOccGam -> [HsName] -> IdOccKind -> IdAspect -> Range -> (HsName,[HsName],IdUseOccGam,[Err]) +mkUseOccGam opts idGam names kind asp rng = mkUseOccGam' opts idGam [(names,kind,asp)] rng + + + +mkUseOccGam' :: EHCOpts -> IdDefOccGam -> [([HsName],IdOccKind,IdAspect)] -> Range -> (HsName,[HsName],IdUseOccGam,[Err]) +mkUseOccGam' _ _ [] _ + = (hsnUnknown,[],emptyGam,[]) +mkUseOccGam' opts idGam names rng + = (if null ns then hsnUnknown else n, ns, gamUnions g, concat e) + where (ns@(~(n:_)),g,e) = unzip3 [ mkUse idGam n kind asp rng | (ns,kind,asp) <- names, n <- ns ] + mkUse idGam name kind asp rng + = (nmOfDef,idUseOccGam,errs) + where idOccUse = IdOcc name kind + mbDef = -- (\v -> tr "XX" (idOccUse >#< ">>>>>" >#< v) v) $ + case gamLookup idOccUse idGam of + Nothing | hsnIsInPrelude name + -> if ehcOptUseAssumePrelude opts + then Just (emptyIdDefOcc {doccOcc = idOccUse}) + else gamLookup (idOccUse {ioccNm = hsnQualified $ ioccNm idOccUse}) idGam + md -> md + nmOfDef = case mbDef of + Just d -> ioccNm $ doccOcc d + _ -> name + occOfDef = idOccUse {ioccNm = nmOfDef} + idUseOccGam = gamSingleton occOfDef (IdUseOcc occOfDef asp rng (doccForUse mbDef)) + errs = case mbDef of + Just d | Set.size (doccNmAlts d) > 1 + -> [rngLift rng Err_AmbiguousNameRef "name" k name (Set.toList $ doccNmAlts d)] + where k = (show $ ioccKind $ doccOcc d) ++ " (" ++ (showPP $ pp $ doccAsp d) ++ ")" + _ -> [] + + + +type IdDpdMp = Map.Map IdOcc [IdOcc] + +idDpdMpSingleton :: IdOcc -> IdOcc -> IdDpdMp +idDpdMpSingleton f t = Map.singleton f [t] + +idDpdMpUnions :: [IdDpdMp] -> IdDpdMp +idDpdMpUnions = Map.unionsWith (++) + +idDpdMpUnion :: IdDpdMp -> IdDpdMp -> IdDpdMp +idDpdMpUnion = Map.unionWith (++) + +idToOccL2DpdMp :: [IdOcc] -> AssocL IdOcc x -> IdDpdMp +idToOccL2DpdMp fs l + = if null ts then Map.empty else idDpdMpUnions [ Map.singleton f ts | f <- fs ] + where ts = assocLKeys l + +idToOccGam2DpdMp :: [IdOcc] -> Gam IdOcc x -> IdDpdMp +idToOccGam2DpdMp fs l + = idToOccL2DpdMp fs (gamToAssocL l) + +idFrOccGam2DpdMp :: Gam IdOcc x -> [IdOcc] -> IdDpdMp +idFrOccGam2DpdMp g ts + = if null ts then Map.empty else idDpdMpUnions [ Map.singleton f ts | (f,_) <- gamToAssocL g ] + + + +idDpdMp2SccOrder :: IdDefOccGam -> IdDpdMp -> [[IdOcc]] +idDpdMp2SccOrder gam mp + = dgSCCToList gr + where dflt = idDpdMpUnions [ idDpdMpSingleton o o | o <- gamKeys gam ] `Map.difference` mp + gr = mkDpdGrFromEdgesMp (idDpdMpUnions [mp,dflt]) + + + +mkIdDefEH :: IdDefOcc -> [EH.Decl] +mkIdDefEH def + = case doccAsp def of + IdAsp_Val_Pat decl + -> [decl] + IdAsp_Val_Sig decl + -> [decl] + IdAsp_Val_Fun lhs rhs _ + -> [decl] + where (h,t) = hdAndTl lhs + decl = rngLift (doccRange def) EH.Decl_Val h (foldr (rngLift (doccRange def) EH.Expr_Lam) rhs t) + IdAsp_Type_Def decl + -> [decl] + IdAsp_Type_Sig decl + -> [decl] + IdAsp_Val_Foreign decl + -> [decl] + IdAsp_Class_Def decl declInst + -> [decl,declInst] + IdAsp_Inst_Def decl _ + -> [decl] + IdAsp_Dflt_Def decl ignore | not ignore + -> [decl] + IdAsp_Val_Fusion decl + -> [decl] + IdAsp_Fusion_Conv decl + -> [decl] + _ -> [] + + + +mergeFunDefL :: Range -> [IdDefOcc] -> ([IdDefOcc],[Err]) +mergeFunDefL _ ds + = case ds of + [_] -> (ds,[]) + (od : _ : _) | iaspIsFun (doccAsp od) + -> ([d],e) + where (IdAsp_Val_Fun (patf:pats1) _ uniq) = doccAsp od + xSz = length pats1 + xNmL = [ mkHNm ("x" ++ show i) | i <- [1..xSz] ] + xPatL = map (rngLift r EH.PatExpr_Var) xNmL + b = EH.mkCase' + r (appRngProdOpt r $ map (rngLift r EH.Expr_Var) $ xNmL) + (Just $ Set.fromList $ map (iaspUniq . doccAsp) ds) + Set.empty + (length xNmL > 1) + $ zipWith (EH.mkAlt r) + [ appRngProdOpt r $ tail $ iaspPatL $ doccAsp d | d <- ds ] + [ iaspBody $ doccAsp $ d | d <- ds ] + d = mkIdDefOcc (doccOcc od) (IdAsp_Val_Fun (patf:xPatL) b uniq) 0 r + e | length patLens > 1 = [rngLift r Err_FunPatternLengths (ioccNm $ doccOcc od)] + | otherwise = [] + where patLens = Set.toList $ Set.fromList [ length $ iaspPatL $ doccAsp d | d <- ds ] + r = rangeUnions [ doccRange d | d <- ds ] + _ -> ([],[]) + + + +splitOff :: [IdDefOcc] -> [[IdDefOcc]] +splitOff + = foldr (\df dfs -> zipWith (++) (s df) dfs) (repeat []) + where s d = case doccAsp d of + (IdAsp_Inst_Def _ _) -> [[],[d]] + _ -> [[d],[]] + + + +idOcc2Defs :: IdDefOccGam -> IdOcc -> [IdDefOcc] +idOcc2Defs idDefOccGam occ = maybe [] id $ gamLookupDup occ idDefOccGam + +mkIdOccEH :: Range -> [IdDefOcc] -> ([EH.Decl],[Err]) +mkIdOccEH r defs + = case defs of + (_:_) + -> (concatMap mkIdDefEH (otherDefs ++ funDef),errL) + where (funDefs,otherDefs) = partition (iaspIsFun . doccAsp) defs + (funDef,errL) = mergeFunDefL r funDefs + _ -> ([],[]) + + + +idDefOccs2Decls :: Range -> [[IdDefOcc]] -> ([[EH.Decl]],[Err]) +idDefOccs2Decls r docss + = ([concat ds], concat es) + where (ds,es) = unzip $ map (mkIdOccEH r) $ docss + + + +mkIdOccSccEH :: Range -> Bool -> IdDefOccGam -> Maybe [[IdOcc]] -> (EH.Expr -> EH.Expr,[[EH.Decl]],[Err]) +mkIdOccSccEH r isStrict g moss + = (m . mkLet (concat sds), d ++ sds, e ++ ses) + where (m,d,e) = foldr mkl (id,[],[]) doss + mkl dos (mke,d,e) + = ((\e -> foldr mkLet e dss) . mke,dss ++ d, es ++ e) + where (dss,es) = idDefOccs2Decls r dos + mkLet ds = EH.mkLet' isStrict r (Just ds) + (sds,ses) = idDefOccs2Decls r $ concat $ spls + (doss:spls:_) + = collapse + [ collapse [ splitOff $ idOcc2Defs g $ l | l <- ll ] + | ll <- maybe [gamKeys g] id moss + ] + collapse :: [[a]] -> [[a]] + collapse = foldr (zipWith (:)) (repeat []) + + + +type PatchEhNmInInstance = HsName -> HsName + + + +idDupCheckInfo :: AssocL IdOccKind (AssocL String (IdAspect -> Bool)) +idDupCheckInfo + = [ ( IdOcc_Val + , [ ( "type signature" , iaspIsValSig ) + , ( "value" , (\a -> iaspIsValVar a + || iaspIsFun a + || iaspIsValFld a + || iaspIsValForeign a + ) ) + , ( "operator fixity" , iaspIsValFix ) + , ( "data constructor" , iaspIsValCon ) + ] + ) + , ( IdOcc_Type + , [ ( "type variable" , iaspIsTypeVar ) + , ( "type" , iaspIsTypeDef ) + , ( "kind signature" , iaspIsTypeSig ) + ] + ) + , ( IdOcc_Class + , [ ( "class" , iaspIsClassDef ) + ] + ) + ] + + + +idDefOccGamCheckDupNames :: IdDefOccGam -> [Err] +idDefOccGamCheckDupNames g + = case dups of + [] -> [] + es -> map mk es + where mk (info,ds@((_,Just ((r,_):_)):_)) = rngLift r Err_NamesDupIntrod info ds + where dups + = Map.toList + $ Map.unionsWith (++) + $ [ Map.singleton info [(n,Just [(doccRange d, Just $ pp $ doccAsp d) | d <- defs])] + | (IdOcc {ioccKind=k, ioccNm=n},ds) <- gamToAssocDupL g + , check <- maybeToList $ lookup k idDupCheckInfo + , (info,defs) <- filter (\(_,x) -> length x > 1) + $ assocLMapElt (\c -> filter (\d -> c (doccAsp d)) $ collapse ds) check + ] + -- Functions and data fields are allowed to have duplicate entries, so they are collapsed into 1. + -- For data fields under the provision that the type to which they belong is the same, but the constructor not (another weird language complexity check) + collapse ds + = take 1 funs + ++ (map head $ filter (\l -> length l > 0) $ map concat flds1PerCon) + ++ (concat $ concat fldsManyPerCon) + ++ others2 + where (funs,others1) = partition (iaspIsFun . doccAsp) ds + (flds,others2) = partition (iaspIsValFld . doccAsp) others1 + fldsGrouped = map (groupOn (iaspConNm . doccAsp)) $ groupOn (iaspDataNm . doccAsp) flds + (flds1PerCon,fldsManyPerCon) = unzip $ map (partition (\l -> length l == 1)) $ fldsGrouped + + + +ppInstNm :: Bool -> Maybe HsName -> PP_Doc +ppInstNm useimplicitly maybeinstancename + = maybe empty (\n -> " " >|< n >#< (if useimplicitly then "<:" else "::")) maybeinstancename + + + +data OpChain leaf + = OpChain_Op leaf PP_Doc Fixity Int Range (OpChain leaf) (OpChain leaf) + | OpChain_Leaf leaf + +opChainReArrange :: OpChain e -> (OpChain e,[Err]) +opChainReArrange opChain + = case opChain of + OpChain_Op op1 pp1 f1 p1 pos1 l1 r1 + -> case opChainReArrange r1 of + (OpChain_Op op2 pp2 f2 p2 pos2 l2 r2,rerr) + | p1 > p2 -> (lvariant,lerr) + | p1 < p2 -> (rvariant,rerr) + | p1 == p2 -> case (f1,f2,lvariant,rvariant) of + (Fixity_Infixr,Fixity_Infixr,_,r) -> (r,rerr) + (Fixity_Infixl,Fixity_Infixl,l,_) -> (l,lerr) + (Fixity_Infix ,_ ,l,_) -> (l,[rngLift pos2 Err_Fixity pp1 pp2] ++ lerr) + where (lrearr,lerr) = opChainReArrange (OpChain_Op op1 pp1 f1 p1 pos1 l1 l2) + lvariant = OpChain_Op op2 pp2 f2 p2 pos2 lrearr r2 + rvariant = OpChain_Op op1 pp1 f1 p1 pos1 l1 (OpChain_Op op2 pp2 f2 p2 pos2 l2 r2) + (r1l@(OpChain_Leaf _),rerr) -> (OpChain_Op op1 pp1 f1 p1 pos1 l1 r1l,rerr) + _ -> (opChain,[]) + +unOpChain :: AppLike a boundmeta => OpChain a -> a +unOpChain opChain + = un opChain + where un ch + = case ch of + OpChain_Op op _ _ _ rng l r + -> appRngParApp rng [op,un l,un r] + OpChain_Leaf leaf + -> leaf + + + +ehSection :: AppLike eh bound + => UID -> Range + -> RngLiftArg (HsName -> eh) + -> RngLiftArg (HsName -> ehp) + -> RngLiftArg (ehp -> eh -> eh) + -> Maybe eh -> eh -> Maybe eh + -> eh +ehSection uniq range semvar sempatvar semlam left op right + = case (left,right) of + -- (Just l ,Just r ) -> appRngParApp range [op,l,r] + (Nothing,Just r ) -> rngLift range semlam np (appRngParApp range [op,ne,r]) + (Just l ,Nothing) -> appRngParApp range [op,l] + (Nothing,Nothing) -> op + where n = mkHNmHidden $ mkHNm ("x_" ++ show uniq) + ne = rngLift range semvar n + np = rngLift range sempatvar n + + + +ehTupleConstructor + :: AppLike eh bound + => Range -> Int -> RngLiftArg (HsName -> eh) -> RngLiftArg (HsName -> ehp) -> RngLiftArg (ehp -> eh -> eh) + -> ([ehp] -> eh -> eh) -> RngLiftArg (r -> eh) -> RngLiftArg (r -> Maybe HsName -> eh -> r) -> RngLiftArg r + -> eh +ehTupleConstructor range arity semvar sempatvar semlam + semtop semrecd semrecdext semrecdempty + = foldr (rngLift range semlam) recd ps + where ns = take arity hsnLclSupply + ps = map (rngLift range sempatvar) ns + recd = mkt (map (rngLift range semvar) ns) + mkt ns = semtop ps + $ rngLift range semrecd + $ foldl (\r e -> rngLift range semrecdext r Nothing e) + (rngLift range semrecdempty) + ns + + + +ehTyExprArg :: EH.TyExpr -> EH.TyExpr +ehTyExprArg = snd . panicJust "HS.ToEH.ehTyExprArg" . appMbApp1 . fst . appUnTop + + + + + +ehPlainDataField :: Range -> EH.TyExpr -> EH.DataField +ehPlainDataField r + = rngLift r EH.DataField_Field Nothing + + + +ehExpLitInt :: Range -> Int -> String -> Int -> [HsName] -> (EH.Expr,Maybe SrcConst) +ehExpLitInt r b s sign litrefnames + | sign < 0 = mk (\e -> ehExpVarApp r (litrefnames !! 1) [e], negate) + | otherwise = mk (id , id ) + where i = intDenot2Integer b s + mk (neg,negconst) + = (neg $ ehExpVarApp r (litrefnames !! 0) [rngLift r EH.Expr_IIConst i], Just $ SrcConst_Int $ negconst i) + +ehExpLitFloat :: Range -> String -> Int -> [HsName] -> (EH.Expr,Maybe SrcConst) +ehExpLitFloat r s sign litrefnames + | sign < 0 = mk (\e -> ehExpVarApp r (litrefnames !! 2) [e], \(n,d) -> (negate n, d)) + | otherwise = mk (id , id ) + where nd@(n,d) = floatDenot2NomDenom s + mk (neg,negconst) + = ( neg $ ehExpVarApp r (litrefnames !! 1) + $ [rngLift r EH.Expr_Parens $ ehExpVarApp r (litrefnames !! 0) [rngLift r EH.Expr_IIConst n,rngLift r EH.Expr_IIConst d]] + , Just $ uncurry SrcConst_Ratio $ negconst nd + ) + + + +ehExpLitString :: EHCOpts -> Range -> String -> [HsName] -> (EH.Expr,Maybe SrcConst) +ehExpLitString opts r str litrefnames + | ehcOptOverloadedStrings opts = (ehExpVarApp r (litrefnames !! 2) [s], Nothing) + | otherwise = (s , Nothing) + where s = rngLift r EH.Expr_SConst str + + + +ehExpApp' :: (EH.Expr -> a -> EH.Expr) -> Range -> EH.Expr -> [a] -> EH.Expr +ehExpApp' app r f as + = rngLift r EH.Expr_AppTop + $ foldl app (ehExpUnTop f) as + +ehExpConApp :: Range -> HsName -> [EH.Expr] -> EH.Expr +ehExpConApp r n as + = appRngParApp r (rngLift r EH.Expr_Con n : as) + +ehExpVarApp :: Range -> HsName -> [EH.Expr] -> EH.Expr +ehExpVarApp r n as + = appRngParApp r (rngLift r EH.Expr_Var n : as) + +ehExpUnTop :: EH.Expr -> EH.Expr +ehExpUnTop (EH.Expr_AppTop _ e) = e +ehExpUnTop e = e + + + +ehExpProd :: Range -> [EH.Expr] -> EH.Expr +ehExpProd r as + = ehExpConApp r (hsnProd a) as + where a = length as + + + +-- original with mono restriction +ehGenerator :: Range -> EH.PatExpr -> (EH.Expr -> EH.Expr) -> EH.Expr -> EH.Expr -> EH.Expr +ehGenerator r p mkRes fail e + = EH.mkLet r + (Just + [ {- -} rngLift r EH.Decl_TySig ok ([mono] `appArr` appTopApp1 mono mono) + , + rngLift r EH.Decl_Val + (rngLift r EH.PatExpr_Var ok) + (rngLift r EH.Expr_Lam + (rngLift r EH.PatExpr_Var x) + (EH.mkCase r + (rngLift r EH.Expr_Var x) + [(p,e),(rngLift r EH.PatExpr_Var hsnWild,fail)] + ) ) +{- + , rngLift r EH.Decl_TySig res mono + , rngLift r EH.Decl_Val + (rngLift r EH.PatExpr_Var res) + (mkRes (rngLift r EH.Expr_Var ok)) +-} + ]) + (mkRes (rngLift r EH.Expr_Var ok)) + -- (rngLift r EH.Expr_Var res) + where ok = mkHNmHidden "ok" + res = mkHNmHidden "ok_app" + x = mkHNmHidden "x" + mono = rngLift r EH.TyExpr_Mono + + + +ehRowRecExprUpd :: Range -> nm -> (EH.RecExpr -> nm -> EH.Expr -> EH.RecExpr) -> EH.Expr -> EH.Expr -> EH.Expr +ehRowRecExprUpd rng nm mk updE recE + = case recE of + EH.Expr_Rec _ r + -> mkUpd r + _ -> mkUpd (r2e recE) + where r2e = rngLift rng EH.RecExpr_Expr + mkUpd r = rngLift rng EH.Expr_Rec (mk r nm updE) + +ehRowRecPatExprUpd :: Range -> nm -> (EH.RecPatExpr -> nm -> EH.PatExpr -> EH.RecPatExpr) -> EH.PatExpr -> EH.PatExpr -> EH.PatExpr +ehRowRecPatExprUpd rng nm mk updE recE + = case recE of + EH.PatExpr_Rec _ r + -> mkUpd r + _ -> mkUpd (r2e recE) + where r2e = rngLift rng EH.RecPatExpr_Expr + mkUpd r = rngLift rng EH.PatExpr_Rec (mk r nm updE) + + + +ehRowRowTyExprUpd :: Range -> nm -> (EH.RowTyExpr -> nm -> EH.TyExpr -> EH.RowTyExpr) -> EH.TyExpr -> EH.TyExpr -> EH.TyExpr +ehRowRowTyExprUpd rng nm mk updE recE + = case recE of + EH.TyExpr_Row _ r + -> mkUpd r + EH.TyExpr_Var _ v + -> mkUpd (rngLift rng EH.RowTyExpr_Var v) + _ -> mkUpd (rngLift rng EH.RowTyExpr_Empty) + where mkUpd r = rngLift rng EH.TyExpr_Row (mk r nm updE) + + + +-- | enforce monomorphism +ehMkEnforceMono :: Range -> Bool -> EH.Expr -> EH.Expr +ehMkEnforceMono r True e = rngLift r EH.Expr_TypeAs False (rngLift r EH.TyExpr_Mono) e +ehMkEnforceMono _ _ e = e + + + +ehPatConApp r n as + = rngLift r EH.PatExpr_AppTop + $ foldl (rngLift r EH.PatExpr_App) (rngLift r EH.PatExpr_Con n) as + + + +ehPatProd :: Range -> [EH.PatExpr] -> EH.PatExpr +ehPatProd r as + = ehPatConApp r (hsnProd a) as + where a = length as + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +data TypeConFixedMeaning + = TyConIsOther + | TyConIsPrArrow + | TyConIsEqTilde + deriving Eq + + + +extrTopInstanceNm :: [HsName] -> (Maybe HsName,[HsName]) +extrTopInstanceNm nms + = case nms of + (n:t) -> (Just n,t) + _ -> (Nothing,[]) + +-- AGItf ------------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + gUniq : UID + idGam : IdDefOccGam + isTopMod : Bool + modEntToOrig : ModEntRngMp + modInScope : ModEntDomMp + moduleNm : HsName + opts : EHCOpts + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.AGItf + errSq : ErrSq + fileHeaderPragmas : Set.Set Pragma.Pragma + gathFixityGam : FixityGam + gathIdGam : IdDefOccGam + mainValExists : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + alternatives: + alternative AGItf: + child module : Module + visit 0: + local patchEhNmInInstance : _ + local nmLev : _ + local ppExtra : _ + local isMainMod : _ +-} +-- cata +sem_AGItf :: AGItf -> + T_AGItf +sem_AGItf (AGItf_AGItf _module) = + (sem_AGItf_AGItf (sem_Module _module)) +-- semantic domain +type T_AGItf = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + ModEntRngMp -> + ModEntDomMp -> + HsName -> + EHCOpts -> + ([HsName]) -> + ( (EH.AGItf),ErrSq,(Set.Set Pragma.Pragma),FixityGam,IdDefOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc)) +data Inh_AGItf = Inh_AGItf {fixityGam_Inh_AGItf :: !(FixityGam),gUniq_Inh_AGItf :: !(UID),idGam_Inh_AGItf :: !(IdDefOccGam),isTopMod_Inh_AGItf :: !(Bool),modEntToOrig_Inh_AGItf :: !(ModEntRngMp),modInScope_Inh_AGItf :: !(ModEntDomMp),moduleNm_Inh_AGItf :: !(HsName),opts_Inh_AGItf :: !(EHCOpts),topInstanceNmL_Inh_AGItf :: !(([HsName]))} +data Syn_AGItf = Syn_AGItf {eh_Syn_AGItf :: !((EH.AGItf)),errSq_Syn_AGItf :: !(ErrSq),fileHeaderPragmas_Syn_AGItf :: !((Set.Set Pragma.Pragma)),gathFixityGam_Syn_AGItf :: !(FixityGam),gathIdGam_Syn_AGItf :: !(IdDefOccGam),mainValExists_Syn_AGItf :: !(Bool),pp_Syn_AGItf :: !(PP_Doc),ppWrap_Syn_AGItf :: !((PP_Doc -> PP_Doc))} +wrap_AGItf :: T_AGItf -> + Inh_AGItf -> + Syn_AGItf +wrap_AGItf sem (Inh_AGItf _lhsIfixityGam _lhsIgUniq _lhsIidGam _lhsIisTopMod _lhsImodEntToOrig _lhsImodInScope _lhsImoduleNm _lhsIopts _lhsItopInstanceNmL) = + (let ( _lhsOeh,_lhsOerrSq,_lhsOfileHeaderPragmas,_lhsOgathFixityGam,_lhsOgathIdGam,_lhsOmainValExists,_lhsOpp,_lhsOppWrap) = sem _lhsIfixityGam _lhsIgUniq _lhsIidGam _lhsIisTopMod _lhsImodEntToOrig _lhsImodInScope _lhsImoduleNm _lhsIopts _lhsItopInstanceNmL + in (Syn_AGItf _lhsOeh _lhsOerrSq _lhsOfileHeaderPragmas _lhsOgathFixityGam _lhsOgathIdGam _lhsOmainValExists _lhsOpp _lhsOppWrap)) +sem_AGItf_AGItf :: T_Module -> + T_AGItf +sem_AGItf_AGItf module_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisTopMod + _lhsImodEntToOrig + _lhsImodInScope + _lhsImoduleNm + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOpp :: PP_Doc + _lhsOeh :: (EH.AGItf) + _lhsOerrSq :: ErrSq + _lhsOfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _lhsOgathFixityGam :: FixityGam + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgathIdGam :: IdDefOccGam + _lhsOmainValExists :: Bool + _moduleOfixityGam :: FixityGam + _moduleOgUniq :: UID + _moduleOidGam :: IdDefOccGam + _moduleOisMainMod :: Bool + _moduleOisTopMod :: Bool + _moduleOmodEntToOrig :: ModEntRngMp + _moduleOmodInScope :: ModEntDomMp + _moduleOmoduleNm :: HsName + _moduleOnmLev :: NmLev + _moduleOopts :: EHCOpts + _moduleOpatchEhNmInInstance :: PatchEhNmInInstance + _moduleOtopInstanceNmL :: ([HsName]) + _moduleIeh :: (EH.Expr) + _moduleIerrSq :: ErrSq + _moduleIfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _moduleIgUniq :: UID + _moduleIgathFixityGam :: FixityGam + _moduleIgathIdGam :: IdDefOccGam + _moduleIidUseOccGam :: IdUseOccGam + _moduleImainValExists :: Bool + _moduleIpp :: PP_Doc + _moduleIppWrap :: (PP_Doc -> PP_Doc) + _moduleItopInstanceNmL :: ([HsName]) + _moduleIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1066, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 13, column 9) + _nmLev = + nmLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 14, column 17) + _lhsOpp = + _ppExtra >-< _moduleIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 15, column 17) + _ppExtra = + empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 5, column 9) + _lhsOeh = + EH.AGItf_AGItf _moduleIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 248, column 9) + _isMainMod = + _moduleImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _moduleIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 2, column 43) + _lhsOfileHeaderPragmas = + _moduleIfileHeaderPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _moduleIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _moduleIppWrap + -- copy rule (up) + _lhsOgathIdGam = + _moduleIgathIdGam + -- copy rule (up) + _lhsOmainValExists = + _moduleImainValExists + -- copy rule (down) + _moduleOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _moduleOgUniq = + _lhsIgUniq + -- copy rule (down) + _moduleOidGam = + _lhsIidGam + -- copy rule (from local) + _moduleOisMainMod = + _isMainMod + -- copy rule (down) + _moduleOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _moduleOmodEntToOrig = + _lhsImodEntToOrig + -- copy rule (down) + _moduleOmodInScope = + _lhsImodInScope + -- copy rule (down) + _moduleOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _moduleOnmLev = + _nmLev + -- copy rule (down) + _moduleOopts = + _lhsIopts + -- copy rule (from local) + _moduleOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _moduleOtopInstanceNmL = + _lhsItopInstanceNmL + ( _moduleIeh,_moduleIerrSq,_moduleIfileHeaderPragmas,_moduleIgUniq,_moduleIgathFixityGam,_moduleIgathIdGam,_moduleIidUseOccGam,_moduleImainValExists,_moduleIpp,_moduleIppWrap,_moduleItopInstanceNmL,_moduleIundefOccGam) = + module_ _moduleOfixityGam _moduleOgUniq _moduleOidGam _moduleOisMainMod _moduleOisTopMod _moduleOmodEntToOrig _moduleOmodInScope _moduleOmoduleNm _moduleOnmLev _moduleOopts _moduleOpatchEhNmInInstance _moduleOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfileHeaderPragmas,_lhsOgathFixityGam,_lhsOgathIdGam,_lhsOmainValExists,_lhsOpp,_lhsOppWrap))) +-- Alternative ------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.CaseAlt] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Alternative: + child range : {Range} + child pattern : Pattern + child righthandside : RightHandSide + visit 0: + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + alternative Empty: + child range : {Range} +-} +-- cata +sem_Alternative :: Alternative -> + T_Alternative +sem_Alternative (Alternative_Alternative _range _pattern _righthandside) = + (sem_Alternative_Alternative _range (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Alternative (Alternative_Empty _range) = + (sem_Alternative_Empty _range) +-- semantic domain +type T_Alternative = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.CaseAlt]),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Alternative_Alternative :: Range -> + T_Pattern -> + T_RightHandSide -> + T_Alternative +sem_Alternative_Alternative range_ pattern_ righthandside_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _righthandsideOidGam :: IdDefOccGam + _righthandsideOsepPP :: PP_Doc + _lhsOeh :: ([EH.CaseAlt]) + _righthandsideOmustBeMono :: Bool + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _righthandsideOcaseId :: UID + _righthandsideOfixityGam :: FixityGam + _righthandsideOgUniq :: UID + _righthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _righthandsideOpragmas :: (Set.Set Pragma.Pragma) + _righthandsideOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _righthandsideIeh :: (EH.Expr) + _righthandsideIerrSq :: ErrSq + _righthandsideIgUniq :: UID + _righthandsideIidUseOccGam :: IdUseOccGam + _righthandsideIpp :: PP_Doc + _righthandsideIppWrap :: (PP_Doc -> PP_Doc) + _righthandsideItopInstanceNmL :: ([HsName]) + _righthandsideIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 392, column 9) + _righthandsideOidGam = + gamUnion _patternIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 73, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 121, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _patternIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 93, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _patternIerrSq, _righthandsideIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 275, column 9) + _pp = + _patternIpp >#< _righthandsideIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 276, column 9) + _righthandsideOsepPP = + pp "->" + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 625, column 9) + _lhsOeh = + [EH.mkAlt range_ _patternIeh _righthandsideIeh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 278, column 9) + _righthandsideOmustBeMono = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam `gamAddGam` _righthandsideIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _righthandsideIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _righthandsideIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _righthandsideOcaseId = + _lhsIcaseId + -- copy rule (down) + _righthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _righthandsideOgUniq = + _patternIgUniq + -- copy rule (down) + _righthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _righthandsideOnmLev = + _nmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (down) + _righthandsideOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _righthandsideOpragmas = + _lhsIpragmas + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _righthandsideIeh,_righthandsideIerrSq,_righthandsideIgUniq,_righthandsideIidUseOccGam,_righthandsideIpp,_righthandsideIppWrap,_righthandsideItopInstanceNmL,_righthandsideIundefOccGam) = + righthandside_ _righthandsideOcaseId _righthandsideOfixityGam _righthandsideOgUniq _righthandsideOgenerDerivMp _righthandsideOidGam _righthandsideOmoduleNm _righthandsideOmustBeMono _righthandsideOnmLev _righthandsideOopts _righthandsideOpatchEhNmInInstance _righthandsideOpragmas _righthandsideOsepPP _righthandsideOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Alternative_Empty :: Range -> + T_Alternative +sem_Alternative_Empty range_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.CaseAlt]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 627, column 9) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Alternatives ------------------------------------------------ +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.CaseAlt] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Alternative + child tl : Alternatives + alternative Nil: +-} +-- cata +sem_Alternatives :: Alternatives -> + T_Alternatives +sem_Alternatives list = + (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list)) +-- semantic domain +type T_Alternatives = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.CaseAlt]),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Alternatives_Cons :: T_Alternative -> + T_Alternatives -> + T_Alternatives +sem_Alternatives_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.CaseAlt]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: ([EH.CaseAlt]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.CaseAlt]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 619, column 28) + _lhsOeh = + _hdIeh ++ _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.CaseAlt]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 619, column 28) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Body -------------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + modEntToOrig : ModEntRngMp + modInScope : ModEntDomMp + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Expr + errSq : ErrSq + extraModImpL : [ModImp] + gathFixityGam : FixityGam + gathIdGam : IdDefOccGam + idUseOccGam : IdUseOccGam + mainValExists : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Body: + child range : {Range} + child importdeclarations : ImportDeclarations + child declarations : Declarations + visit 0: + local idDefOccGamMain : _ + local idGam : _ + local mainrefname : _ + local mainrefnames : _ + local idUseOccGamMain : _ + local errIdUse : _ + local idUseHereOccL : _ + local undefOccGamMain : _ + local idDpdMp : _ + local mainValExists : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local modAsMp : _ + local refmainname : _ + local idOccDefMain : _ + local extraModImpL : _ + local errDupIntro : _ + local ppExtra : _ + local ehMainDecl : _ + local ehMainSig : _ + local caseId : _ + local pragmas : _ +-} +-- cata +sem_Body :: Body -> + T_Body +sem_Body (Body_Body _range _importdeclarations _declarations) = + (sem_Body_Body _range (sem_ImportDeclarations _importdeclarations) (sem_Declarations _declarations)) +-- semantic domain +type T_Body = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + ModEntRngMp -> + ModEntDomMp -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.Expr),ErrSq,([ModImp]),UID,FixityGam,IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Body_Body :: Range -> + T_ImportDeclarations -> + T_Declarations -> + T_Body +sem_Body_Body range_ importdeclarations_ declarations_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImodEntToOrig + _lhsImodInScope + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _declarationsOfixityGam :: FixityGam + _lhsOeh :: (EH.Expr) + _lhsOgathIdGam :: IdDefOccGam + _declarationsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOextraModImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOmainValExists :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _importdeclarationsOfixityGam :: FixityGam + _importdeclarationsOgUniq :: UID + _importdeclarationsOidGam :: IdDefOccGam + _importdeclarationsOisMainMod :: Bool + _importdeclarationsOisTopMod :: Bool + _importdeclarationsOmoduleNm :: HsName + _importdeclarationsOnmLev :: NmLev + _importdeclarationsOopts :: EHCOpts + _importdeclarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _importdeclarationsOtopInstanceNmL :: ([HsName]) + _declarationsOcaseId :: UID + _declarationsOgUniq :: UID + _declarationsOidGam :: IdDefOccGam + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _declarationsOpragmas :: (Set.Set Pragma.Pragma) + _declarationsOtopInstanceNmL :: ([HsName]) + _importdeclarationsIerrSq :: ErrSq + _importdeclarationsIgUniq :: UID + _importdeclarationsIgathFixityGam :: FixityGam + _importdeclarationsIidUseOccGam :: IdUseOccGam + _importdeclarationsImodAsMp :: (Map.Map HsName HsName) + _importdeclarationsIpp :: PP_Doc + _importdeclarationsIppWrap :: (PP_Doc -> PP_Doc) + _importdeclarationsItopInstanceNmL :: ([HsName]) + _importdeclarationsIundefOccGam :: IdUseOccGam + _declarationsIeh :: ([EH.Decl]) + _declarationsIerrSq :: ErrSq + _declarationsIgUniq :: UID + _declarationsIgathFixityGam :: FixityGam + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidDefOccGam :: IdDefOccGam + _declarationsIidDpdMp :: IdDpdMp + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsIidTySigDefOccGam :: IdDefOccGam + _declarationsIidUseOccGam :: IdUseOccGam + _declarationsIneedsError :: Bool + _declarationsIpp :: PP_Doc + _declarationsIppWrap :: (PP_Doc -> PP_Doc) + _declarationsItopInstanceNmL :: ([HsName]) + _declarationsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 252, column 9) + _idDefOccGamMain = + gamSingleton _idOccDefMain (mkIdDefOcc _idOccDefMain (IdAsp_Val_Pat _ehMainDecl) _lhsInmLev range_) + `gamUnion` gamSingleton _idOccDefMain (mkIdDefOcc _idOccDefMain IdAsp_Val_Var _lhsInmLev range_) + `gamUnion` gamSingleton _idOccDefMain (mkIdDefOcc _idOccDefMain (IdAsp_Val_Sig _ehMainSig) _lhsInmLev range_) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 293, column 9) + _idGam = + let + lkn :: (IdOcc -> Bool) -> HsName -> Maybe (HsName,[ModEnt]) + lkn isq n = case Map.lookup n + _lhsImodInScope of + Just es | not (null es') + -> Just (n,es') + where es' = [ e | e <- es, isq (mentIdOcc e) ] + _ -> Nothing + lks :: Bool -> IdOcc -> [(HsName,[ModEnt])] + lks allowRename o + = ns1 ++ catMaybes ns2 + where (mq,n) = hsnSplitQualify (ioccNm o) + (ns1,isq) = case mq of + Just q -> ( qres + , (\o' -> maybe False ( `elem` qquals ) (hsnQualifier (ioccNm o')) + ) + ) + where (qres,qquals) + = maybe ([],[q]) + (\x@(_,es) -> ( [x] + , q : extra es + ) ) + (lkn (const True) (hsnPrefixQual (as q) n)) + Nothing -> ( [], const True ) + ns2 = [lkn isq n] + extra | allowRename = \es -> catMaybes $ map (hsnQualifier . ioccNm . mentIdOcc) es + | otherwise = const [] + as :: HsName -> HsName + as n = Map.findWithDefault n n _modAsMp + mkg sel g + = foldr idDefOccGamUnion emptyGam + [ + gamSingleton (o {ioccNm = n}) (d {doccNmAlts = Set.fromList ns}) + | (o,d) <- gamToAssocL g + , (n,es) <- sel o + , let ns = [ ioccNm eo | e <- es, let eo = mentIdOcc e, ioccKind eo == ioccKind o ] + ] + gnew = mkg (lks False) + _lhsIidGam + in + mkg (lks False) _declarationsIidDefOccGam `idDefOccGamUnion` gnew + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 650, column 29) + (_mainrefname,_mainrefnames,_idUseOccGamMain,_errIdUse) = + mkUseOccGam _lhsIopts _idGam + ( [hsnMain] + ++ [hsnIO] + ++ [hsnEhcRunMain] + ++ (if _declarationsIneedsError then [hsnError] else []) + ) + IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 839, column 29) + (_,_idUseHereOccL,_,_undefOccGamMain) = + splitIdUseOccGam _lhsInmLev _idUseOccGamMain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 844, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDefMain] ((IdOcc _mainrefname IdOcc_Val,undefined) : _idUseHereOccL) + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamMain [_idOccDefMain] + `idDpdMpUnion` + _declarationsIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 849, column 9) + _lhsOundefOccGam = + let g = if _lhsIisMainMod then _undefOccGamMain else emptyGam + in gamUnions [g,_declarationsIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 863, column 9) + _mainValExists = + case gamLookupDup (IdOcc _refmainname IdOcc_Val) _declarationsIidDefOccGam of + Nothing -> False + Just occs -> chk iaspIsValVar + where chk f = not $ null $ filter (f . doccAsp) occs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 886, column 9) + _sccOrder = + idDpdMp2SccOrder (_idDefOccGamMain `gamUnion` _declarationsIidDefOccGam) _idDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1014, column 29) + (_mkSccLet,_,_errReorder) = + let g = if _lhsIisMainMod then _idDefOccGamMain else emptyGam + in mkIdOccSccEH range_ False (g `gamUnion` _declarationsIidDefOccGam) (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1054, column 9) + _modAsMp = + _importdeclarationsImodAsMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 8, column 9) + _refmainname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm hsnMain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 188, column 9) + _idOccDefMain = + IdOcc hsnMain IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 271, column 9) + _extraModImpL = + if ehcOptOverloadedStrings _lhsIopts + then [ModImp True hsnModDataString hsnModDataString False [ModEntSpec (hsnQualified hsnDataStringFromString) range_ Nothing] range_] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 97, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _declarationsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 9, column 9) + _lhsOerrSq = + Seq.firstNotEmpty [Seq.fromList _errDupIntro, Seq.fromList _errIdUse,Seq.fromList _errReorder, _declarationsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 7, column 9) + _lhsOpp = + _importdeclarationsIpp >-< + _declarationsIpp >-< _ppExtra + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 10, column 9) + _ppExtra = + empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 22, column 9) + _declarationsOfixityGam = + _declarationsIgathFixityGam `gamUnion` _lhsIfixityGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 51, column 9) + _lhsOeh = + _mkSccLet (if _lhsIisMainMod then rngLift range_ EH.Expr_Var hsnMain + else rngLift range_ EH.Expr_IConst 0 + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 57, column 9) + _ehMainDecl = + rngLift range_ EH.Decl_Val + (rngLift range_ EH.PatExpr_Var hsnMain) + (appRngParApp range_ [rngLift range_ EH.Expr_Var (_mainrefnames !! 2),rngLift range_ EH.Expr_Var _mainrefname]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 57, column 9) + _ehMainSig = + rngLift range_ EH.Decl_TySig + hsnMain + (appRngParApp range_ [rngLift range_ EH.TyExpr_Con (_mainrefnames !! 1),rngLift range_ EH.TyExpr_Wild]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 881, column 9) + _caseId = + uidStart + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 89, column 9) + _lhsOgathIdGam = + _declarationsIidDefOccGam + `gamUnion` + assocLToGam [ (o {ioccNm = hsnSetQual _lhsImoduleNm (ioccNm o)},d) + | (o,d) <- gamToAssocL _lhsIidGam + , n <- Map.findWithDefault [] o _lhsImodEntToOrig + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 309, column 9) + _pragmas = + _declarationsIgathPragmas `Set.union` _lhsIpragmas + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 315, column 9) + _declarationsOgenerDerivMp = + let nm n = hsnSetLevQual _lhsInmLev _lhsImoduleNm n + in Map.unionsWith (++) + [ Map.singleton (nm clNm) [(nm fldNm,nm dfltNm)] + | (Pragma.Pragma_Derivable clNm fldNm dfltNm) <- Set.toList _pragmas + ] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _importdeclarationsIgathFixityGam `gamAddGam` _declarationsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _importdeclarationsIidUseOccGam `gamAddGam` _declarationsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _importdeclarationsIppWrap . _declarationsIppWrap + -- copy rule (from local) + _lhsOextraModImpL = + _extraModImpL + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (from local) + _lhsOmainValExists = + _mainValExists + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _importdeclarationsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _importdeclarationsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _importdeclarationsOidGam = + _idGam + -- copy rule (down) + _importdeclarationsOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _importdeclarationsOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _importdeclarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importdeclarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _importdeclarationsOopts = + _lhsIopts + -- copy rule (down) + _importdeclarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _importdeclarationsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _declarationsOcaseId = + _caseId + -- copy rule (chain) + _declarationsOgUniq = + _importdeclarationsIgUniq + -- copy rule (from local) + _declarationsOidGam = + _idGam + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _declarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (from local) + _declarationsOpragmas = + _pragmas + -- copy rule (chain) + _declarationsOtopInstanceNmL = + _importdeclarationsItopInstanceNmL + ( _importdeclarationsIerrSq,_importdeclarationsIgUniq,_importdeclarationsIgathFixityGam,_importdeclarationsIidUseOccGam,_importdeclarationsImodAsMp,_importdeclarationsIpp,_importdeclarationsIppWrap,_importdeclarationsItopInstanceNmL,_importdeclarationsIundefOccGam) = + importdeclarations_ _importdeclarationsOfixityGam _importdeclarationsOgUniq _importdeclarationsOidGam _importdeclarationsOisMainMod _importdeclarationsOisTopMod _importdeclarationsOmoduleNm _importdeclarationsOnmLev _importdeclarationsOopts _importdeclarationsOpatchEhNmInInstance _importdeclarationsOtopInstanceNmL + ( _declarationsIeh,_declarationsIerrSq,_declarationsIgUniq,_declarationsIgathFixityGam,_declarationsIgathPragmas,_declarationsIidDefOccGam,_declarationsIidDpdMp,_declarationsIidOccDefs,_declarationsIidTySigDefOccGam,_declarationsIidUseOccGam,_declarationsIneedsError,_declarationsIpp,_declarationsIppWrap,_declarationsItopInstanceNmL,_declarationsIundefOccGam) = + declarations_ _declarationsOcaseId _declarationsOfixityGam _declarationsOgUniq _declarationsOgenerDerivMp _declarationsOidGam _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOpatchEhNmInInstance _declarationsOpragmas _declarationsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOextraModImpL,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathIdGam,_lhsOidUseOccGam,_lhsOmainValExists,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Constructor ------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conAndFldrefnames : AssocL Name Names + conrefnames : Names + eh : EH.DataConstr + errSq : ErrSq + freeTvarS : HsNameS + hasFlds : Bool + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Constructor: + child range : {Range} + child constructor : {Name} + child types : Types + visit 0: + local conrefname : _ + local nmLev : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Infix: + child range : {Range} + child leftType : Type + child constructorOperator : {Name} + child rightType : Type + visit 0: + local conrefname : _ + local nmLev : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Record: + child range : {Range} + child constructor : {Name} + child fieldDeclarations : FieldDeclarations + visit 0: + local conrefname : _ + local conAndFldrefnames : _ + local pp : _ + alternative Contexted: + child range : {Range} + child context : ContextItems + child constructor : Constructor + visit 0: + local pp : _ + alternative GADTFunction: + child range : {Range} + child constructor : {Name} + child type : Type + visit 0: + local conrefname : _ + local nmLev : _ + local pp : _ + local ehArgs : _ + local ehRes : _ + local isAsPred : _ + local doGenVarWild : _ +-} +-- cata +sem_Constructor :: Constructor -> + T_Constructor +sem_Constructor (Constructor_Constructor _range _constructor _types) = + (sem_Constructor_Constructor _range _constructor (sem_Types _types)) +sem_Constructor (Constructor_Infix _range _leftType _constructorOperator _rightType) = + (sem_Constructor_Infix _range (sem_Type _leftType) _constructorOperator (sem_Type _rightType)) +sem_Constructor (Constructor_Record _range _constructor _fieldDeclarations) = + (sem_Constructor_Record _range _constructor (sem_FieldDeclarations _fieldDeclarations)) +sem_Constructor (Constructor_Contexted _range _context _constructor) = + (sem_Constructor_Contexted _range (sem_ContextItems _context) (sem_Constructor _constructor)) +sem_Constructor (Constructor_GADTFunction _range _constructor _type) = + (sem_Constructor_GADTFunction _range _constructor (sem_Type _type)) +-- semantic domain +type T_Constructor = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (AssocL Name Names),Names,(EH.DataConstr),ErrSq,HsNameS,UID,Bool,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Constructor_Constructor :: Range -> + Name -> + T_Types -> + T_Constructor +sem_Constructor_Constructor range_ constructor_ types_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOeh :: (EH.DataConstr) + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOfixityGam :: FixityGam + _typesOgUniq :: UID + _typesOidGam :: IdDefOccGam + _typesOisAsPred :: Bool + _typesOnmLev :: NmLev + _typesOopts :: EHCOpts + _typesOpatchEhNmInInstance :: PatchEhNmInInstance + _typesOtopInstanceNmL :: ([HsName]) + _typesIeh :: ([EH.TyExpr]) + _typesIerrSq :: ErrSq + _typesIfreeTvarS :: HsNameS + _typesIgUniq :: UID + _typesIidUseOccGam :: IdUseOccGam + _typesIpp :: PP_Doc + _typesIppL :: ([PP_Doc]) + _typesIppWrap :: (PP_Doc -> PP_Doc) + _typesItopInstanceNmL :: ([HsName]) + _typesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 71, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 178, column 9) + _pp = + constructor_ >#< ppSpaces _typesIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 307, column 9) + _lhsOeh = + rngLift range_ EH.DataConstr_Constr _conrefname + Nothing + (map (ehPlainDataField emptyRange) _typesIeh) + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 174, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 227, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typesIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typesIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (down) + _typesOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typesOgUniq = + _lhsIgUniq + -- copy rule (down) + _typesOidGam = + _lhsIidGam + -- copy rule (from local) + _typesOisAsPred = + _isAsPred + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (down) + _typesOopts = + _lhsIopts + -- copy rule (down) + _typesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIeh,_typesIerrSq,_typesIfreeTvarS,_typesIgUniq,_typesIidUseOccGam,_typesIpp,_typesIppL,_typesIppWrap,_typesItopInstanceNmL,_typesIundefOccGam) = + types_ _typesOfixityGam _typesOgUniq _typesOidGam _typesOisAsPred _typesOnmLev _typesOopts _typesOpatchEhNmInInstance _typesOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Constructor_Infix :: Range -> + T_Type -> + Name -> + T_Type -> + T_Constructor +sem_Constructor_Infix range_ leftType_ constructorOperator_ rightType_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOeh :: (EH.DataConstr) + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOdoGenVarWild :: Bool + _leftTypeOfixityGam :: FixityGam + _leftTypeOgUniq :: UID + _leftTypeOidGam :: IdDefOccGam + _leftTypeOisAsPred :: Bool + _leftTypeOnmLev :: NmLev + _leftTypeOopts :: EHCOpts + _leftTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _leftTypeOtopInstanceNmL :: ([HsName]) + _rightTypeOdoGenVarWild :: Bool + _rightTypeOfixityGam :: FixityGam + _rightTypeOgUniq :: UID + _rightTypeOidGam :: IdDefOccGam + _rightTypeOisAsPred :: Bool + _rightTypeOnmLev :: NmLev + _rightTypeOopts :: EHCOpts + _rightTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIconNm :: Name + _leftTypeIeh :: (EH.TyExpr) + _leftTypeIehMbAsPr :: (Maybe EH.PrExpr) + _leftTypeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _leftTypeIehMbAsTyPr :: (Maybe EH.TyExpr) + _leftTypeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _leftTypeIerrSq :: ErrSq + _leftTypeIfreeTvarS :: HsNameS + _leftTypeIgUniq :: UID + _leftTypeIidUseOccGam :: IdUseOccGam + _leftTypeImbRefConNm :: (Maybe Name) + _leftTypeIopChain :: (OpChain EH.TyExpr) + _leftTypeIoperatorName :: MaybeName + _leftTypeIpp :: PP_Doc + _leftTypeIppWrap :: (PP_Doc -> PP_Doc) + _leftTypeItopInstanceNmL :: ([HsName]) + _leftTypeItyConIs :: TypeConFixedMeaning + _leftTypeIundefOccGam :: IdUseOccGam + _rightTypeIconNm :: Name + _rightTypeIeh :: (EH.TyExpr) + _rightTypeIehMbAsPr :: (Maybe EH.PrExpr) + _rightTypeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _rightTypeIehMbAsTyPr :: (Maybe EH.TyExpr) + _rightTypeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _rightTypeIerrSq :: ErrSq + _rightTypeIfreeTvarS :: HsNameS + _rightTypeIgUniq :: UID + _rightTypeIidUseOccGam :: IdUseOccGam + _rightTypeImbRefConNm :: (Maybe Name) + _rightTypeIopChain :: (OpChain EH.TyExpr) + _rightTypeIoperatorName :: MaybeName + _rightTypeIpp :: PP_Doc + _rightTypeIppWrap :: (PP_Doc -> PP_Doc) + _rightTypeItopInstanceNmL :: ([HsName]) + _rightTypeItyConIs :: TypeConFixedMeaning + _rightTypeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 66, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructorOperator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 73, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 180, column 9) + _pp = + _leftTypeIpp >#< constructorOperator_ >#< _rightTypeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 319, column 9) + _lhsOeh = + rngLift range_ EH.DataConstr_Constr _conrefname + (let fgi = fixityGamLookup _conrefname _lhsIfixityGam + in Just (fgiPrio fgi, fgiFixity fgi) + ) + (map (ehPlainDataField emptyRange) [_leftTypeIeh,_rightTypeIeh]) + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 174, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 227, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftTypeIerrSq `Seq.union` _rightTypeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _leftTypeIfreeTvarS `Set.union` _rightTypeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftTypeIidUseOccGam `gamAddGam` _rightTypeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftTypeIppWrap . _rightTypeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftTypeIundefOccGam `gamUnion` _rightTypeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (from local) + _leftTypeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _leftTypeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftTypeOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftTypeOidGam = + _lhsIidGam + -- copy rule (from local) + _leftTypeOisAsPred = + _isAsPred + -- copy rule (from local) + _leftTypeOnmLev = + _nmLev + -- copy rule (down) + _leftTypeOopts = + _lhsIopts + -- copy rule (down) + _leftTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _rightTypeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _rightTypeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightTypeOgUniq = + _leftTypeIgUniq + -- copy rule (down) + _rightTypeOidGam = + _lhsIidGam + -- copy rule (from local) + _rightTypeOisAsPred = + _isAsPred + -- copy rule (from local) + _rightTypeOnmLev = + _nmLev + -- copy rule (down) + _rightTypeOopts = + _lhsIopts + -- copy rule (down) + _rightTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _leftTypeItopInstanceNmL + ( _leftTypeIconNm,_leftTypeIeh,_leftTypeIehMbAsPr,_leftTypeIehMbAsPrL,_leftTypeIehMbAsTyPr,_leftTypeIehMbAsTyPrL,_leftTypeIerrSq,_leftTypeIfreeTvarS,_leftTypeIgUniq,_leftTypeIidUseOccGam,_leftTypeImbRefConNm,_leftTypeIopChain,_leftTypeIoperatorName,_leftTypeIpp,_leftTypeIppWrap,_leftTypeItopInstanceNmL,_leftTypeItyConIs,_leftTypeIundefOccGam) = + leftType_ _leftTypeOdoGenVarWild _leftTypeOfixityGam _leftTypeOgUniq _leftTypeOidGam _leftTypeOisAsPred _leftTypeOnmLev _leftTypeOopts _leftTypeOpatchEhNmInInstance _leftTypeOtopInstanceNmL + ( _rightTypeIconNm,_rightTypeIeh,_rightTypeIehMbAsPr,_rightTypeIehMbAsPrL,_rightTypeIehMbAsTyPr,_rightTypeIehMbAsTyPrL,_rightTypeIerrSq,_rightTypeIfreeTvarS,_rightTypeIgUniq,_rightTypeIidUseOccGam,_rightTypeImbRefConNm,_rightTypeIopChain,_rightTypeIoperatorName,_rightTypeIpp,_rightTypeIppWrap,_rightTypeItopInstanceNmL,_rightTypeItyConIs,_rightTypeIundefOccGam) = + rightType_ _rightTypeOdoGenVarWild _rightTypeOfixityGam _rightTypeOgUniq _rightTypeOidGam _rightTypeOisAsPred _rightTypeOnmLev _rightTypeOopts _rightTypeOpatchEhNmInInstance _rightTypeOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Constructor_Record :: Range -> + Name -> + T_FieldDeclarations -> + T_Constructor +sem_Constructor_Record range_ constructor_ fieldDeclarations_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOeh :: (EH.DataConstr) + _lhsOhasFlds :: Bool + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _fieldDeclarationsOfixityGam :: FixityGam + _fieldDeclarationsOgUniq :: UID + _fieldDeclarationsOidGam :: IdDefOccGam + _fieldDeclarationsOmoduleNm :: HsName + _fieldDeclarationsOnmLev :: NmLev + _fieldDeclarationsOopts :: EHCOpts + _fieldDeclarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _fieldDeclarationsOtopInstanceNmL :: ([HsName]) + _fieldDeclarationsIeh :: ([EH.DataField]) + _fieldDeclarationsIerrSq :: ErrSq + _fieldDeclarationsIfldrefnames :: Names + _fieldDeclarationsIfreeTvarS :: HsNameS + _fieldDeclarationsIgUniq :: UID + _fieldDeclarationsIidUseOccGam :: IdUseOccGam + _fieldDeclarationsIpp :: PP_Doc + _fieldDeclarationsIppL :: ([PP_Doc]) + _fieldDeclarationsIppWrap :: (PP_Doc -> PP_Doc) + _fieldDeclarationsItopInstanceNmL :: ([HsName]) + _fieldDeclarationsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 76, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 87, column 9) + _conAndFldrefnames = + [(_conrefname,_fieldDeclarationsIfldrefnames)] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 182, column 9) + _pp = + constructor_ >#< ppCurlysCommas' _fieldDeclarationsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 327, column 9) + _lhsOeh = + rngLift range_ EH.DataConstr_Constr _conrefname + Nothing + _fieldDeclarationsIeh + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 241, column 9) + _lhsOhasFlds = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _conAndFldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _fieldDeclarationsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _fieldDeclarationsIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _fieldDeclarationsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _fieldDeclarationsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _fieldDeclarationsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _fieldDeclarationsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _fieldDeclarationsItopInstanceNmL + -- copy rule (down) + _fieldDeclarationsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _fieldDeclarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _fieldDeclarationsOidGam = + _lhsIidGam + -- copy rule (down) + _fieldDeclarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _fieldDeclarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _fieldDeclarationsOopts = + _lhsIopts + -- copy rule (down) + _fieldDeclarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _fieldDeclarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _fieldDeclarationsIeh,_fieldDeclarationsIerrSq,_fieldDeclarationsIfldrefnames,_fieldDeclarationsIfreeTvarS,_fieldDeclarationsIgUniq,_fieldDeclarationsIidUseOccGam,_fieldDeclarationsIpp,_fieldDeclarationsIppL,_fieldDeclarationsIppWrap,_fieldDeclarationsItopInstanceNmL,_fieldDeclarationsIundefOccGam) = + fieldDeclarations_ _fieldDeclarationsOfixityGam _fieldDeclarationsOgUniq _fieldDeclarationsOidGam _fieldDeclarationsOmoduleNm _fieldDeclarationsOnmLev _fieldDeclarationsOopts _fieldDeclarationsOpatchEhNmInInstance _fieldDeclarationsOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Constructor_Contexted :: Range -> + T_ContextItems -> + T_Constructor -> + T_Constructor +sem_Constructor_Contexted range_ context_ constructor_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.DataConstr) + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _constructorOfixityGam :: FixityGam + _constructorOgUniq :: UID + _constructorOidGam :: IdDefOccGam + _constructorOmoduleNm :: HsName + _constructorOnmLev :: NmLev + _constructorOopts :: EHCOpts + _constructorOpatchEhNmInInstance :: PatchEhNmInInstance + _constructorOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _constructorIconAndFldrefnames :: (AssocL Name Names) + _constructorIconrefnames :: Names + _constructorIeh :: (EH.DataConstr) + _constructorIerrSq :: ErrSq + _constructorIfreeTvarS :: HsNameS + _constructorIgUniq :: UID + _constructorIhasFlds :: Bool + _constructorIidUseOccGam :: IdUseOccGam + _constructorIpp :: PP_Doc + _constructorIppWrap :: (PP_Doc -> PP_Doc) + _constructorItopInstanceNmL :: ([HsName]) + _constructorIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 184, column 17) + _pp = + _contextIpp >#< "=>" >#< _constructorIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 332, column 17) + _lhsOeh = + _constructorIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _constructorIconAndFldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + _constructorIconrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _contextIerrSq `Seq.union` _constructorIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _contextIfreeTvarS `Set.union` _constructorIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + _constructorIhasFlds + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _contextIidUseOccGam `gamAddGam` _constructorIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _constructorIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _contextIundefOccGam `gamUnion` _constructorIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _constructorIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _constructorItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (down) + _contextOidGam = + _lhsIidGam + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _constructorOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _constructorOgUniq = + _contextIgUniq + -- copy rule (down) + _constructorOidGam = + _lhsIidGam + -- copy rule (down) + _constructorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _constructorOnmLev = + _lhsInmLev + -- copy rule (down) + _constructorOopts = + _lhsIopts + -- copy rule (down) + _constructorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _constructorOtopInstanceNmL = + _contextItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _constructorIconAndFldrefnames,_constructorIconrefnames,_constructorIeh,_constructorIerrSq,_constructorIfreeTvarS,_constructorIgUniq,_constructorIhasFlds,_constructorIidUseOccGam,_constructorIpp,_constructorIppWrap,_constructorItopInstanceNmL,_constructorIundefOccGam) = + constructor_ _constructorOfixityGam _constructorOgUniq _constructorOidGam _constructorOmoduleNm _constructorOnmLev _constructorOopts _constructorOpatchEhNmInInstance _constructorOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Constructor_GADTFunction :: Range -> + Name -> + T_Type -> + T_Constructor +sem_Constructor_GADTFunction range_ constructor_ type_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOeh :: (EH.DataConstr) + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 71, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 186, column 17) + _pp = + constructor_ >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 312, column 41) + (_ehArgs,_ehRes) = + appUnArr _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 314, column 9) + _lhsOeh = + rngLift range_ EH.DataConstr_Constr _conrefname + Nothing + (map (ehPlainDataField emptyRange) _ehArgs) + (Just _ehRes) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 174, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 227, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Constructors ------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conAndFldrefnames : AssocL Name Names + conrefnames : Names + eh : [EH.DataConstr] + errSq : ErrSq + freeTvarS : HsNameS + hasFlds : Bool + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Constructor + child tl : Constructors + alternative Nil: +-} +-- cata +sem_Constructors :: Constructors -> + T_Constructors +sem_Constructors list = + (Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list)) +-- semantic domain +type T_Constructors = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (AssocL Name Names),Names,([EH.DataConstr]),ErrSq,HsNameS,UID,Bool,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Constructors_Cons :: T_Constructor -> + T_Constructors -> + T_Constructors +sem_Constructors_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOeh :: ([EH.DataConstr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIconAndFldrefnames :: (AssocL Name Names) + _hdIconrefnames :: Names + _hdIeh :: (EH.DataConstr) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIhasFlds :: Bool + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIconAndFldrefnames :: (AssocL Name Names) + _tlIconrefnames :: Names + _tlIeh :: ([EH.DataConstr]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIhasFlds :: Bool + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _hdIconAndFldrefnames ++ _tlIconAndFldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + _hdIconrefnames ++ _tlIconrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 295, column 28) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + _hdIhasFlds || _tlIhasFlds + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconAndFldrefnames,_hdIconrefnames,_hdIeh,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIhasFlds,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIconAndFldrefnames,_tlIconrefnames,_tlIeh,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIhasFlds,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOeh :: ([EH.DataConstr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOhasFlds :: Bool + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 295, column 28) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 237, column 35) + _lhsOhasFlds = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOhasFlds,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextItem ------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.PrExpr + ehTy : EH.TyExpr + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Class: + child range : {Range} + child name : {Name} + child types : Types + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local ehTy : _ + local isAsPred : _ + alternative Forall: + child range : {Range} + child typevariables : {Names} + child context : ContextItem + visit 0: + local idDefOccGamInside : _ + local idGam : _ + local nmLev : _ + local pp : _ + local eh : _ + local ehTy : _ + alternative Arrow: + child range : {Range} + child argument : ContextItem + child result : ContextItem + visit 0: + local pp : _ + local eh : _ + local ehTy : _ + alternative Implicits: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehTy : _ + alternative NoImplicits: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehTy : _ + alternative RowLacksLabel: + child range : {Range} + child rowvariable : {Name} + child name : {Name} + visit 0: + local pp : _ + local eh : _ + local ehTy : _ + alternative Equal: + child range : {Range} + child type1 : Type + child type2 : Type + visit 0: + local pp : _ + local eh : _ + local ehTy : _ + local isAsPred : _ + local doGenVarWild : _ +-} +-- cata +sem_ContextItem :: ContextItem -> + T_ContextItem +sem_ContextItem (ContextItem_Class _range _name _types) = + (sem_ContextItem_Class _range _name (sem_Types _types)) +sem_ContextItem (ContextItem_Forall _range _typevariables _context) = + (sem_ContextItem_Forall _range _typevariables (sem_ContextItem _context)) +sem_ContextItem (ContextItem_Arrow _range _argument _result) = + (sem_ContextItem_Arrow _range (sem_ContextItem _argument) (sem_ContextItem _result)) +sem_ContextItem (ContextItem_Implicits _range) = + (sem_ContextItem_Implicits _range) +sem_ContextItem (ContextItem_NoImplicits _range) = + (sem_ContextItem_NoImplicits _range) +sem_ContextItem (ContextItem_RowLacksLabel _range _rowvariable _name) = + (sem_ContextItem_RowLacksLabel _range _rowvariable _name) +sem_ContextItem (ContextItem_Equal _range _type1 _type2) = + (sem_ContextItem_Equal _range (sem_Type _type1) (sem_Type _type2)) +-- semantic domain +type T_ContextItem = FixityGam -> + UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.PrExpr),(EH.TyExpr),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextItem_Class :: Range -> + Name -> + T_Types -> + T_ContextItem +sem_ContextItem_Class range_ name_ types_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOfixityGam :: FixityGam + _typesOgUniq :: UID + _typesOidGam :: IdDefOccGam + _typesOisAsPred :: Bool + _typesOnmLev :: NmLev + _typesOopts :: EHCOpts + _typesOpatchEhNmInInstance :: PatchEhNmInInstance + _typesOtopInstanceNmL :: ([HsName]) + _typesIeh :: ([EH.TyExpr]) + _typesIerrSq :: ErrSq + _typesIfreeTvarS :: HsNameS + _typesIgUniq :: UID + _typesIidUseOccGam :: IdUseOccGam + _typesIpp :: PP_Doc + _typesIppL :: ([PP_Doc]) + _typesIppWrap :: (PP_Doc -> PP_Doc) + _typesItopInstanceNmL :: ([HsName]) + _typesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 617, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 619, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_typesIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 125, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _typesIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 162, column 9) + _pp = + name_ >#< ppSpaces _typesIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 275, column 9) + _eh = + rngLift range_ EH.PrExpr_Class _refname _typesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 289, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Pred _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 193, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typesIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (down) + _typesOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typesOgUniq = + _lhsIgUniq + -- copy rule (down) + _typesOidGam = + _lhsIidGam + -- copy rule (from local) + _typesOisAsPred = + _isAsPred + -- copy rule (down) + _typesOnmLev = + _lhsInmLev + -- copy rule (down) + _typesOopts = + _lhsIopts + -- copy rule (down) + _typesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIeh,_typesIerrSq,_typesIfreeTvarS,_typesIgUniq,_typesIidUseOccGam,_typesIpp,_typesIppL,_typesIppWrap,_typesItopInstanceNmL,_typesIundefOccGam) = + types_ _typesOfixityGam _typesOgUniq _typesOidGam _typesOisAsPred _typesOnmLev _typesOopts _typesOpatchEhNmInInstance _typesOtopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_Forall :: Range -> + Names -> + T_ContextItem -> + T_ContextItem +sem_ContextItem_Forall range_ typevariables_ context_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOfreeTvarS :: HsNameS + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _contextIeh :: (EH.PrExpr) + _contextIehTy :: (EH.TyExpr) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 259, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _lhsInmLev range_ typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 416, column 9) + _idGam = + gamUnion _idDefOccGamInside _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 46, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 172, column 9) + _pp = + "forall" >#< ppSpaces typevariables_ >#< "." >#< _contextIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 283, column 9) + _eh = + foldr (rngLift range_ EH.PrExpr_Forall) _contextIeh typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 289, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Pred _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 128, column 9) + _lhsOfreeTvarS = + _contextIfreeTvarS `Set.difference` Set.fromList typevariables_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _contextIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _contextIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _contextIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_Arrow :: Range -> + T_ContextItem -> + T_ContextItem -> + T_ContextItem +sem_ContextItem_Arrow range_ argument_ result_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _argumentOfixityGam :: FixityGam + _argumentOgUniq :: UID + _argumentOidGam :: IdDefOccGam + _argumentOnmLev :: NmLev + _argumentOopts :: EHCOpts + _argumentOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentOtopInstanceNmL :: ([HsName]) + _resultOfixityGam :: FixityGam + _resultOgUniq :: UID + _resultOidGam :: IdDefOccGam + _resultOnmLev :: NmLev + _resultOopts :: EHCOpts + _resultOpatchEhNmInInstance :: PatchEhNmInInstance + _resultOtopInstanceNmL :: ([HsName]) + _argumentIeh :: (EH.PrExpr) + _argumentIehTy :: (EH.TyExpr) + _argumentIerrSq :: ErrSq + _argumentIfreeTvarS :: HsNameS + _argumentIgUniq :: UID + _argumentIidUseOccGam :: IdUseOccGam + _argumentIpp :: PP_Doc + _argumentIppWrap :: (PP_Doc -> PP_Doc) + _argumentItopInstanceNmL :: ([HsName]) + _argumentIundefOccGam :: IdUseOccGam + _resultIeh :: (EH.PrExpr) + _resultIehTy :: (EH.TyExpr) + _resultIerrSq :: ErrSq + _resultIfreeTvarS :: HsNameS + _resultIgUniq :: UID + _resultIidUseOccGam :: IdUseOccGam + _resultIpp :: PP_Doc + _resultIppWrap :: (PP_Doc -> PP_Doc) + _resultItopInstanceNmL :: ([HsName]) + _resultIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 170, column 9) + _pp = + _argumentIpp >#< "->" >#< _resultIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 281, column 9) + _eh = + rngLift range_ EH.PrExpr_Arrow _argumentIeh _resultIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 289, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Pred _eh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _argumentIerrSq `Seq.union` _resultIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _argumentIfreeTvarS `Set.union` _resultIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _argumentIidUseOccGam `gamAddGam` _resultIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _argumentIppWrap . _resultIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _argumentIundefOccGam `gamUnion` _resultIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (up) + _lhsOgUniq = + _resultIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _resultItopInstanceNmL + -- copy rule (down) + _argumentOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _argumentOgUniq = + _lhsIgUniq + -- copy rule (down) + _argumentOidGam = + _lhsIidGam + -- copy rule (down) + _argumentOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentOopts = + _lhsIopts + -- copy rule (down) + _argumentOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _argumentOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _resultOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _resultOgUniq = + _argumentIgUniq + -- copy rule (down) + _resultOidGam = + _lhsIidGam + -- copy rule (down) + _resultOnmLev = + _lhsInmLev + -- copy rule (down) + _resultOopts = + _lhsIopts + -- copy rule (down) + _resultOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _resultOtopInstanceNmL = + _argumentItopInstanceNmL + ( _argumentIeh,_argumentIehTy,_argumentIerrSq,_argumentIfreeTvarS,_argumentIgUniq,_argumentIidUseOccGam,_argumentIpp,_argumentIppWrap,_argumentItopInstanceNmL,_argumentIundefOccGam) = + argument_ _argumentOfixityGam _argumentOgUniq _argumentOidGam _argumentOnmLev _argumentOopts _argumentOpatchEhNmInInstance _argumentOtopInstanceNmL + ( _resultIeh,_resultIehTy,_resultIerrSq,_resultIfreeTvarS,_resultIgUniq,_resultIidUseOccGam,_resultIpp,_resultIppWrap,_resultItopInstanceNmL,_resultIundefOccGam) = + result_ _resultOfixityGam _resultOgUniq _resultOidGam _resultOnmLev _resultOopts _resultOpatchEhNmInInstance _resultOtopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_Implicits :: Range -> + T_ContextItem +sem_ContextItem_Implicits range_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 164, column 9) + _pp = + pp "..." + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 277, column 9) + _eh = + undefined + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 291, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Impls + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_NoImplicits :: Range -> + T_ContextItem +sem_ContextItem_NoImplicits range_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 166, column 9) + _pp = + empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 277, column 9) + _eh = + undefined + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 293, column 9) + _ehTy = + rngLift range_ EH.TyExpr_NoImpls + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_RowLacksLabel :: Range -> + Name -> + Name -> + T_ContextItem +sem_ContextItem_RowLacksLabel range_ rowvariable_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOfreeTvarS :: HsNameS + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 168, column 9) + _pp = + name_ >|< "\\" >|< rowvariable_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 279, column 9) + _eh = + rngLift range_ EH.PrExpr_Lacks (rngLift range_ EH.RowTyExpr_Var rowvariable_) name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 289, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Pred _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 130, column 9) + _lhsOfreeTvarS = + Set.singleton rowvariable_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItem_Equal :: Range -> + T_Type -> + T_Type -> + T_ContextItem +sem_ContextItem_Equal range_ type1_ type2_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PrExpr) + _lhsOehTy :: (EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _type1OdoGenVarWild :: Bool + _type1OfixityGam :: FixityGam + _type1OgUniq :: UID + _type1OidGam :: IdDefOccGam + _type1OisAsPred :: Bool + _type1OnmLev :: NmLev + _type1Oopts :: EHCOpts + _type1OpatchEhNmInInstance :: PatchEhNmInInstance + _type1OtopInstanceNmL :: ([HsName]) + _type2OdoGenVarWild :: Bool + _type2OfixityGam :: FixityGam + _type2OgUniq :: UID + _type2OidGam :: IdDefOccGam + _type2OisAsPred :: Bool + _type2OnmLev :: NmLev + _type2Oopts :: EHCOpts + _type2OpatchEhNmInInstance :: PatchEhNmInInstance + _type2OtopInstanceNmL :: ([HsName]) + _type1IconNm :: Name + _type1Ieh :: (EH.TyExpr) + _type1IehMbAsPr :: (Maybe EH.PrExpr) + _type1IehMbAsPrL :: ([Maybe EH.PrExpr]) + _type1IehMbAsTyPr :: (Maybe EH.TyExpr) + _type1IehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _type1IerrSq :: ErrSq + _type1IfreeTvarS :: HsNameS + _type1IgUniq :: UID + _type1IidUseOccGam :: IdUseOccGam + _type1ImbRefConNm :: (Maybe Name) + _type1IopChain :: (OpChain EH.TyExpr) + _type1IoperatorName :: MaybeName + _type1Ipp :: PP_Doc + _type1IppWrap :: (PP_Doc -> PP_Doc) + _type1ItopInstanceNmL :: ([HsName]) + _type1ItyConIs :: TypeConFixedMeaning + _type1IundefOccGam :: IdUseOccGam + _type2IconNm :: Name + _type2Ieh :: (EH.TyExpr) + _type2IehMbAsPr :: (Maybe EH.PrExpr) + _type2IehMbAsPrL :: ([Maybe EH.PrExpr]) + _type2IehMbAsTyPr :: (Maybe EH.TyExpr) + _type2IehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _type2IerrSq :: ErrSq + _type2IfreeTvarS :: HsNameS + _type2IgUniq :: UID + _type2IidUseOccGam :: IdUseOccGam + _type2ImbRefConNm :: (Maybe Name) + _type2IopChain :: (OpChain EH.TyExpr) + _type2IoperatorName :: MaybeName + _type2Ipp :: PP_Doc + _type2IppWrap :: (PP_Doc -> PP_Doc) + _type2ItopInstanceNmL :: ([HsName]) + _type2ItyConIs :: TypeConFixedMeaning + _type2IundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 174, column 9) + _pp = + _type1Ipp >#< hsnEqTilde >#< _type2Ipp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 285, column 9) + _eh = + rngLift range_ EH.PrExpr_Eq _type1Ieh _type2Ieh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 289, column 9) + _ehTy = + rngLift range_ EH.TyExpr_Pred _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 193, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 235, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _type1IerrSq `Seq.union` _type2IerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _type1IfreeTvarS `Set.union` _type2IfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _type1IidUseOccGam `gamAddGam` _type2IidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _type1IppWrap . _type2IppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _type1IundefOccGam `gamUnion` _type2IundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehTy = + _ehTy + -- copy rule (up) + _lhsOgUniq = + _type2IgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _type2ItopInstanceNmL + -- copy rule (from local) + _type1OdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _type1OfixityGam = + _lhsIfixityGam + -- copy rule (down) + _type1OgUniq = + _lhsIgUniq + -- copy rule (down) + _type1OidGam = + _lhsIidGam + -- copy rule (from local) + _type1OisAsPred = + _isAsPred + -- copy rule (down) + _type1OnmLev = + _lhsInmLev + -- copy rule (down) + _type1Oopts = + _lhsIopts + -- copy rule (down) + _type1OpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _type1OtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _type2OdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _type2OfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _type2OgUniq = + _type1IgUniq + -- copy rule (down) + _type2OidGam = + _lhsIidGam + -- copy rule (from local) + _type2OisAsPred = + _isAsPred + -- copy rule (down) + _type2OnmLev = + _lhsInmLev + -- copy rule (down) + _type2Oopts = + _lhsIopts + -- copy rule (down) + _type2OpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _type2OtopInstanceNmL = + _type1ItopInstanceNmL + ( _type1IconNm,_type1Ieh,_type1IehMbAsPr,_type1IehMbAsPrL,_type1IehMbAsTyPr,_type1IehMbAsTyPrL,_type1IerrSq,_type1IfreeTvarS,_type1IgUniq,_type1IidUseOccGam,_type1ImbRefConNm,_type1IopChain,_type1IoperatorName,_type1Ipp,_type1IppWrap,_type1ItopInstanceNmL,_type1ItyConIs,_type1IundefOccGam) = + type1_ _type1OdoGenVarWild _type1OfixityGam _type1OgUniq _type1OidGam _type1OisAsPred _type1OnmLev _type1Oopts _type1OpatchEhNmInInstance _type1OtopInstanceNmL + ( _type2IconNm,_type2Ieh,_type2IehMbAsPr,_type2IehMbAsPrL,_type2IehMbAsTyPr,_type2IehMbAsTyPrL,_type2IerrSq,_type2IfreeTvarS,_type2IgUniq,_type2IidUseOccGam,_type2ImbRefConNm,_type2IopChain,_type2IoperatorName,_type2Ipp,_type2IppWrap,_type2ItopInstanceNmL,_type2ItyConIs,_type2IundefOccGam) = + type2_ _type2OdoGenVarWild _type2OfixityGam _type2OgUniq _type2OidGam _type2OisAsPred _type2OnmLev _type2Oopts _type2OpatchEhNmInInstance _type2OtopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextItems ------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.PrExpr] + ehTy : [EH.TyExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : ContextItem + child tl : ContextItems + alternative Nil: +-} +-- cata +sem_ContextItems :: ContextItems -> + T_ContextItems +sem_ContextItems list = + (Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list)) +-- semantic domain +type T_ContextItems = FixityGam -> + UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.PrExpr]),([EH.TyExpr]),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextItems_Cons :: T_ContextItem -> + T_ContextItems -> + T_ContextItems +sem_ContextItems_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.PrExpr]) + _lhsOehTy :: ([EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.PrExpr) + _hdIehTy :: (EH.TyExpr) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.PrExpr]) + _tlIehTy :: ([EH.TyExpr]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 269, column 28) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 269, column 62) + _lhsOehTy = + _hdIehTy : _tlIehTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIehTy,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIehTy,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.PrExpr]) + _lhsOehTy :: ([EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 269, column 28) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 269, column 62) + _lhsOehTy = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOehTy,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextedExpression ----------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : (EH.Expr,EH.PrExpr) + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Contexted: + child range : {Range} + child expression : Expression + child context : ContextItem + visit 0: + local pp : _ +-} +-- cata +sem_ContextedExpression :: ContextedExpression -> + T_ContextedExpression +sem_ContextedExpression (ContextedExpression_Contexted _range _expression _context) = + (sem_ContextedExpression_Contexted _range (sem_Expression _expression) (sem_ContextItem _context)) +-- semantic domain +type T_ContextedExpression = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ((EH.Expr,EH.PrExpr)),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextedExpression_Contexted :: Range -> + T_Expression -> + T_ContextItem -> + T_ContextedExpression +sem_ContextedExpression_Contexted range_ expression_ context_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ((EH.Expr,EH.PrExpr)) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _contextIeh :: (EH.PrExpr) + _contextIehTy :: (EH.TyExpr) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 259, column 9) + _pp = + _expressionIpp >#< "<:" >#< _contextIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 550, column 9) + _lhsOeh = + (_expressionIeh,_contextIeh) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _contextIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _contextIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _contextIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _contextIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _contextOgUniq = + _expressionIgUniq + -- copy rule (down) + _contextOidGam = + _lhsIidGam + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _contextOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextedExpressions ---------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [(EH.Expr,EH.PrExpr)] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : ContextedExpression + child tl : ContextedExpressions + alternative Nil: +-} +-- cata +sem_ContextedExpressions :: ContextedExpressions -> + T_ContextedExpressions +sem_ContextedExpressions list = + (Prelude.foldr sem_ContextedExpressions_Cons sem_ContextedExpressions_Nil (Prelude.map sem_ContextedExpression list)) +-- semantic domain +type T_ContextedExpressions = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([(EH.Expr,EH.PrExpr)]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextedExpressions_Cons :: T_ContextedExpression -> + T_ContextedExpressions -> + T_ContextedExpressions +sem_ContextedExpressions_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.Expr,EH.PrExpr)]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: ((EH.Expr,EH.PrExpr)) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([(EH.Expr,EH.PrExpr)]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 511, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 544, column 36) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextedExpressions_Nil :: T_ContextedExpressions +sem_ContextedExpressions_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.Expr,EH.PrExpr)]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 513, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 544, column 36) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextedPattern -------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : (EH.PatExpr,EH.PrExpr) + errSq : ErrSq + freeTvarS : HsNameS + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Contexted: + child range : {Range} + child pattern : Pattern + child context : ContextItem + visit 0: + local pp : _ +-} +-- cata +sem_ContextedPattern :: ContextedPattern -> + T_ContextedPattern +sem_ContextedPattern (ContextedPattern_Contexted _range _pattern _context) = + (sem_ContextedPattern_Contexted _range (sem_Pattern _pattern) (sem_ContextItem _context)) +-- semantic domain +type T_ContextedPattern = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ((EH.PatExpr,EH.PrExpr)),ErrSq,HsNameS,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextedPattern_Contexted :: Range -> + T_Pattern -> + T_ContextItem -> + T_ContextedPattern +sem_ContextedPattern_Contexted range_ pattern_ context_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ((EH.PatExpr,EH.PrExpr)) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _contextIeh :: (EH.PrExpr) + _contextIehTy :: (EH.TyExpr) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 372, column 9) + _pp = + _patternIpp >#< "<:" >#< _contextIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 852, column 9) + _lhsOeh = + (_patternIeh,_contextIeh) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq `Seq.union` _contextIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _contextIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam `gamAddGam` _contextIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _contextIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _contextIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _contextOgUniq = + _patternIgUniq + -- copy rule (down) + _contextOidGam = + _lhsIidGam + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _contextOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ContextedPatterns ------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [(EH.PatExpr,EH.PrExpr)] + errSq : ErrSq + freeTvarS : HsNameS + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : ContextedPattern + child tl : ContextedPatterns + alternative Nil: +-} +-- cata +sem_ContextedPatterns :: ContextedPatterns -> + T_ContextedPatterns +sem_ContextedPatterns list = + (Prelude.foldr sem_ContextedPatterns_Cons sem_ContextedPatterns_Nil (Prelude.map sem_ContextedPattern list)) +-- semantic domain +type T_ContextedPatterns = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([(EH.PatExpr,EH.PrExpr)]),ErrSq,HsNameS,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ContextedPatterns_Cons :: T_ContextedPattern -> + T_ContextedPatterns -> + T_ContextedPatterns +sem_ContextedPatterns_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.PatExpr,EH.PrExpr)]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: ((EH.PatExpr,EH.PrExpr)) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidDefOccGam :: IdDefOccGam + _hdIidOccDefs :: ([IdOcc]) + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([(EH.PatExpr,EH.PrExpr)]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidDefOccGam :: IdDefOccGam + _tlIidOccDefs :: ([IdOcc]) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 517, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 846, column 33) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIidDefOccGam,_hdIidOccDefs,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIidDefOccGam,_tlIidOccDefs,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ContextedPatterns_Nil :: T_ContextedPatterns +sem_ContextedPatterns_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.PatExpr,EH.PrExpr)]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 519, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 846, column 33) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Declaration ------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Decl] + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative FunctionBindings: + child range : {Range} + child bindings : FunctionBindings + visit 0: + local idOccDefs : _ + local isAsPred : _ + local doGenVarWild : _ + alternative PatternBinding: + child range : {Range} + child pattern : Pattern + child righthandside : RightHandSide + visit 0: + local idDefOccGamPat : _ + local idDefOccGam : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local idOccDef : _ + local idOccDefsPat : _ + local idOccDefs : _ + local pp : _ + local eh : _ + local caseId : _ + local isAsPred : _ + local doGenVarWild : _ + local lUniq : {UID} + alternative TypeSignature: + child range : {Range} + child names : {Names} + child type : Type + visit 0: + local idDefOccGam : _ + local idDefOccGamType : _ + local idTySigDefOccGam : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local refnames : _ + local idOccDefs : _ + local nmLev : _ + local pp : _ + local mkEHSig : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Fixity: + child range : {Range} + child fixity : {Fixity} + child priority : {Maybe Int} + child operators : {Names} + visit 0: + local idDefOccGam : _ + local patchEhNmInInstance : _ + local oprefnames : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ + alternative FusionDeclaration: + child range : {Range} + child fusename : {Name} + visit 0: + local idDefOccGam : _ + local reffusename : _ + local idUseOccGamFusion : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local idOccDef : _ + local idOccDefs : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local lUniq : {UID} + alternative FusionConversion: + child range : {Range} + child absname : {Name} + child conname : {Name} + visit 0: + local idDefOccGam : _ + local refnames : _ + local idUseOccGamFusion : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local idOccDef : _ + local idOccDefs : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local lUniq : {UID} + alternative Empty: + child range : {Range} + visit 0: + local patchEhNmInInstance : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Data: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructors + child derivings : Derivings + visit 0: + local idDefOccGamType : _ + local idDefOccGamType2 : _ + local idDefOccGamConstrs : _ + local idDefOccGamGener : _ + local idDefOccGam : _ + local idDefOccGamInside : _ + local idGam : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local idUseOccGamClass : _ + local errIdUseClass : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + local errDupIntro : _ + local locErrs : _ + local errSq : _ + local pp : _ + local eh : _ + local ehGener : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Newtype: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructor + child derivings : Derivings + visit 0: + local idDefOccGamType : _ + local idDefOccGamType2 : _ + local idDefOccGamConstrs : _ + local idDefOccGamGener : _ + local idDefOccGam : _ + local idDefOccGamInside : _ + local idGam : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local idUseOccGamClass : _ + local errIdUseClass : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + local errNewtype : _ + local errDupIntro : _ + local locErrs : _ + local errSq : _ + local pp : _ + local eh : _ + local ehGener : _ + local isAsPred : _ + local doGenVarWild : _ + alternative GADT: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructors + child derivings : Derivings + visit 0: + local idDefOccGamType : _ + local idDefOccGamType2 : _ + local idDefOccGamConstrs : _ + local idDefOccGamGener : _ + local idDefOccGam : _ + local idDefOccGamInside : _ + local idGam : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local idUseOccGamClass : _ + local errIdUseClass : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + local errDupIntro : _ + local locErrs : _ + local errSq : _ + local pp : _ + local eh : _ + local ehGener : _ + local isAsPred : _ + local doGenVarWild : _ + alternative KindSignature: + child range : {Range} + child names : {Names} + child kind : Kind + visit 0: + local idDefOccGam : _ + local idDefOccGamKind : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local refnames : _ + local idOccDefs : _ + local nmLev : _ + local pp : _ + local mkEHSig : _ + local isAsPred : _ + local doGenVarWild : _ + alternative ForeignImport: + child range : {Range} + child callconvention : {FFIWay} + child safety : {Maybe String} + child importname : {Maybe String} + child name : {Name} + child type : Type + visit 0: + local idDefOccGamType : _ + local idDefOccGam : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local refname : _ + local idOccDef : _ + local idOccDefs : _ + local errFFIWay : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local nmForParse : _ + local ent : _ + local entErrs : _ + alternative ForeignExport: + child range : {Range} + child callconvention : {FFIWay} + child exportname : {Maybe String} + child name : {Name} + child type : Type + visit 0: + local idDefOccGamType : _ + local idDefOccGam : _ + local refname : _ + local idUseOccGamExport : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local exportrefname : _ + local idOccDef : _ + local idOccDefs : _ + local errFFIWay : _ + local errSq : _ + local pp : _ + local nmForParse : _ + local ent : _ + local entErrs : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Class: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child dependencies : FunctionalDependencies + child where : MaybeDeclarations + visit 0: + local idDefOccGamType : _ + local idDefOccGamSigAsVar : _ + local idDefOccGam : _ + local idDefOccGamInside : _ + local idGam : _ + local idDefOccGamInstForClass : _ + local idUseOccGamExtra : _ + local errIdUseExtra : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local ehReorderedDecls : _ + local errReorder : _ + local patchEhNmInInstance : _ + local instancerefname : _ + local classrefname : _ + local extranames : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefsSig : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local ehInst : _ + local isAsPred : _ + local doGenVarWild : _ + local mbPrevInstancename : _ + local generDerivInfoL : _ + local lUniq : {UID} + alternative Instance: + child range : {Range} + child instVariant : {InstVariant} + child maybeinstancename : {MaybeName} + child useimplicitly : {Bool} + child context : ContextItems + child type : Type + child where : MaybeDeclarations + visit 0: + local idDefOccGamType : _ + local idDefOccGam : _ + local idGam : _ + local classrefname : _ + local idUseOccGamInst : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local ehReorderedDecls : _ + local errReorder : _ + local instancerefname : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local mbPrevInstancename : _ + local lUniq : {UID} + alternative InstanceUseImplicitly: + child range : {Range} + child expression : Expression + child name : {Name} + child types : Types + visit 0: + local idDefOccGam : _ + local classrefname : _ + local idUseOccGamInst : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local instancerefname : _ + local idOccDef : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local mbPrevInstancename : _ + local lUniq : {UID} + alternative Default: + child range : {Range} + child name : {MaybeName} + child types : Types + visit 0: + local idDefOccGam : _ + local classrefname : _ + local classrefnames : _ + local idUseOccGamDflt : _ + local errIdUse : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local idOccDef : _ + local idOccDefs : _ + local defaultname : _ + local nmLev : _ + local errSq : _ + local pp : _ + local ignoredecl : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local lUniq : {UID} + alternative Type: + child range : {Range} + child typelefthandside : TypeLeftHandSide + child type : Type + visit 0: + local idDefOccGamType : _ + local idDefOccGam : _ + local idDefOccGamInside : _ + local idGam : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local patchEhNmInInstance : _ + local typerefname : _ + local idOccDef : _ + local idOccDefs : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Pragma: + child range : {Range} + child pragma : Pragma + visit 0: + local patchEhNmInInstance : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Module: + child range : {Range} + child name : {MaybeName} + child exports : MaybeExports + visit 0: + local patchEhNmInInstance : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + local isMainMod : _ + local isTopMod : _ +-} +-- cata +sem_Declaration :: Declaration -> + T_Declaration +sem_Declaration (Declaration_FunctionBindings _range _bindings) = + (sem_Declaration_FunctionBindings _range (sem_FunctionBindings _bindings)) +sem_Declaration (Declaration_PatternBinding _range _pattern _righthandside) = + (sem_Declaration_PatternBinding _range (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Declaration (Declaration_TypeSignature _range _names _type) = + (sem_Declaration_TypeSignature _range _names (sem_Type _type)) +sem_Declaration (Declaration_Fixity _range _fixity _priority _operators) = + (sem_Declaration_Fixity _range _fixity _priority _operators) +sem_Declaration (Declaration_FusionDeclaration _range _fusename) = + (sem_Declaration_FusionDeclaration _range _fusename) +sem_Declaration (Declaration_FusionConversion _range _absname _conname) = + (sem_Declaration_FusionConversion _range _absname _conname) +sem_Declaration (Declaration_Empty _range) = + (sem_Declaration_Empty _range) +sem_Declaration (Declaration_Data _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_Data _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructors _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_Newtype _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_Newtype _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructor _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_GADT _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_GADT _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructors _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_KindSignature _range _names _kind) = + (sem_Declaration_KindSignature _range _names (sem_Kind _kind)) +sem_Declaration (Declaration_ForeignImport _range _callconvention _safety _importname _name _type) = + (sem_Declaration_ForeignImport _range _callconvention _safety _importname _name (sem_Type _type)) +sem_Declaration (Declaration_ForeignExport _range _callconvention _exportname _name _type) = + (sem_Declaration_ForeignExport _range _callconvention _exportname _name (sem_Type _type)) +sem_Declaration (Declaration_Class _range _context _typelefthandside _dependencies _where) = + (sem_Declaration_Class _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_FunctionalDependencies _dependencies) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_Instance _range _instVariant _maybeinstancename _useimplicitly _context _type _where) = + (sem_Declaration_Instance _range _instVariant _maybeinstancename _useimplicitly (sem_ContextItems _context) (sem_Type _type) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_InstanceUseImplicitly _range _expression _name _types) = + (sem_Declaration_InstanceUseImplicitly _range (sem_Expression _expression) _name (sem_Types _types)) +sem_Declaration (Declaration_Default _range _name _types) = + (sem_Declaration_Default _range _name (sem_Types _types)) +sem_Declaration (Declaration_Type _range _typelefthandside _type) = + (sem_Declaration_Type _range (sem_TypeLeftHandSide _typelefthandside) (sem_Type _type)) +sem_Declaration (Declaration_Pragma _range _pragma) = + (sem_Declaration_Pragma _range (sem_Pragma _pragma)) +sem_Declaration (Declaration_Module _range _name _exports) = + (sem_Declaration_Module _range _name (sem_MaybeExports _exports)) +-- semantic domain +type T_Declaration = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Decl]),ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Declaration_FunctionBindings :: Range -> + T_FunctionBindings -> + T_Declaration +sem_Declaration_FunctionBindings range_ bindings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _bindingsOcaseId :: UID + _bindingsOfixityGam :: FixityGam + _bindingsOgUniq :: UID + _bindingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _bindingsOidGam :: IdDefOccGam + _bindingsOmoduleNm :: HsName + _bindingsOnmLev :: NmLev + _bindingsOopts :: EHCOpts + _bindingsOpatchEhNmInInstance :: PatchEhNmInInstance + _bindingsOpragmas :: (Set.Set Pragma.Pragma) + _bindingsOtopInstanceNmL :: ([HsName]) + _bindingsIeh :: ([EH.Decl]) + _bindingsIerrSq :: ErrSq + _bindingsIgUniq :: UID + _bindingsIidDefOccGam :: IdDefOccGam + _bindingsIidDpdMp :: IdDpdMp + _bindingsIidOccDefs :: ([IdOcc]) + _bindingsIidUseOccGam :: IdUseOccGam + _bindingsIpp :: PP_Doc + _bindingsIppWrap :: (PP_Doc -> PP_Doc) + _bindingsItopInstanceNmL :: ([HsName]) + _bindingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 115, column 9) + _idOccDefs = + _bindingsIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 76, column 9) + _lhsOeh = + _bindingsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _bindingsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _bindingsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _bindingsIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _bindingsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _bindingsIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _bindingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _bindingsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _bindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _bindingsItopInstanceNmL + -- copy rule (down) + _bindingsOcaseId = + _lhsIcaseId + -- copy rule (down) + _bindingsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _bindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _bindingsOidGam = + _lhsIidGam + -- copy rule (down) + _bindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _bindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _bindingsOopts = + _lhsIopts + -- copy rule (down) + _bindingsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _bindingsOpragmas = + _lhsIpragmas + -- copy rule (down) + _bindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _bindingsIeh,_bindingsIerrSq,_bindingsIgUniq,_bindingsIidDefOccGam,_bindingsIidDpdMp,_bindingsIidOccDefs,_bindingsIidUseOccGam,_bindingsIpp,_bindingsIppWrap,_bindingsItopInstanceNmL,_bindingsIundefOccGam) = + bindings_ _bindingsOcaseId _bindingsOfixityGam _bindingsOgUniq _bindingsOgenerDerivMp _bindingsOidGam _bindingsOmoduleNm _bindingsOnmLev _bindingsOopts _bindingsOpatchEhNmInInstance _bindingsOpragmas _bindingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_PatternBinding :: Range -> + T_Pattern -> + T_RightHandSide -> + T_Declaration +sem_Declaration_PatternBinding range_ pattern_ righthandside_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _righthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _righthandsideOsepPP :: PP_Doc + _lhsOeh :: ([EH.Decl]) + _righthandsideOmustBeMono :: Bool + _patternOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _righthandsideOcaseId :: UID + _righthandsideOfixityGam :: FixityGam + _righthandsideOgUniq :: UID + _righthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _righthandsideOidGam :: IdDefOccGam + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOpragmas :: (Set.Set Pragma.Pragma) + _righthandsideOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _righthandsideIeh :: (EH.Expr) + _righthandsideIerrSq :: ErrSq + _righthandsideIgUniq :: UID + _righthandsideIidUseOccGam :: IdUseOccGam + _righthandsideIpp :: PP_Doc + _righthandsideIppWrap :: (PP_Doc -> PP_Doc) + _righthandsideItopInstanceNmL :: ([HsName]) + _righthandsideIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 140, column 9) + _idDefOccGamPat = + mkDefOccGam _lhsInmLev range_ (IdAsp_Val_Pat _eh) _idOccDefsPat + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 140, column 9) + _idDefOccGam = + _idDefOccGamPat `gamAddGam` _patternIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 746, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_patternIidUseOccGam,_righthandsideIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 746, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + `idDpdMpUnion` + idToOccL2DpdMp [_idOccDef] (gamToAssocL _patternIidDefOccGam) + `idDpdMpUnion` + idFrOccGam2DpdMp _patternIidDefOccGam [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 754, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_righthandsideIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1074, column 9) + _righthandsideOpatchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDef = + IdOcc (maybe (mkHNm _lUniq) id _patternImbTopRefname) IdOcc_Pat + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDefsPat = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDefs = + _patternIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 29, column 9) + _pp = + _patternIpp >#< _righthandsideIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 30, column 9) + _righthandsideOsepPP = + pp "=" + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 78, column 9) + _eh = + rngLift range_ EH.Decl_Val _patternIeh _righthandsideIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 79, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 877, column 9) + _caseId = + _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 270, column 9) + _righthandsideOmustBeMono = + not _patternIisVar + -- -- generated by the unique rule mechanism. + (_patternOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq `Seq.union` _righthandsideIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _righthandsideIppWrap + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _righthandsideOcaseId = + _caseId + -- copy rule (down) + _righthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _righthandsideOgUniq = + _patternIgUniq + -- copy rule (down) + _righthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _righthandsideOidGam = + _lhsIidGam + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _righthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (down) + _righthandsideOpragmas = + _lhsIpragmas + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _righthandsideIeh,_righthandsideIerrSq,_righthandsideIgUniq,_righthandsideIidUseOccGam,_righthandsideIpp,_righthandsideIppWrap,_righthandsideItopInstanceNmL,_righthandsideIundefOccGam) = + righthandside_ _righthandsideOcaseId _righthandsideOfixityGam _righthandsideOgUniq _righthandsideOgenerDerivMp _righthandsideOidGam _righthandsideOmoduleNm _righthandsideOmustBeMono _righthandsideOnmLev _righthandsideOopts _righthandsideOpatchEhNmInInstance _righthandsideOpragmas _righthandsideOsepPP _righthandsideOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_TypeSignature :: Range -> + Names -> + T_Type -> + T_Declaration +sem_Declaration_TypeSignature range_ names_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 134, column 9) + _idDefOccGam = + mkDefOccGam' _lhsInmLev range_ (\o -> IdAsp_Val_Sig (_mkEHSig (ioccNm o))) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 134, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _nmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 274, column 9) + _idTySigDefOccGam = + mkDefOccGam' _lhsInmLev range_ (\o -> IdAsp_Val_Var) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 366, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 741, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _typeIidUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 741, column 9) + _idDpdMp = + idToOccL2DpdMp (gamKeys _idDefOccGam) _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 744, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_typeIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 14, column 9) + _refnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 113, column 9) + _idOccDefs = + [ IdOcc n IdOcc_Val | n <- _refnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 17, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 33, column 9) + _pp = + ppCommas' names_ >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 81, column 9) + _mkEHSig = + \n -> rngLift range_ EH.Decl_TySig n _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 82, column 9) + _lhsOeh = + map _mkEHSig _refnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _idTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (from local) + _typeOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Fixity :: Range -> + Fixity -> + (Maybe Int) -> + Names -> + T_Declaration +sem_Declaration_Fixity range_ fixity_ priority_ operators_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOgathFixityGam :: FixityGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 138, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ IdAsp_Val_Fix [ IdOcc n IdOcc_Val | n <- _oprefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 12, column 9) + _oprefnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) operators_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 35, column 9) + _pp = + fixity_ >#< maybe empty pp priority_ >#< ppCommas' operators_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 16, column 9) + _lhsOgathFixityGam = + let p = maybe (fgiPrio defaultFixityGamInfo) id priority_ + mk n = (n,FixityGamInfo p fixity_) + in assocLToGam $ map mk $ _oprefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 84, column 9) + _lhsOeh = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_FusionDeclaration :: Range -> + Name -> + T_Declaration +sem_Declaration_FusionDeclaration range_ fusename_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 201, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Val_Fusion _eh) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 682, column 29) + (_reffusename,_,_idUseOccGamFusion,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [fusename_] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 832, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _idUseOccGamFusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 832, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 835, column 9) + _lhsOundefOccGam = + _undefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDef = + IdOcc (mkHNm _lUniq) IdOcc_Fusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 158, column 17) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 71, column 9) + _pp = + "fuse" >#< fusename_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 99, column 9) + _eh = + rngLift range_ EH.Decl_FusionDecl _reffusename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 103, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_FusionConversion :: Range -> + Name -> + Name -> + T_Declaration +sem_Declaration_FusionConversion range_ absname_ conname_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 203, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Fusion_Conv _eh) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 685, column 29) + (_,_refnames,_idUseOccGamFusion,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [conname_,absname_] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 832, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _idUseOccGamFusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 832, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 835, column 9) + _lhsOundefOccGam = + _undefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDef = + IdOcc (mkHNm _lUniq) IdOcc_Fusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 158, column 17) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 73, column 9) + _pp = + "convert" >#< ppCommas [conname_, absname_] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 101, column 9) + _eh = + rngLift range_ EH.Decl_FusionConv (_refnames !! 0) (_refnames !! 1) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 103, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Empty :: Range -> + T_Declaration +sem_Declaration_Empty range_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 37, column 9) + _pp = + empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 86, column 9) + _lhsOeh = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Data :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructors -> + T_Derivings -> + T_Declaration +sem_Declaration_Data range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOneedsError :: Bool + _derivingsOidOccDefData :: IdOcc + _lhsOeh :: ([EH.Decl]) + _derivingsOehDataTyExpr :: (EH.TyExpr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOfixityGam :: FixityGam + _typelefthandsideOgUniq :: UID + _typelefthandsideOidGam :: IdDefOccGam + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOopts :: EHCOpts + _typelefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOfixityGam :: FixityGam + _constructorsOgUniq :: UID + _constructorsOidGam :: IdDefOccGam + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOopts :: EHCOpts + _constructorsOpatchEhNmInInstance :: PatchEhNmInInstance + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOfixityGam :: FixityGam + _derivingsOgUniq :: UID + _derivingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _derivingsOidGam :: IdDefOccGam + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOpatchEhNmInInstance :: PatchEhNmInInstance + _derivingsOpragmas :: (Set.Set Pragma.Pragma) + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typelefthandsideIeh :: ([EH.TyVar]) + _typelefthandsideIerrSq :: ErrSq + _typelefthandsideIfreeTvarS :: HsNameS + _typelefthandsideIgUniq :: UID + _typelefthandsideIidDefOccGam :: IdDefOccGam + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIidUseOccGam :: IdUseOccGam + _typelefthandsideIname :: Name + _typelefthandsideIpp :: PP_Doc + _typelefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typelefthandsideIundefOccGam :: IdUseOccGam + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIeh :: ([EH.DataConstr]) + _constructorsIerrSq :: ErrSq + _constructorsIfreeTvarS :: HsNameS + _constructorsIgUniq :: UID + _constructorsIhasFlds :: Bool + _constructorsIidUseOccGam :: IdUseOccGam + _constructorsIpp :: PP_Doc + _constructorsIppWrap :: (PP_Doc -> PP_Doc) + _constructorsItopInstanceNmL :: ([HsName]) + _constructorsIundefOccGam :: IdUseOccGam + _derivingsIerrSq :: ErrSq + _derivingsIgUniq :: UID + _derivingsIgathFixityGam :: FixityGam + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidDefOccGam :: IdDefOccGam + _derivingsIidDpdMp :: IdDpdMp + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsIidTySigDefOccGam :: IdDefOccGam + _derivingsIidUseOccGam :: IdUseOccGam + _derivingsIneedsError :: Bool + _derivingsIpp :: PP_Doc + _derivingsIppL :: ([PP_Doc]) + _derivingsIppWrap :: (PP_Doc -> PP_Doc) + _derivingsItopInstanceNmL :: ([HsName]) + _derivingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _nmLev _typelefthandsideIrange _constructorsIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType2 = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamConstrs = + mkDefOccGam _lhsInmLev _typelefthandsideIrange IdAsp_Val_Con _idOccDefsCon + `gamAddGam` + mkDefOccGam'' _lhsInmLev _typelefthandsideIrange (\c _ -> IdAsp_Val_Fld _typerefname c) + (concat [ [(c,IdOcc n IdOcc_Val), (c,IdOcc n IdOcc_Fld)] | (c,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamGener = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _ehGener) _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _eh) [_idOccDef] + `gamAddGam` _idDefOccGamConstrs + `gamAddGam` _derivingsIidDefOccGam + `gamAddGam` _idDefOccGamGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 191, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 370, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 662, column 29) + (_,_,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 675, column 29) + (_,_,_idUseOccGamClass,_errIdUseClass) = + mkUseOccGam _lhsIopts _lhsIidGam + (if ehcOptGenGenerics _lhsIopts then builtinGenerClassNmL else []) + IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 697, column 9) + _lhsOneedsError = + _constructorsIhasFlds + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions + [ _constructorsIidUseOccGam + , _idUseOccGamVal + , _contextIidUseOccGam + , _idUseOccGamClass + ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamConstrs [_idOccDef] + `idDpdMpUnion` + _derivingsIidDpdMp + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamGener [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 873, column 9) + _derivingsOidOccDefData = + _idOccDef + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 117, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamType2 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 72, column 9) + _locErrs = + Seq.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 77, column 9) + _errSq = + Seq.unions [ _locErrs + , _typelefthandsideIerrSq + , Seq.fromList _errDupIntro + , Seq.fromList _errIdUseVal + , _constructorsIerrSq + , _contextIerrSq + , _derivingsIerrSq + , Seq.fromList _errIdUseClass + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 39, column 9) + _pp = + "data" >#< _typelefthandsideIpp + >#< "=" >#< _constructorsIpp + >-< ppParensCommas _derivingsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 89, column 9) + _eh = + rngLift range_ EH.Decl_Data False _typerefname (map (rngLift range_ EH.TyVar_Var) _typelefthandsideItypevariables) _constructorsIeh + (if ehcOptGenGenerics _lhsIopts then Just _generMaxRemArity else Nothing) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 91, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 97, column 9) + _ehGener = + rngLift range_ EH.Decl_GenerRep _generMaxRemArity _typerefname _constructorsIconrefnames _constructorsIconAndFldrefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 164, column 9) + _derivingsOehDataTyExpr = + appTopApp (rngLift range_ EH.TyExpr_Con _typerefname : map (rngLift range_ EH.TyExpr_Var) _typelefthandsideItypevariables) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _derivingsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _derivingsIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typelefthandsideIppWrap . _constructorsIppWrap . _derivingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _undefOccGam + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (from local) + _contextOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typelefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (from local) + _typelefthandsideOidGam = + _idGam + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOopts = + _lhsIopts + -- copy rule (from local) + _typelefthandsideOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _constructorsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (from local) + _constructorsOidGam = + _idGam + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (down) + _constructorsOopts = + _lhsIopts + -- copy rule (from local) + _constructorsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (down) + _derivingsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _derivingsOidGam = + _idGam + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (from local) + _derivingsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _derivingsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typelefthandsideIeh,_typelefthandsideIerrSq,_typelefthandsideIfreeTvarS,_typelefthandsideIgUniq,_typelefthandsideIidDefOccGam,_typelefthandsideIidOccDefs,_typelefthandsideIidUseOccGam,_typelefthandsideIname,_typelefthandsideIpp,_typelefthandsideIppWrap,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables,_typelefthandsideIundefOccGam) = + typelefthandside_ _typelefthandsideOfixityGam _typelefthandsideOgUniq _typelefthandsideOidGam _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOopts _typelefthandsideOpatchEhNmInInstance _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIeh,_constructorsIerrSq,_constructorsIfreeTvarS,_constructorsIgUniq,_constructorsIhasFlds,_constructorsIidUseOccGam,_constructorsIpp,_constructorsIppWrap,_constructorsItopInstanceNmL,_constructorsIundefOccGam) = + constructors_ _constructorsOfixityGam _constructorsOgUniq _constructorsOidGam _constructorsOmoduleNm _constructorsOnmLev _constructorsOopts _constructorsOpatchEhNmInInstance _constructorsOtopInstanceNmL + ( _derivingsIerrSq,_derivingsIgUniq,_derivingsIgathFixityGam,_derivingsIgathPragmas,_derivingsIidDefOccGam,_derivingsIidDpdMp,_derivingsIidOccDefs,_derivingsIidTySigDefOccGam,_derivingsIidUseOccGam,_derivingsIneedsError,_derivingsIpp,_derivingsIppL,_derivingsIppWrap,_derivingsItopInstanceNmL,_derivingsIundefOccGam) = + derivings_ _derivingsOehDataTyExpr _derivingsOfixityGam _derivingsOgUniq _derivingsOgenerDerivMp _derivingsOidGam _derivingsOidOccDefData _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOpatchEhNmInInstance _derivingsOpragmas _derivingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Newtype :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructor -> + T_Derivings -> + T_Declaration +sem_Declaration_Newtype range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _derivingsOidOccDefData :: IdOcc + _lhsOeh :: ([EH.Decl]) + _derivingsOehDataTyExpr :: (EH.TyExpr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOfixityGam :: FixityGam + _typelefthandsideOgUniq :: UID + _typelefthandsideOidGam :: IdDefOccGam + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOopts :: EHCOpts + _typelefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOfixityGam :: FixityGam + _constructorsOgUniq :: UID + _constructorsOidGam :: IdDefOccGam + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOopts :: EHCOpts + _constructorsOpatchEhNmInInstance :: PatchEhNmInInstance + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOfixityGam :: FixityGam + _derivingsOgUniq :: UID + _derivingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _derivingsOidGam :: IdDefOccGam + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOpatchEhNmInInstance :: PatchEhNmInInstance + _derivingsOpragmas :: (Set.Set Pragma.Pragma) + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typelefthandsideIeh :: ([EH.TyVar]) + _typelefthandsideIerrSq :: ErrSq + _typelefthandsideIfreeTvarS :: HsNameS + _typelefthandsideIgUniq :: UID + _typelefthandsideIidDefOccGam :: IdDefOccGam + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIidUseOccGam :: IdUseOccGam + _typelefthandsideIname :: Name + _typelefthandsideIpp :: PP_Doc + _typelefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typelefthandsideIundefOccGam :: IdUseOccGam + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIeh :: (EH.DataConstr) + _constructorsIerrSq :: ErrSq + _constructorsIfreeTvarS :: HsNameS + _constructorsIgUniq :: UID + _constructorsIhasFlds :: Bool + _constructorsIidUseOccGam :: IdUseOccGam + _constructorsIpp :: PP_Doc + _constructorsIppWrap :: (PP_Doc -> PP_Doc) + _constructorsItopInstanceNmL :: ([HsName]) + _constructorsIundefOccGam :: IdUseOccGam + _derivingsIerrSq :: ErrSq + _derivingsIgUniq :: UID + _derivingsIgathFixityGam :: FixityGam + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidDefOccGam :: IdDefOccGam + _derivingsIidDpdMp :: IdDpdMp + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsIidTySigDefOccGam :: IdDefOccGam + _derivingsIidUseOccGam :: IdUseOccGam + _derivingsIneedsError :: Bool + _derivingsIpp :: PP_Doc + _derivingsIppL :: ([PP_Doc]) + _derivingsIppWrap :: (PP_Doc -> PP_Doc) + _derivingsItopInstanceNmL :: ([HsName]) + _derivingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _nmLev _typelefthandsideIrange _constructorsIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType2 = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamConstrs = + mkDefOccGam _lhsInmLev _typelefthandsideIrange IdAsp_Val_Con _idOccDefsCon + `gamAddGam` + mkDefOccGam'' _lhsInmLev _typelefthandsideIrange (\c _ -> IdAsp_Val_Fld _typerefname c) + (concat [ [(c,IdOcc n IdOcc_Val), (c,IdOcc n IdOcc_Fld)] | (c,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamGener = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _ehGener) _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _eh) [_idOccDef] + `gamAddGam` _idDefOccGamConstrs + `gamAddGam` _derivingsIidDefOccGam + `gamAddGam` _idDefOccGamGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 191, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 370, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 665, column 29) + (_,_,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnPrelId] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 675, column 29) + (_,_,_idUseOccGamClass,_errIdUseClass) = + mkUseOccGam _lhsIopts _lhsIidGam + (if ehcOptGenGenerics _lhsIopts then builtinGenerClassNmL else []) + IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions + [ _constructorsIidUseOccGam + , _idUseOccGamVal + , _contextIidUseOccGam + , _idUseOccGamClass + ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamConstrs [_idOccDef] + `idDpdMpUnion` + _derivingsIidDpdMp + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamGener [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 873, column 9) + _derivingsOidOccDefData = + _idOccDef + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 30, column 9) + _errNewtype = + case _constructorsIeh of + EH.DataConstr_Constr _ + _ + _ + [_] + _ + -> [] + _ -> [rngLift range_ Err_Newtype _typelefthandsideIname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 117, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamType2 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 74, column 9) + _locErrs = + Seq.fromList _errNewtype + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 77, column 9) + _errSq = + Seq.unions [ _locErrs + , _typelefthandsideIerrSq + , Seq.fromList _errDupIntro + , Seq.fromList _errIdUseVal + , _constructorsIerrSq + , _contextIerrSq + , _derivingsIerrSq + , Seq.fromList _errIdUseClass + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 43, column 9) + _pp = + "newtype" >#< _typelefthandsideIpp + >#< "=" >#< _constructorsIpp + >-< ppParensCommas _derivingsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 93, column 9) + _eh = + rngLift range_ EH.Decl_Data True _typerefname (map (rngLift range_ EH.TyVar_Var) _typelefthandsideItypevariables) [_constructorsIeh] + (if ehcOptGenGenerics _lhsIopts then Just _generMaxRemArity else Nothing) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 95, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 97, column 9) + _ehGener = + rngLift range_ EH.Decl_GenerRep _generMaxRemArity _typerefname _constructorsIconrefnames _constructorsIconAndFldrefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 164, column 9) + _derivingsOehDataTyExpr = + appTopApp (rngLift range_ EH.TyExpr_Con _typerefname : map (rngLift range_ EH.TyExpr_Var) _typelefthandsideItypevariables) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _derivingsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _derivingsIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _derivingsIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typelefthandsideIppWrap . _constructorsIppWrap . _derivingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _undefOccGam + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (from local) + _contextOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typelefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (from local) + _typelefthandsideOidGam = + _idGam + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOopts = + _lhsIopts + -- copy rule (from local) + _typelefthandsideOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _constructorsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (from local) + _constructorsOidGam = + _idGam + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (down) + _constructorsOopts = + _lhsIopts + -- copy rule (from local) + _constructorsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (down) + _derivingsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _derivingsOidGam = + _idGam + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (from local) + _derivingsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _derivingsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typelefthandsideIeh,_typelefthandsideIerrSq,_typelefthandsideIfreeTvarS,_typelefthandsideIgUniq,_typelefthandsideIidDefOccGam,_typelefthandsideIidOccDefs,_typelefthandsideIidUseOccGam,_typelefthandsideIname,_typelefthandsideIpp,_typelefthandsideIppWrap,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables,_typelefthandsideIundefOccGam) = + typelefthandside_ _typelefthandsideOfixityGam _typelefthandsideOgUniq _typelefthandsideOidGam _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOopts _typelefthandsideOpatchEhNmInInstance _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIeh,_constructorsIerrSq,_constructorsIfreeTvarS,_constructorsIgUniq,_constructorsIhasFlds,_constructorsIidUseOccGam,_constructorsIpp,_constructorsIppWrap,_constructorsItopInstanceNmL,_constructorsIundefOccGam) = + constructors_ _constructorsOfixityGam _constructorsOgUniq _constructorsOidGam _constructorsOmoduleNm _constructorsOnmLev _constructorsOopts _constructorsOpatchEhNmInInstance _constructorsOtopInstanceNmL + ( _derivingsIerrSq,_derivingsIgUniq,_derivingsIgathFixityGam,_derivingsIgathPragmas,_derivingsIidDefOccGam,_derivingsIidDpdMp,_derivingsIidOccDefs,_derivingsIidTySigDefOccGam,_derivingsIidUseOccGam,_derivingsIneedsError,_derivingsIpp,_derivingsIppL,_derivingsIppWrap,_derivingsItopInstanceNmL,_derivingsIundefOccGam) = + derivings_ _derivingsOehDataTyExpr _derivingsOfixityGam _derivingsOgUniq _derivingsOgenerDerivMp _derivingsOidGam _derivingsOidOccDefData _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOpatchEhNmInInstance _derivingsOpragmas _derivingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_GADT :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructors -> + T_Derivings -> + T_Declaration +sem_Declaration_GADT range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _derivingsOidOccDefData :: IdOcc + _lhsOeh :: ([EH.Decl]) + _derivingsOehDataTyExpr :: (EH.TyExpr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOfixityGam :: FixityGam + _typelefthandsideOgUniq :: UID + _typelefthandsideOidGam :: IdDefOccGam + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOopts :: EHCOpts + _typelefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOfixityGam :: FixityGam + _constructorsOgUniq :: UID + _constructorsOidGam :: IdDefOccGam + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOopts :: EHCOpts + _constructorsOpatchEhNmInInstance :: PatchEhNmInInstance + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOfixityGam :: FixityGam + _derivingsOgUniq :: UID + _derivingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _derivingsOidGam :: IdDefOccGam + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOpatchEhNmInInstance :: PatchEhNmInInstance + _derivingsOpragmas :: (Set.Set Pragma.Pragma) + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typelefthandsideIeh :: ([EH.TyVar]) + _typelefthandsideIerrSq :: ErrSq + _typelefthandsideIfreeTvarS :: HsNameS + _typelefthandsideIgUniq :: UID + _typelefthandsideIidDefOccGam :: IdDefOccGam + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIidUseOccGam :: IdUseOccGam + _typelefthandsideIname :: Name + _typelefthandsideIpp :: PP_Doc + _typelefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typelefthandsideIundefOccGam :: IdUseOccGam + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIeh :: ([EH.DataConstr]) + _constructorsIerrSq :: ErrSq + _constructorsIfreeTvarS :: HsNameS + _constructorsIgUniq :: UID + _constructorsIhasFlds :: Bool + _constructorsIidUseOccGam :: IdUseOccGam + _constructorsIpp :: PP_Doc + _constructorsIppWrap :: (PP_Doc -> PP_Doc) + _constructorsItopInstanceNmL :: ([HsName]) + _constructorsIundefOccGam :: IdUseOccGam + _derivingsIerrSq :: ErrSq + _derivingsIgUniq :: UID + _derivingsIgathFixityGam :: FixityGam + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidDefOccGam :: IdDefOccGam + _derivingsIidDpdMp :: IdDpdMp + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsIidTySigDefOccGam :: IdDefOccGam + _derivingsIidUseOccGam :: IdUseOccGam + _derivingsIneedsError :: Bool + _derivingsIpp :: PP_Doc + _derivingsIppL :: ([PP_Doc]) + _derivingsIppWrap :: (PP_Doc -> PP_Doc) + _derivingsItopInstanceNmL :: ([HsName]) + _derivingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _nmLev _typelefthandsideIrange _constructorsIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamType2 = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamConstrs = + mkDefOccGam _lhsInmLev _typelefthandsideIrange IdAsp_Val_Con _idOccDefsCon + `gamAddGam` + mkDefOccGam'' _lhsInmLev _typelefthandsideIrange (\c _ -> IdAsp_Val_Fld _typerefname c) + (concat [ [(c,IdOcc n IdOcc_Val), (c,IdOcc n IdOcc_Fld)] | (c,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGamGener = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _ehGener) _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 145, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _eh) [_idOccDef] + `gamAddGam` _idDefOccGamConstrs + `gamAddGam` _derivingsIidDefOccGam + `gamAddGam` _idDefOccGamGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 191, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 370, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 662, column 29) + (_,_,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 675, column 29) + (_,_,_idUseOccGamClass,_errIdUseClass) = + mkUseOccGam _lhsIopts _lhsIidGam + (if ehcOptGenGenerics _lhsIopts then builtinGenerClassNmL else []) + IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions + [ _constructorsIidUseOccGam + , _idUseOccGamVal + , _contextIidUseOccGam + , _idUseOccGamClass + ] + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 757, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamConstrs [_idOccDef] + `idDpdMpUnion` + _derivingsIidDpdMp + `idDpdMpUnion` + idFrOccGam2DpdMp _idDefOccGamGener [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 873, column 9) + _derivingsOidOccDefData = + _idOccDef + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 117, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamType2 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 72, column 9) + _locErrs = + Seq.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 77, column 9) + _errSq = + Seq.unions [ _locErrs + , _typelefthandsideIerrSq + , Seq.fromList _errDupIntro + , Seq.fromList _errIdUseVal + , _constructorsIerrSq + , _contextIerrSq + , _derivingsIerrSq + , Seq.fromList _errIdUseClass + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 47, column 9) + _pp = + "data" >#< _typelefthandsideIpp + >#< "where" + >-< indent 2 (_constructorsIpp + >-< ppParensCommas _derivingsIppL + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 89, column 9) + _eh = + rngLift range_ EH.Decl_Data False _typerefname (map (rngLift range_ EH.TyVar_Var) _typelefthandsideItypevariables) _constructorsIeh + (if ehcOptGenGenerics _lhsIopts then Just _generMaxRemArity else Nothing) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 91, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 97, column 9) + _ehGener = + rngLift range_ EH.Decl_GenerRep _generMaxRemArity _typerefname _constructorsIconrefnames _constructorsIconAndFldrefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 164, column 9) + _derivingsOehDataTyExpr = + appTopApp (rngLift range_ EH.TyExpr_Con _typerefname : map (rngLift range_ EH.TyExpr_Var) _typelefthandsideItypevariables) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _derivingsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _derivingsIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _derivingsIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typelefthandsideIppWrap . _constructorsIppWrap . _derivingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _undefOccGam + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (from local) + _contextOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typelefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (from local) + _typelefthandsideOidGam = + _idGam + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOopts = + _lhsIopts + -- copy rule (from local) + _typelefthandsideOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _constructorsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (from local) + _constructorsOidGam = + _idGam + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (down) + _constructorsOopts = + _lhsIopts + -- copy rule (from local) + _constructorsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (down) + _derivingsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _derivingsOidGam = + _idGam + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (from local) + _derivingsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _derivingsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typelefthandsideIeh,_typelefthandsideIerrSq,_typelefthandsideIfreeTvarS,_typelefthandsideIgUniq,_typelefthandsideIidDefOccGam,_typelefthandsideIidOccDefs,_typelefthandsideIidUseOccGam,_typelefthandsideIname,_typelefthandsideIpp,_typelefthandsideIppWrap,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables,_typelefthandsideIundefOccGam) = + typelefthandside_ _typelefthandsideOfixityGam _typelefthandsideOgUniq _typelefthandsideOidGam _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOopts _typelefthandsideOpatchEhNmInInstance _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIeh,_constructorsIerrSq,_constructorsIfreeTvarS,_constructorsIgUniq,_constructorsIhasFlds,_constructorsIidUseOccGam,_constructorsIpp,_constructorsIppWrap,_constructorsItopInstanceNmL,_constructorsIundefOccGam) = + constructors_ _constructorsOfixityGam _constructorsOgUniq _constructorsOidGam _constructorsOmoduleNm _constructorsOnmLev _constructorsOopts _constructorsOpatchEhNmInInstance _constructorsOtopInstanceNmL + ( _derivingsIerrSq,_derivingsIgUniq,_derivingsIgathFixityGam,_derivingsIgathPragmas,_derivingsIidDefOccGam,_derivingsIidDpdMp,_derivingsIidOccDefs,_derivingsIidTySigDefOccGam,_derivingsIidUseOccGam,_derivingsIneedsError,_derivingsIpp,_derivingsIppL,_derivingsIppWrap,_derivingsItopInstanceNmL,_derivingsIundefOccGam) = + derivings_ _derivingsOehDataTyExpr _derivingsOfixityGam _derivingsOgUniq _derivingsOgenerDerivMp _derivingsOidGam _derivingsOidOccDefData _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOpatchEhNmInInstance _derivingsOpragmas _derivingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_KindSignature :: Range -> + Names -> + T_Kind -> + T_Declaration +sem_Declaration_KindSignature range_ names_ kind_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _kindOidGam :: IdDefOccGam + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOnmLev :: NmLev + _kindOopts :: EHCOpts + _kindOpatchEhNmInInstance :: PatchEhNmInInstance + _kindOtopInstanceNmL :: ([HsName]) + _kindIconNm :: Name + _kindIeh :: (EH.KiExpr) + _kindIerrSq :: ErrSq + _kindIfreeTvarS :: HsNameS + _kindIgUniq :: UID + _kindIidUseOccGam :: IdUseOccGam + _kindIpp :: PP_Doc + _kindIppWrap :: (PP_Doc -> PP_Doc) + _kindItopInstanceNmL :: ([HsName]) + _kindIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 163, column 9) + _idDefOccGam = + mkDefOccGam' _lhsInmLev range_ (\o -> IdAsp_Type_Sig (_mkEHSig (ioccNm o))) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 163, column 9) + _idDefOccGamKind = + kvarS2IdDefOccGam _nmLev range_ _kindIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 372, column 9) + _kindOidGam = + gamUnion _idDefOccGamKind _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 775, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _kindIidUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 775, column 9) + _idDpdMp = + idToOccL2DpdMp (gamKeys _idDefOccGam) _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 778, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_kindIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 16, column 9) + _refnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 137, column 9) + _idOccDefs = + [ IdOcc n IdOcc_Type | n <- _refnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 22, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 53, column 9) + _pp = + ppCommas' names_ >#< "::" >#< _kindIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 105, column 9) + _mkEHSig = + \n -> rngLift range_ EH.Decl_KiSig n _kindIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 106, column 9) + _lhsOeh = + map _mkEHSig _refnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _kindIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _kindIppWrap + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (from local) + _kindOnmLev = + _nmLev + -- copy rule (down) + _kindOopts = + _lhsIopts + -- copy rule (from local) + _kindOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIconNm,_kindIeh,_kindIerrSq,_kindIfreeTvarS,_kindIgUniq,_kindIidUseOccGam,_kindIpp,_kindIppWrap,_kindItopInstanceNmL,_kindIundefOccGam) = + kind_ _kindOgUniq _kindOidGam _kindOnmLev _kindOopts _kindOpatchEhNmInInstance _kindOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_ForeignImport :: Range -> + FFIWay -> + (Maybe String) -> + (Maybe String) -> + Name -> + T_Type -> + T_Declaration +sem_Declaration_ForeignImport range_ callconvention_ safety_ importname_ name_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 195, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 199, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Val_Foreign _eh) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 366, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 780, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _typeIidUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 780, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 783, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_typeIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 20, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 157, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 157, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 24, column 9) + _errFFIWay = + if maybe False (callconvention_ `elem`) $ fmap targiAllowedFFI $ Map.lookup (ehcOptTarget _lhsIopts) allTargetInfoMp + then [] + else [rngLift range_ Err_IllegalFFIWay callconvention_] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 147, column 9) + _errSq = + Seq.unions [ Seq.fromList (rngLift range_ mkNestErr (pp ("Parse of foreign entity '" ++ _nmForParse ++ "'")) _entErrs) + , _typeIerrSq + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 55, column 9) + _pp = + "foreign import" >#< callconvention_ >#< safety_ >#< maybe empty (pp.show) importname_ >#< name_ >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 108, column 9) + _eh = + rngLift range_ EH.Decl_FFI callconvention_ (maybe "safe" id safety_) _ent _refname _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 109, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 328, column 9) + _nmForParse = + maybe "" id importname_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 329, column 25) + (_ent,_entErrs) = + parseForeignEnt ForeignDirection_Import callconvention_ (Just $ show name_) _nmForParse + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (from local) + _typeOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_ForeignExport :: Range -> + FFIWay -> + (Maybe String) -> + Name -> + T_Type -> + T_Declaration +sem_Declaration_ForeignExport range_ callconvention_ exportname_ name_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 195, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 199, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Val_Foreign _eh) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 366, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 670, column 29) + (_refname,_,_idUseOccGamExport,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 826, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_idUseOccGamExport,_typeIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 826, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 830, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_typeIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 32, column 9) + _exportrefname = + hsnUniqify HsNameUniqifier_FFE name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 160, column 9) + _idOccDef = + IdOcc _exportrefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 160, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 24, column 9) + _errFFIWay = + if maybe False (callconvention_ `elem`) $ fmap targiAllowedFFI $ Map.lookup (ehcOptTarget _lhsIopts) allTargetInfoMp + then [] + else [rngLift range_ Err_IllegalFFIWay callconvention_] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 151, column 9) + _errSq = + Seq.unions [ Seq.fromList _errIdUse + , Seq.fromList (rngLift range_ mkNestErr (pp ("Parse of foreign entity '" ++ _nmForParse ++ "'")) _entErrs) + , _typeIerrSq + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 83, column 9) + _pp = + "foreign export" >#< callconvention_ >#< exportname_ >#< name_ >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 141, column 9) + _nmForParse = + maybe "" id exportname_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 142, column 25) + (_ent,_entErrs) = + parseForeignEnt ForeignDirection_Export callconvention_ (Just $ show name_) _nmForParse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 141, column 9) + _eh = + rngLift range_ EH.Decl_FFE _exportrefname callconvention_ _ent (rngLift range_ EH.Expr_Var _refname) _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 145, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (from local) + _typeOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Class :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_FunctionalDependencies -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Class range_ context_ typelefthandside_ dependencies_ where_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _contextOfixityGam :: FixityGam + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOfixityGam :: FixityGam + _typelefthandsideOgUniq :: UID + _typelefthandsideOidGam :: IdDefOccGam + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOopts :: EHCOpts + _typelefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _dependenciesOfixityGam :: FixityGam + _dependenciesOgUniq :: UID + _dependenciesOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _dependenciesOidGam :: IdDefOccGam + _dependenciesOmoduleNm :: HsName + _dependenciesOnmLev :: NmLev + _dependenciesOopts :: EHCOpts + _dependenciesOpatchEhNmInInstance :: PatchEhNmInInstance + _dependenciesOpragmas :: (Set.Set Pragma.Pragma) + _dependenciesOtopInstanceNmL :: ([HsName]) + _whereOcaseId :: UID + _whereOfixityGam :: FixityGam + _whereOgUniq :: UID + _whereOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _whereOidGam :: IdDefOccGam + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOpatchEhNmInInstance :: PatchEhNmInInstance + _whereOpragmas :: (Set.Set Pragma.Pragma) + _whereOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typelefthandsideIeh :: ([EH.TyVar]) + _typelefthandsideIerrSq :: ErrSq + _typelefthandsideIfreeTvarS :: HsNameS + _typelefthandsideIgUniq :: UID + _typelefthandsideIidDefOccGam :: IdDefOccGam + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIidUseOccGam :: IdUseOccGam + _typelefthandsideIname :: Name + _typelefthandsideIpp :: PP_Doc + _typelefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typelefthandsideIundefOccGam :: IdUseOccGam + _dependenciesIeh :: ([EH.FuncDep]) + _dependenciesIerrSq :: ErrSq + _dependenciesIgUniq :: UID + _dependenciesIgathFixityGam :: FixityGam + _dependenciesIgathPragmas :: (Set.Set Pragma.Pragma) + _dependenciesIidDefOccGam :: IdDefOccGam + _dependenciesIidDpdMp :: IdDpdMp + _dependenciesIidOccDefs :: ([IdOcc]) + _dependenciesIidTySigDefOccGam :: IdDefOccGam + _dependenciesIidUseOccGam :: IdUseOccGam + _dependenciesIneedsError :: Bool + _dependenciesIpp :: PP_Doc + _dependenciesIppWrap :: (PP_Doc -> PP_Doc) + _dependenciesItopInstanceNmL :: ([HsName]) + _dependenciesIundefOccGam :: IdUseOccGam + _whereIeh :: (Maybe [EH.Decl]) + _whereIerrSq :: ErrSq + _whereIgUniq :: UID + _whereIgathFixityGam :: FixityGam + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidDefOccGam :: IdDefOccGam + _whereIidDpdMp :: IdDpdMp + _whereIidOccDefs :: ([IdOcc]) + _whereIidTySigDefOccGam :: IdDefOccGam + _whereIidUseOccGam :: IdUseOccGam + _whereIneedsError :: Bool + _whereIpp :: PP_Doc + _whereIppWrap :: (PP_Doc -> PP_Doc) + _whereItopInstanceNmL :: ([HsName]) + _whereIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 167, column 9) + _idDefOccGamType = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 167, column 9) + _idDefOccGamSigAsVar = + _whereIidTySigDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 167, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Class_Def _eh _ehInst) [_idOccDef] + `gamUnion` _idDefOccGamSigAsVar + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 191, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 375, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 375, column 9) + _idDefOccGamInstForClass = + fst $ gamPartition (\_ d -> case doccAsp d of {IdAsp_Inst_Def _ n | n == _classrefname -> True ; _ -> False}) $ _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 690, column 29) + (_,_,_idUseOccGamExtra,_errIdUseExtra) = + mkUseOccGam _lhsIopts _lhsIidGam _extranames IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 785, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [ _contextIidUseOccGam,_whereIidUseOccGam + , _idUseOccGamExtra + ]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 785, column 9) + _idDpdMp = + idDpdMpUnions + [ idToOccL2DpdMp [_idOccDef] _idUseHereOccL + , idToOccGam2DpdMp [_idOccDef] _idDefOccGamSigAsVar + , idFrOccGam2DpdMp _idDefOccGamSigAsVar [_idOccDef] + , idFrOccGam2DpdMp _idDefOccGamSigAsVar (gamKeys _idDefOccGamInstForClass) + , _whereIidDpdMp + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 798, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_whereIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1036, column 29) + (_,_ehReorderedDecls,_errReorder) = + mkIdOccSccEH range_ False _whereIidDefOccGam Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 26, column 9) + _classrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 96, column 17) + _extranames = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDef = + IdOcc _classrefname IdOcc_Class + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefsSig = + _whereIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefs = + [_idOccDef] ++ _idOccDefsSig + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 235, column 9) + _instancename = + hsnUniqifyUID HsNameUniqifier_Class _lUniq (mkHNm _typelefthandsideIname) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 131, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamType + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 129, column 9) + _errSq = + Seq.unions [ Seq.fromList _errDupIntro, Seq.fromList _errReorder, _contextIerrSq, _typelefthandsideIerrSq + , _dependenciesIerrSq + , Seq.fromList _errIdUseExtra + , _whereIerrSq + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 57, column 9) + _pp = + "class" >#< ppParens _contextIpp >#< "=>" >#< _typelefthandsideIpp + >#< "|" >#< _dependenciesIpp + >-< indent 2 _whereIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 111, column 25) + (_eh,_ehInst) = + let h = rngLift range_ EH.TyExpr_Pred + $ rngLift range_ EH.PrExpr_Class _classrefname (map (rngLift range_ EH.TyExpr_Var) _typelefthandsideItypevariables) + c = map (rngLift range_ EH.TyExpr_Pred) _contextIeh + a = appArr c h + (vals,sigs) = partition EH.ehIsDeclVal $ concat _ehReorderedDecls + in ( rngLift range_ EH.Decl_Class a + _dependenciesIeh + (Just _instancerefname) sigs + _generDerivInfoL + , rngLift range_ EH.Decl_Instance (Just (_instancerefname,False)) InstDefault a vals + ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 122, column 9) + _lhsOeh = + [_eh,_ehInst] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 293, column 9) + (_mbPrevInstancename,_lhsOtopInstanceNmL) = + extrTopInstanceNm _lhsItopInstanceNmL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 323, column 9) + _generDerivInfoL = + Map.findWithDefault [] _classrefname _lhsIgenerDerivMp + -- -- generated by the unique rule mechanism. + (_contextOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _dependenciesIgathFixityGam `gamAddGam` _whereIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _dependenciesIgathPragmas `Set.union` _whereIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _dependenciesIidTySigDefOccGam `gamAddGam` _whereIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _dependenciesIneedsError || _whereIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typelefthandsideIppWrap . _dependenciesIppWrap . _whereIppWrap + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (from local) + _contextOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typelefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (from local) + _typelefthandsideOidGam = + _idGam + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOopts = + _lhsIopts + -- copy rule (from local) + _typelefthandsideOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _dependenciesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _dependenciesOgUniq = + _typelefthandsideIgUniq + -- copy rule (down) + _dependenciesOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _dependenciesOidGam = + _idGam + -- copy rule (down) + _dependenciesOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _dependenciesOnmLev = + _nmLev + -- copy rule (down) + _dependenciesOopts = + _lhsIopts + -- copy rule (from local) + _dependenciesOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _dependenciesOpragmas = + _lhsIpragmas + -- copy rule (chain) + _dependenciesOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (down) + _whereOcaseId = + _lhsIcaseId + -- copy rule (down) + _whereOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _whereOgUniq = + _dependenciesIgUniq + -- copy rule (down) + _whereOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _whereOidGam = + _idGam + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (from local) + _whereOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _whereOpragmas = + _lhsIpragmas + -- copy rule (chain) + _whereOtopInstanceNmL = + _dependenciesItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typelefthandsideIeh,_typelefthandsideIerrSq,_typelefthandsideIfreeTvarS,_typelefthandsideIgUniq,_typelefthandsideIidDefOccGam,_typelefthandsideIidOccDefs,_typelefthandsideIidUseOccGam,_typelefthandsideIname,_typelefthandsideIpp,_typelefthandsideIppWrap,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables,_typelefthandsideIundefOccGam) = + typelefthandside_ _typelefthandsideOfixityGam _typelefthandsideOgUniq _typelefthandsideOidGam _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOopts _typelefthandsideOpatchEhNmInInstance _typelefthandsideOtopInstanceNmL + ( _dependenciesIeh,_dependenciesIerrSq,_dependenciesIgUniq,_dependenciesIgathFixityGam,_dependenciesIgathPragmas,_dependenciesIidDefOccGam,_dependenciesIidDpdMp,_dependenciesIidOccDefs,_dependenciesIidTySigDefOccGam,_dependenciesIidUseOccGam,_dependenciesIneedsError,_dependenciesIpp,_dependenciesIppWrap,_dependenciesItopInstanceNmL,_dependenciesIundefOccGam) = + dependencies_ _dependenciesOfixityGam _dependenciesOgUniq _dependenciesOgenerDerivMp _dependenciesOidGam _dependenciesOmoduleNm _dependenciesOnmLev _dependenciesOopts _dependenciesOpatchEhNmInInstance _dependenciesOpragmas _dependenciesOtopInstanceNmL + ( _whereIeh,_whereIerrSq,_whereIgUniq,_whereIgathFixityGam,_whereIgathPragmas,_whereIidDefOccGam,_whereIidDpdMp,_whereIidOccDefs,_whereIidTySigDefOccGam,_whereIidUseOccGam,_whereIneedsError,_whereIpp,_whereIppWrap,_whereItopInstanceNmL,_whereIundefOccGam) = + where_ _whereOcaseId _whereOfixityGam _whereOgUniq _whereOgenerDerivMp _whereOidGam _whereOmoduleNm _whereOnmLev _whereOopts _whereOpatchEhNmInInstance _whereOpragmas _whereOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Instance :: Range -> + InstVariant -> + MaybeName -> + Bool -> + T_ContextItems -> + T_Type -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Instance range_ instVariant_ maybeinstancename_ useimplicitly_ context_ type_ where_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _whereOpatchEhNmInInstance :: PatchEhNmInInstance + _lhsOeh :: ([EH.Decl]) + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _contextOfixityGam :: FixityGam + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _whereOcaseId :: UID + _whereOfixityGam :: FixityGam + _whereOgUniq :: UID + _whereOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _whereOidGam :: IdDefOccGam + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOpragmas :: (Set.Set Pragma.Pragma) + _whereOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + _whereIeh :: (Maybe [EH.Decl]) + _whereIerrSq :: ErrSq + _whereIgUniq :: UID + _whereIgathFixityGam :: FixityGam + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidDefOccGam :: IdDefOccGam + _whereIidDpdMp :: IdDpdMp + _whereIidOccDefs :: ([IdOcc]) + _whereIidTySigDefOccGam :: IdDefOccGam + _whereIidUseOccGam :: IdUseOccGam + _whereIneedsError :: Bool + _whereIpp :: PP_Doc + _whereIppWrap :: (PP_Doc -> PP_Doc) + _whereItopInstanceNmL :: ([HsName]) + _whereIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 175, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 175, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Inst_Def _eh _classrefname) [_idOccDef] + `gamUnion` mkDefOccGam _lhsInmLev range_ IdAsp_Val_Var [_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 379, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 623, column 29) + (_classrefname,_,_idUseOccGamInst,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [_typeIconNm] IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 800, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_idUseOccGamInst,_contextIidUseOccGam,_typeIidUseOccGam ,_whereIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 800, column 9) + _idDpdMp = + idDpdMpUnions + [ idToOccL2DpdMp [_idOccDef] _idUseHereOccL + , idDpdMpSingleton _idOccDefVal _idOccDef + , _whereIidDpdMp + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 808, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_whereIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1036, column 29) + (_,_ehReorderedDecls,_errReorder) = + mkIdOccSccEH range_ False _whereIidDefOccGam Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1071, column 9) + _whereOpatchEhNmInInstance = + hsnSetQual (panicJust "Declaration.Instance.patchEhNmInInstance" $ hsnQualifier _classrefname) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDefs = + [_idOccDef,_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 233, column 9) + _instancename = + maybe (hsnUniqifyUID HsNameUniqifier_ClassDict _lUniq (_typeIconNm)) id maybeinstancename_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 26, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 135, column 9) + _errSq = + Seq.firstNotEmpty [Seq.fromList _errIdUse, _contextIerrSq, _typeIerrSq, _whereIerrSq, Seq.fromList _errReorder] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 61, column 9) + _pp = + "instance" >|< ppInstNm useimplicitly_ maybeinstancename_ + >#< ppParens _contextIpp >#< "=>" >#< _typeIpp + >-< indent 2 _whereIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 124, column 9) + _eh = + let + h = rngLift range_ EH.TyExpr_Pred $ panicJust "HS.ToEH.Instance.eh.type.ehMbAsPr" _typeIehMbAsPr + c = map (rngLift range_ EH.TyExpr_Pred) _contextIeh + in rngLift range_ EH.Decl_Instance (Just (_instancerefname,useimplicitly_)) instVariant_ (appArr c h) (concat _ehReorderedDecls) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 128, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 182, column 9) + _isAsPred = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 293, column 9) + (_mbPrevInstancename,_lhsOtopInstanceNmL) = + extrTopInstanceNm _lhsItopInstanceNmL + -- -- generated by the unique rule mechanism. + (_contextOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _whereIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _whereIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _whereIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _whereIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typeIppWrap . _whereIppWrap + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (from local) + _contextOidGam = + _idGam + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _contextIgUniq + -- copy rule (from local) + _typeOidGam = + _idGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _whereOcaseId = + _lhsIcaseId + -- copy rule (down) + _whereOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _whereOgUniq = + _typeIgUniq + -- copy rule (down) + _whereOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _whereOidGam = + _idGam + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (down) + _whereOpragmas = + _lhsIpragmas + -- copy rule (chain) + _whereOtopInstanceNmL = + _typeItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + ( _whereIeh,_whereIerrSq,_whereIgUniq,_whereIgathFixityGam,_whereIgathPragmas,_whereIidDefOccGam,_whereIidDpdMp,_whereIidOccDefs,_whereIidTySigDefOccGam,_whereIidUseOccGam,_whereIneedsError,_whereIpp,_whereIppWrap,_whereItopInstanceNmL,_whereIundefOccGam) = + where_ _whereOcaseId _whereOfixityGam _whereOgUniq _whereOgenerDerivMp _whereOidGam _whereOmoduleNm _whereOnmLev _whereOopts _whereOpatchEhNmInInstance _whereOpragmas _whereOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_InstanceUseImplicitly :: Range -> + T_Expression -> + Name -> + T_Types -> + T_Declaration +sem_Declaration_InstanceUseImplicitly range_ expression_ name_ types_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _typesOfixityGam :: FixityGam + _typesOgUniq :: UID + _typesOidGam :: IdDefOccGam + _typesOisAsPred :: Bool + _typesOnmLev :: NmLev + _typesOopts :: EHCOpts + _typesOpatchEhNmInInstance :: PatchEhNmInInstance + _typesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _typesIeh :: ([EH.TyExpr]) + _typesIerrSq :: ErrSq + _typesIfreeTvarS :: HsNameS + _typesIgUniq :: UID + _typesIidUseOccGam :: IdUseOccGam + _typesIpp :: PP_Doc + _typesIppL :: ([PP_Doc]) + _typesIppWrap :: (PP_Doc -> PP_Doc) + _typesItopInstanceNmL :: ([HsName]) + _typesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 180, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Inst_Def _eh _classrefname) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 627, column 29) + (_classrefname,_,_idUseOccGamInst,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 810, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_idUseOccGamInst,_typesIidUseOccGam,_expressionIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 810, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 148, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 148, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 237, column 9) + _instancename = + mkHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 137, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _expressionIerrSq, _typesIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 65, column 9) + _pp = + "instance" >#< _expressionIpp >#< "<:" >#< name_ >#< ppSpaces _typesIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 130, column 9) + _eh = + let h = rngLift range_ EH.PrExpr_Class _classrefname _typesIeh + in rngLift range_ EH.Decl_InstanceIntro (Just _instancerefname) _expressionIeh h + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 132, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 293, column 9) + (_mbPrevInstancename,_lhsOtopInstanceNmL) = + extrTopInstanceNm _lhsItopInstanceNmL + -- -- generated by the unique rule mechanism. + (_expressionOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _typesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _undefOccGam + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (from local) + _expressionOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typesOgUniq = + _expressionIgUniq + -- copy rule (down) + _typesOidGam = + _lhsIidGam + -- copy rule (from local) + _typesOisAsPred = + _isAsPred + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (down) + _typesOopts = + _lhsIopts + -- copy rule (from local) + _typesOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _typesIeh,_typesIerrSq,_typesIfreeTvarS,_typesIgUniq,_typesIidUseOccGam,_typesIpp,_typesIppL,_typesIppWrap,_typesItopInstanceNmL,_typesIundefOccGam) = + types_ _typesOfixityGam _typesOgUniq _typesOidGam _typesOisAsPred _typesOnmLev _typesOopts _typesOpatchEhNmInInstance _typesOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Default :: Range -> + MaybeName -> + T_Types -> + T_Declaration +sem_Declaration_Default range_ name_ types_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _typesOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOfixityGam :: FixityGam + _typesOidGam :: IdDefOccGam + _typesOisAsPred :: Bool + _typesOnmLev :: NmLev + _typesOopts :: EHCOpts + _typesOpatchEhNmInInstance :: PatchEhNmInInstance + _typesOtopInstanceNmL :: ([HsName]) + _typesIeh :: ([EH.TyExpr]) + _typesIerrSq :: ErrSq + _typesIfreeTvarS :: HsNameS + _typesIgUniq :: UID + _typesIidUseOccGam :: IdUseOccGam + _typesIpp :: PP_Doc + _typesIppL :: ([PP_Doc]) + _typesIppWrap :: (PP_Doc -> PP_Doc) + _typesItopInstanceNmL :: ([HsName]) + _typesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 182, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Dflt_Def _eh _ignoredecl) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 630, column 29) + (_classrefname,_classrefnames,_idUseOccGamDflt,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam (catMaybes [name_]) IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 815, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_idUseOccGamDflt,_typesIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 815, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 819, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_typesIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 151, column 9) + _idOccDef = + IdOcc _defaultname IdOcc_Dflt + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 151, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 239, column 9) + _defaultname = + mkHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 139, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _typesIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 67, column 9) + _pp = + "default" >#< maybe empty pp name_ >#< ppParensCommas _typesIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 134, column 9) + _ignoredecl = + null _classrefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 134, column 9) + _eh = + rngLift range_ EH.Decl_Default _classrefname _typesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 136, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- -- generated by the unique rule mechanism. + (_typesOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typesIppWrap + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (down) + _typesOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typesOidGam = + _lhsIidGam + -- copy rule (from local) + _typesOisAsPred = + _isAsPred + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (down) + _typesOopts = + _lhsIopts + -- copy rule (from local) + _typesOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIeh,_typesIerrSq,_typesIfreeTvarS,_typesIgUniq,_typesIidUseOccGam,_typesIpp,_typesIppL,_typesIppWrap,_typesItopInstanceNmL,_typesIundefOccGam) = + types_ _typesOfixityGam _typesOgUniq _typesOidGam _typesOisAsPred _typesOnmLev _typesOopts _typesOpatchEhNmInInstance _typesOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Type :: Range -> + T_TypeLeftHandSide -> + T_Type -> + T_Declaration +sem_Declaration_Type range_ typelefthandside_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typelefthandsideOfixityGam :: FixityGam + _typelefthandsideOgUniq :: UID + _typelefthandsideOidGam :: IdDefOccGam + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOopts :: EHCOpts + _typelefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typelefthandsideIeh :: ([EH.TyVar]) + _typelefthandsideIerrSq :: ErrSq + _typelefthandsideIfreeTvarS :: HsNameS + _typelefthandsideIgUniq :: UID + _typelefthandsideIidDefOccGam :: IdDefOccGam + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIidUseOccGam :: IdUseOccGam + _typelefthandsideIname :: Name + _typelefthandsideIpp :: PP_Doc + _typelefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typelefthandsideIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 184, column 9) + _idDefOccGamType = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 184, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev _typelefthandsideIrange (IdAsp_Type_Def _eh) _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 191, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _nmLev _typelefthandsideIrange _typelefthandsideItypevariables + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 370, column 9) + _idGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 821, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev _typeIidUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 821, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 824, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_typeIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 28, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 154, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 154, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 29, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 141, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamType + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 143, column 9) + _errSq = + Seq.unions [ Seq.fromList _errDupIntro, _typelefthandsideIerrSq, _typeIerrSq ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 69, column 9) + _pp = + "type" >#< _typelefthandsideIpp >#< "=" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 138, column 9) + _eh = + rngLift range_ EH.Decl_Type _typerefname (foldr (rngLift range_ EH.TyExpr_Lam) _typeIeh _typelefthandsideItypevariables) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 139, column 9) + _lhsOeh = + [_eh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typelefthandsideIppWrap . _typeIppWrap + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typelefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typelefthandsideOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typelefthandsideOidGam = + _idGam + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOopts = + _lhsIopts + -- copy rule (from local) + _typelefthandsideOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _typelefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _typelefthandsideIgUniq + -- copy rule (from local) + _typeOidGam = + _idGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (from local) + _typeOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + ( _typelefthandsideIeh,_typelefthandsideIerrSq,_typelefthandsideIfreeTvarS,_typelefthandsideIgUniq,_typelefthandsideIidDefOccGam,_typelefthandsideIidOccDefs,_typelefthandsideIidUseOccGam,_typelefthandsideIname,_typelefthandsideIpp,_typelefthandsideIppWrap,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables,_typelefthandsideIundefOccGam) = + typelefthandside_ _typelefthandsideOfixityGam _typelefthandsideOgUniq _typelefthandsideOidGam _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOopts _typelefthandsideOpatchEhNmInInstance _typelefthandsideOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Pragma :: Range -> + T_Pragma -> + T_Declaration +sem_Declaration_Pragma range_ pragma_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _pragmaOgUniq :: UID + _pragmaOidGam :: IdDefOccGam + _pragmaOnmLev :: NmLev + _pragmaOopts :: EHCOpts + _pragmaOpatchEhNmInInstance :: PatchEhNmInInstance + _pragmaOtopInstanceNmL :: ([HsName]) + _pragmaIerrSq :: ErrSq + _pragmaIgUniq :: UID + _pragmaIgathPragmas :: (Set.Set Pragma.Pragma) + _pragmaIidUseOccGam :: IdUseOccGam + _pragmaIpp :: PP_Doc + _pragmaIppWrap :: (PP_Doc -> PP_Doc) + _pragmaItopInstanceNmL :: ([HsName]) + _pragmaIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 75, column 9) + _pp = + "{-#" >#< _pragmaIpp >#< "#-}" + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 147, column 9) + _eh = + undefined + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 148, column 9) + _lhsOeh = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _pragmaIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _pragmaIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _pragmaIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _pragmaIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _pragmaIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _pragmaIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _pragmaItopInstanceNmL + -- copy rule (down) + _pragmaOgUniq = + _lhsIgUniq + -- copy rule (down) + _pragmaOidGam = + _lhsIidGam + -- copy rule (down) + _pragmaOnmLev = + _lhsInmLev + -- copy rule (down) + _pragmaOopts = + _lhsIopts + -- copy rule (from local) + _pragmaOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _pragmaOtopInstanceNmL = + _lhsItopInstanceNmL + ( _pragmaIerrSq,_pragmaIgUniq,_pragmaIgathPragmas,_pragmaIidUseOccGam,_pragmaIpp,_pragmaIppWrap,_pragmaItopInstanceNmL,_pragmaIundefOccGam) = + pragma_ _pragmaOgUniq _pragmaOidGam _pragmaOnmLev _pragmaOopts _pragmaOpatchEhNmInInstance _pragmaOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declaration_Module :: Range -> + MaybeName -> + T_MaybeExports -> + T_Declaration +sem_Declaration_Module range_ name_ exports_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _exportsOfixityGam :: FixityGam + _exportsOgUniq :: UID + _exportsOidGam :: IdDefOccGam + _exportsOisMainMod :: Bool + _exportsOisTopMod :: Bool + _exportsOmoduleNm :: HsName + _exportsOnmLev :: NmLev + _exportsOopts :: EHCOpts + _exportsOpatchEhNmInInstance :: PatchEhNmInInstance + _exportsOtopInstanceNmL :: ([HsName]) + _exportsIerrSq :: ErrSq + _exportsIgUniq :: UID + _exportsIgathFixityGam :: FixityGam + _exportsIidUseOccGam :: IdUseOccGam + _exportsIpp :: PP_Doc + _exportsIppWrap :: (PP_Doc -> PP_Doc) + _exportsItopInstanceNmL :: ([HsName]) + _exportsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1077, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 147, column 9) + _eh = + undefined + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 148, column 9) + _lhsOeh = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 184, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 222, column 9) + _doGenVarWild = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 253, column 9) + _isMainMod = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 253, column 9) + _isTopMod = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _exportsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _exportsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _exportsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _exportsIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _exportsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _exportsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _exportsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _exportsItopInstanceNmL + -- copy rule (down) + _exportsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _exportsOgUniq = + _lhsIgUniq + -- copy rule (down) + _exportsOidGam = + _lhsIidGam + -- copy rule (from local) + _exportsOisMainMod = + _isMainMod + -- copy rule (from local) + _exportsOisTopMod = + _isTopMod + -- copy rule (down) + _exportsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _exportsOnmLev = + _lhsInmLev + -- copy rule (down) + _exportsOopts = + _lhsIopts + -- copy rule (from local) + _exportsOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _exportsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _exportsIerrSq,_exportsIgUniq,_exportsIgathFixityGam,_exportsIidUseOccGam,_exportsIpp,_exportsIppWrap,_exportsItopInstanceNmL,_exportsIundefOccGam) = + exports_ _exportsOfixityGam _exportsOgUniq _exportsOidGam _exportsOisMainMod _exportsOisTopMod _exportsOmoduleNm _exportsOnmLev _exportsOopts _exportsOpatchEhNmInInstance _exportsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Declarations ------------------------------------------------ +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Decl] + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Declaration + child tl : Declarations + alternative Nil: +-} +-- cata +sem_Declarations :: Declarations -> + T_Declarations +sem_Declarations list = + (Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list)) +-- semantic domain +type T_Declarations = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Decl]),ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Declarations_Cons :: T_Declaration -> + T_Declarations -> + T_Declarations +sem_Declarations_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: ([EH.Decl]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidDefOccGam :: IdDefOccGam + _hdIidDpdMp :: IdDpdMp + _hdIidOccDefs :: ([IdOcc]) + _hdIidTySigDefOccGam :: IdDefOccGam + _hdIidUseOccGam :: IdUseOccGam + _hdIneedsError :: Bool + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.Decl]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidDefOccGam :: IdDefOccGam + _tlIidDpdMp :: IdDpdMp + _tlIidOccDefs :: ([IdOcc]) + _tlIidTySigDefOccGam :: IdDefOccGam + _tlIidUseOccGam :: IdUseOccGam + _tlIneedsError :: Bool + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 66, column 28) + _lhsOeh = + _hdIeh ++ _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _hdIidDpdMp `idDpdMpUnion` _tlIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _hdIidTySigDefOccGam `gamAddGam` _tlIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _hdIneedsError || _tlIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIgathPragmas,_hdIidDefOccGam,_hdIidDpdMp,_hdIidOccDefs,_hdIidTySigDefOccGam,_hdIidUseOccGam,_hdIneedsError,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIgathPragmas,_tlIidDefOccGam,_tlIidDpdMp,_tlIidOccDefs,_tlIidTySigDefOccGam,_tlIidUseOccGam,_tlIneedsError,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 66, column 28) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Deriving ---------------------------------------------------- +{- + visit 0: + inherited attributes: + ehDataTyExpr : EH.TyExpr + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + idOccDefData : IdOcc + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Deriving: + child range : {Range} + child maybeinstancename : {MaybeName} + child useimplicitly : {Bool} + child name : {Name} + visit 0: + local idDefOccGam : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local instancerefname : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefs : _ + local instancename : _ + local errSq : _ + local pp : _ + local eh : _ + local mbPrevInstancename : _ + local lUniq : {UID} +-} +-- cata +sem_Deriving :: Deriving -> + T_Deriving +sem_Deriving (Deriving_Deriving _range _maybeinstancename _useimplicitly _name) = + (sem_Deriving_Deriving _range _maybeinstancename _useimplicitly _name) +-- semantic domain +type T_Deriving = (EH.TyExpr) -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + IdOcc -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Deriving_Deriving :: Range -> + MaybeName -> + Bool -> + Name -> + T_Deriving +sem_Deriving_Deriving range_ maybeinstancename_ useimplicitly_ name_ = + (\ _lhsIehDataTyExpr + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsIidOccDefData + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidDpdMp :: IdDpdMp + _lhsOtopInstanceNmL :: ([HsName]) + _lhsOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 264, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ (IdAsp_Inst_Def _eh _refname) [_idOccDef] + `gamUnion` mkDefOccGam _lhsInmLev range_ IdAsp_Val_Var [_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 635, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 854, column 9) + _lhsOidDpdMp = + idDpdMpUnions + [ idDpdMpSingleton _idOccDef _lhsIidOccDefData + , idDpdMpSingleton _idOccDefVal _idOccDef + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 37, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDefs = + [_idOccDef,_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 247, column 9) + _instancename = + maybe (mkHNm _lUniq) id maybeinstancename_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 162, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 87, column 9) + _pp = + ppInstNm useimplicitly_ maybeinstancename_ >#< name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 168, column 9) + _eh = + let h = rngLift range_ EH.TyExpr_Pred + $ rngLift range_ EH.PrExpr_Class _refname [rngLift range_ EH.TyExpr_Parens _lhsIehDataTyExpr] + in rngLift range_ EH.Decl_Instance (Just (_instancerefname,useimplicitly_)) (InstDeriving InstDerivingFrom_Datatype) h [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 298, column 9) + (_mbPrevInstancename,_lhsOtopInstanceNmL) = + extrTopInstanceNm _lhsItopInstanceNmL + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Derivings --------------------------------------------------- +{- + visit 0: + inherited attributes: + ehDataTyExpr : EH.TyExpr + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + idOccDefData : IdOcc + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Deriving + child tl : Derivings + alternative Nil: +-} +-- cata +sem_Derivings :: Derivings -> + T_Derivings +sem_Derivings list = + (Prelude.foldr sem_Derivings_Cons sem_Derivings_Nil (Prelude.map sem_Deriving list)) +-- semantic domain +type T_Derivings = (EH.TyExpr) -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + IdOcc -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Derivings_Cons :: T_Deriving -> + T_Derivings -> + T_Derivings +sem_Derivings_Cons hd_ tl_ = + (\ _lhsIehDataTyExpr + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsIidOccDefData + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOehDataTyExpr :: (EH.TyExpr) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOidOccDefData :: IdOcc + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOehDataTyExpr :: (EH.TyExpr) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOidOccDefData :: IdOcc + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidDefOccGam :: IdDefOccGam + _hdIidDpdMp :: IdDpdMp + _hdIidOccDefs :: ([IdOcc]) + _hdIidTySigDefOccGam :: IdDefOccGam + _hdIidUseOccGam :: IdUseOccGam + _hdIneedsError :: Bool + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidDefOccGam :: IdDefOccGam + _tlIidDpdMp :: IdDpdMp + _tlIidOccDefs :: ([IdOcc]) + _tlIidTySigDefOccGam :: IdDefOccGam + _tlIidUseOccGam :: IdUseOccGam + _tlIneedsError :: Bool + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 528, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _hdIidDpdMp `idDpdMpUnion` _tlIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _hdIidTySigDefOccGam `gamAddGam` _tlIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _hdIneedsError || _tlIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOehDataTyExpr = + _lhsIehDataTyExpr + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOidOccDefData = + _lhsIidOccDefData + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOehDataTyExpr = + _lhsIehDataTyExpr + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOidOccDefData = + _lhsIidOccDefData + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIgathPragmas,_hdIidDefOccGam,_hdIidDpdMp,_hdIidOccDefs,_hdIidTySigDefOccGam,_hdIidUseOccGam,_hdIneedsError,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOehDataTyExpr _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOidOccDefData _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIgathPragmas,_tlIidDefOccGam,_tlIidDpdMp,_tlIidOccDefs,_tlIidTySigDefOccGam,_tlIidUseOccGam,_tlIneedsError,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOehDataTyExpr _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOidOccDefData _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Derivings_Nil :: T_Derivings +sem_Derivings_Nil = + (\ _lhsIehDataTyExpr + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsIidOccDefData + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 530, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Export ------------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + alternative TypeOrClass: + child range : {Range} + child name : {Name} + child names : {MaybeNames} + alternative TypeOrClassComplete: + child range : {Range} + child name : {Name} + alternative Module: + child range : {Range} + child name : {Name} +-} +-- cata +sem_Export :: Export -> + T_Export +sem_Export (Export_Variable _range _name) = + (sem_Export_Variable _range _name) +sem_Export (Export_TypeOrClass _range _name _names) = + (sem_Export_TypeOrClass _range _name _names) +sem_Export (Export_TypeOrClassComplete _range _name) = + (sem_Export_TypeOrClassComplete _range _name) +sem_Export (Export_Module _range _name) = + (sem_Export_Module _range _name) +-- semantic domain +type T_Export = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Export_Variable :: Range -> + Name -> + T_Export +sem_Export_Variable range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Export_TypeOrClass :: Range -> + Name -> + MaybeNames -> + T_Export +sem_Export_TypeOrClass range_ name_ names_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Export_TypeOrClassComplete :: Range -> + Name -> + T_Export +sem_Export_TypeOrClassComplete range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Export_Module :: Range -> + Name -> + T_Export +sem_Export_Module range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Exports ----------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Export + child tl : Exports + alternative Nil: +-} +-- cata +sem_Exports :: Exports -> + T_Exports +sem_Exports list = + (Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list)) +-- semantic domain +type T_Exports = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Exports_Cons :: T_Export -> + T_Exports -> + T_Exports +sem_Exports_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOisMainMod :: Bool + _hdOisTopMod :: Bool + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOisMainMod :: Bool + _tlOisTopMod :: Bool + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _hdOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _tlOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOisMainMod _hdOisTopMod _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOisMainMod _tlOisTopMod _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conNm : Name + eh : EH.Expr + errSq : ErrSq + idUseOccGam : IdUseOccGam + opChain : OpChain EH.Expr + operatorName : MaybeName + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Literal: + child range : {Range} + child literal : Literal + visit 0: + local litnames : _ + local litrefname : _ + local litrefnames : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local eh : _ + local isAsPred : _ + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative Constructor: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative TupleConstructor: + child range : {Range} + child arity : {Int} + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative Parenthesized: + child range : {Range} + child expression : Expression + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative NormalApplication: + child range : {Range} + child function : Expression + child arguments : Expressions + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative SectionApplication: + child range : {Range} + child leftExpression : MaybeExpression + child operator : Expression + child rightExpression : MaybeExpression + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + local lUniq_1_nm : {UID} + alternative InfixApplication: + child range : {Range} + child leftExpression : Expression + child operator : Expression + child rightExpression : Expression + visit 0: + local pp : _ + local fgi : _ + local eh : _ + local isAsPred : _ + alternative InfixApplicationChainTop: + child range : {Range} + child expression : Expression + visit 0: + local errSq : _ + local ehRearrOpChain : _ + local errRearr : _ + local ehFromOpChain : _ + local eh : _ + local isAsPred : _ + alternative Lambda: + child range : {Range} + child patterns : Patterns + child expression : Expression + visit 0: + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative Let: + child range : {Range} + child isStrict : {Bool} + child declarations : Declarations + child expression : Expression + visit 0: + local idGam : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local ppExtra : _ + local fixityGam : _ + local eh : _ + local isAsPred : _ + alternative Tuple: + child range : {Range} + child expressions : Expressions + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative Typed: + child range : {Range} + child expression : Expression + child type : Type + visit 0: + local idDefOccGamType : _ + local pp : _ + local eh : _ + local isAsPred : _ + local doGenVarWild : _ + alternative Negate: + child range : {Range} + child expression : Expression + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative Annotate: + child range : {Range} + child annotation : ExpressionAnnotation + child expression : Expression + visit 0: + local eh : _ + local isAsPred : _ + alternative ImpredicativeApplication: + child range : {Range} + child function : Expression + child arguments : Expressions + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative If: + child range : {Range} + child guardExpression : Expression + child thenExpression : Expression + child elseExpression : Expression + visit 0: + local valrefnames : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local typerefname : _ + local idUseOccGamType : _ + local errIdUseType : _ + local idUseOccGam : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative Case: + child range : {Range} + child expression : Expression + child alternatives : Alternatives + visit 0: + local pp : _ + local eh : _ + local caseId : _ + local isAsPred : _ + local lUniq : {UID} + alternative List: + child range : {Range} + child expressions : Expressions + visit 0: + local refnames : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative Enum: + child range : {Range} + child from : Expression + child then : MaybeExpression + child to : MaybeExpression + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local enumNm : _ + local eh : _ + local isAsPred : _ + alternative Comprehension: + child range : {Range} + child expression : Expression + child qualifiers : Qualifiers + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative RecordConstruction: + child range : {Range} + child name : {Name} + child recordExpressionBindings : RecordExpressionBindings + visit 0: + local idAsp : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ + alternative RecordUpdate: + child range : {Range} + child expression : Expression + child recordExpressionBindings : RecordExpressionBindings + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative RowRecordUpdate: + child range : {Range} + child expression : Expression + child rowRecordExpressionUpdates : RowRecordExpressionUpdates + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative RowRecordEmpty: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative RowRecordSelect: + child range : {Range} + child expression : Expression + child name : {Name} + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative Do: + child range : {Range} + child statements : Statements + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative ImplicitApplication: + child range : {Range} + child function : Expression + child arguments : ContextedExpressions + visit 0: + local pp : _ + local eh : _ + local isAsPred : _ + alternative ImplicitLambda: + child range : {Range} + child patterns : ContextedPatterns + child expression : Expression + visit 0: + local idDefOccGamType : _ + local idGam : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local isAsPred : _ +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression_Literal _range _literal) = + (sem_Expression_Literal _range (sem_Literal _literal)) +sem_Expression (Expression_Variable _range _name) = + (sem_Expression_Variable _range _name) +sem_Expression (Expression_Constructor _range _name) = + (sem_Expression_Constructor _range _name) +sem_Expression (Expression_TupleConstructor _range _arity) = + (sem_Expression_TupleConstructor _range _arity) +sem_Expression (Expression_Parenthesized _range _expression) = + (sem_Expression_Parenthesized _range (sem_Expression _expression)) +sem_Expression (Expression_NormalApplication _range _function _arguments) = + (sem_Expression_NormalApplication _range (sem_Expression _function) (sem_Expressions _arguments)) +sem_Expression (Expression_SectionApplication _range _leftExpression _operator _rightExpression) = + (sem_Expression_SectionApplication _range (sem_MaybeExpression _leftExpression) (sem_Expression _operator) (sem_MaybeExpression _rightExpression)) +sem_Expression (Expression_InfixApplication _range _leftExpression _operator _rightExpression) = + (sem_Expression_InfixApplication _range (sem_Expression _leftExpression) (sem_Expression _operator) (sem_Expression _rightExpression)) +sem_Expression (Expression_InfixApplicationChainTop _range _expression) = + (sem_Expression_InfixApplicationChainTop _range (sem_Expression _expression)) +sem_Expression (Expression_Lambda _range _patterns _expression) = + (sem_Expression_Lambda _range (sem_Patterns _patterns) (sem_Expression _expression)) +sem_Expression (Expression_Let _range _isStrict _declarations _expression) = + (sem_Expression_Let _range _isStrict (sem_Declarations _declarations) (sem_Expression _expression)) +sem_Expression (Expression_Tuple _range _expressions) = + (sem_Expression_Tuple _range (sem_Expressions _expressions)) +sem_Expression (Expression_Typed _range _expression _type) = + (sem_Expression_Typed _range (sem_Expression _expression) (sem_Type _type)) +sem_Expression (Expression_Negate _range _expression) = + (sem_Expression_Negate _range (sem_Expression _expression)) +sem_Expression (Expression_Annotate _range _annotation _expression) = + (sem_Expression_Annotate _range (sem_ExpressionAnnotation _annotation) (sem_Expression _expression)) +sem_Expression (Expression_ImpredicativeApplication _range _function _arguments) = + (sem_Expression_ImpredicativeApplication _range (sem_Expression _function) (sem_Expressions _arguments)) +sem_Expression (Expression_If _range _guardExpression _thenExpression _elseExpression) = + (sem_Expression_If _range (sem_Expression _guardExpression) (sem_Expression _thenExpression) (sem_Expression _elseExpression)) +sem_Expression (Expression_Case _range _expression _alternatives) = + (sem_Expression_Case _range (sem_Expression _expression) (sem_Alternatives _alternatives)) +sem_Expression (Expression_List _range _expressions) = + (sem_Expression_List _range (sem_Expressions _expressions)) +sem_Expression (Expression_Enum _range _from _then _to) = + (sem_Expression_Enum _range (sem_Expression _from) (sem_MaybeExpression _then) (sem_MaybeExpression _to)) +sem_Expression (Expression_Comprehension _range _expression _qualifiers) = + (sem_Expression_Comprehension _range (sem_Expression _expression) (sem_Qualifiers _qualifiers)) +sem_Expression (Expression_RecordConstruction _range _name _recordExpressionBindings) = + (sem_Expression_RecordConstruction _range _name (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_RecordUpdate _range _expression _recordExpressionBindings) = + (sem_Expression_RecordUpdate _range (sem_Expression _expression) (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_RowRecordUpdate _range _expression _rowRecordExpressionUpdates) = + (sem_Expression_RowRecordUpdate _range (sem_Expression _expression) (sem_RowRecordExpressionUpdates _rowRecordExpressionUpdates)) +sem_Expression (Expression_RowRecordEmpty _range) = + (sem_Expression_RowRecordEmpty _range) +sem_Expression (Expression_RowRecordSelect _range _expression _name) = + (sem_Expression_RowRecordSelect _range (sem_Expression _expression) _name) +sem_Expression (Expression_Do _range _statements) = + (sem_Expression_Do _range (sem_Statements _statements)) +sem_Expression (Expression_ImplicitApplication _range _function _arguments) = + (sem_Expression_ImplicitApplication _range (sem_Expression _function) (sem_ContextedExpressions _arguments)) +sem_Expression (Expression_ImplicitLambda _range _patterns _expression) = + (sem_Expression_ImplicitLambda _range (sem_ContextedPatterns _patterns) (sem_Expression _expression)) +-- semantic domain +type T_Expression = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( Name,(EH.Expr),ErrSq,UID,IdUseOccGam,(OpChain EH.Expr),MaybeName,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Expression_Literal :: Range -> + T_Literal -> + T_Expression +sem_Expression_Literal range_ literal_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _literalOgUniq :: UID + _literalOidGam :: IdDefOccGam + _literalOnmLev :: NmLev + _literalOopts :: EHCOpts + _literalOpatchEhNmInInstance :: PatchEhNmInInstance + _literalOtopInstanceNmL :: ([HsName]) + _literalIeh :: Literal + _literalIerrSq :: ErrSq + _literalIgUniq :: UID + _literalIidUseOccGam :: IdUseOccGam + _literalIpp :: PP_Doc + _literalIppWrap :: (PP_Doc -> PP_Doc) + _literalItopInstanceNmL :: ([HsName]) + _literalIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 475, column 9) + _litnames = + litNames _lhsIopts _literalIeh False 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 476, column 29) + (_litrefname,_litrefnames,_idUseOccGam,_errIdUse) = + mkUseOccGam' _lhsIopts _lhsIidGam _litnames range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 478, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam, _literalIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 13, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _literalIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 466, column 9) + _eh = + case _literalIeh of + Literal_Int r b s -> fst $ ehExpLitInt r b s 1 _litrefnames + Literal_Char r s -> rngLift r EH.Expr_CConst (head s) + Literal_String r s -> fst $ ehExpLitString _lhsIopts r s _litrefnames + Literal_Float r s -> fst $ ehExpLitFloat r s 1 _litrefnames + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _literalIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _literalIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _literalIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _literalIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _literalItopInstanceNmL + -- copy rule (down) + _literalOgUniq = + _lhsIgUniq + -- copy rule (down) + _literalOidGam = + _lhsIidGam + -- copy rule (down) + _literalOnmLev = + _lhsInmLev + -- copy rule (down) + _literalOopts = + _lhsIopts + -- copy rule (down) + _literalOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _literalOtopInstanceNmL = + _lhsItopInstanceNmL + ( _literalIeh,_literalIerrSq,_literalIgUniq,_literalIidUseOccGam,_literalIpp,_literalIppWrap,_literalItopInstanceNmL,_literalIundefOccGam) = + literal_ _literalOgUniq _literalOidGam _literalOnmLev _literalOopts _literalOpatchEhNmInInstance _literalOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Variable :: Range -> + Name -> + T_Expression +sem_Expression_Variable range_ name_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 480, column 9) + _idAsp = + IdAsp_Val_Var + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 486, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + let x@(n,_,_,_) = mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Val _idAsp range_ + dbgnm = mkHNm "putStrLn" + dbgoc = IdOcc dbgnm IdOcc_Val + in + x + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 15, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 194, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 50, column 9) + _lhsOoperatorName = + Just _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 472, column 9) + _eh = + rngLift range_ EH.Expr_Var _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Constructor :: Range -> + Name -> + T_Expression +sem_Expression_Constructor range_ name_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 483, column 9) + _idAsp = + IdAsp_Val_Con + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 486, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + let x@(n,_,_,_) = mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Val _idAsp range_ + dbgnm = mkHNm "putStrLn" + dbgoc = IdOcc dbgnm IdOcc_Val + in + x + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 263, column 9) + _lhsOconNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 15, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 196, column 9) + _pp = + ppCon name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 50, column 9) + _lhsOoperatorName = + Just _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 474, column 9) + _eh = + rngLift range_ EH.Expr_Con _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_TupleConstructor :: Range -> + Int -> + T_Expression +sem_Expression_TupleConstructor range_ arity_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 198, column 9) + _pp = + ppParens (replicate (arity_ - 1) (',')) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 476, column 9) + _eh = + ehTupleConstructor range_ arity_ EH.Expr_Var EH.PatExpr_Var EH.Expr_Lam + (\_ x -> x) EH.Expr_Rec EH.RecExpr_Ext EH.RecExpr_Empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Parenthesized :: Range -> + T_Expression -> + T_Expression +sem_Expression_Parenthesized range_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 200, column 9) + _pp = + ppParens _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 479, column 9) + _eh = + rngLift range_ EH.Expr_Parens _expressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_NormalApplication :: Range -> + T_Expression -> + T_Expressions -> + T_Expression +sem_Expression_NormalApplication range_ function_ arguments_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOcaseId :: UID + _functionOfixityGam :: FixityGam + _functionOgUniq :: UID + _functionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _functionOidGam :: IdDefOccGam + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOpatchEhNmInInstance :: PatchEhNmInInstance + _functionOpragmas :: (Set.Set Pragma.Pragma) + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOcaseId :: UID + _argumentsOfixityGam :: FixityGam + _argumentsOgUniq :: UID + _argumentsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _argumentsOidGam :: IdDefOccGam + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentsOpragmas :: (Set.Set Pragma.Pragma) + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIeh :: (EH.Expr) + _functionIerrSq :: ErrSq + _functionIgUniq :: UID + _functionIidUseOccGam :: IdUseOccGam + _functionIopChain :: (OpChain EH.Expr) + _functionIoperatorName :: MaybeName + _functionIpp :: PP_Doc + _functionIppWrap :: (PP_Doc -> PP_Doc) + _functionItopInstanceNmL :: ([HsName]) + _functionIundefOccGam :: IdUseOccGam + _argumentsIeh :: ([EH.Expr]) + _argumentsIerrSq :: ErrSq + _argumentsIgUniq :: UID + _argumentsIidUseOccGam :: IdUseOccGam + _argumentsIpp :: PP_Doc + _argumentsIppL :: ([PP_Doc]) + _argumentsIppWrap :: (PP_Doc -> PP_Doc) + _argumentsItopInstanceNmL :: ([HsName]) + _argumentsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 202, column 9) + _pp = + ppAppTop (_functionIconNm,_functionIpp) + _argumentsIppL (_functionIpp >#< ppSpaces _argumentsIppL) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 481, column 9) + _eh = + appRngTopApp range_ (_functionIeh : _argumentsIeh) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _functionIerrSq `Seq.union` _argumentsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _functionIidUseOccGam `gamAddGam` _argumentsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _functionIppWrap . _argumentsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _functionIundefOccGam `gamUnion` _argumentsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOcaseId = + _lhsIcaseId + -- copy rule (down) + _functionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _functionOidGam = + _lhsIidGam + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _functionOpragmas = + _lhsIpragmas + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _argumentsOcaseId = + _lhsIcaseId + -- copy rule (down) + _argumentsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _argumentsOidGam = + _lhsIidGam + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (down) + _argumentsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _argumentsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIeh,_functionIerrSq,_functionIgUniq,_functionIidUseOccGam,_functionIopChain,_functionIoperatorName,_functionIpp,_functionIppWrap,_functionItopInstanceNmL,_functionIundefOccGam) = + function_ _functionOcaseId _functionOfixityGam _functionOgUniq _functionOgenerDerivMp _functionOidGam _functionOmoduleNm _functionOnmLev _functionOopts _functionOpatchEhNmInInstance _functionOpragmas _functionOtopInstanceNmL + ( _argumentsIeh,_argumentsIerrSq,_argumentsIgUniq,_argumentsIidUseOccGam,_argumentsIpp,_argumentsIppL,_argumentsIppWrap,_argumentsItopInstanceNmL,_argumentsIundefOccGam) = + arguments_ _argumentsOcaseId _argumentsOfixityGam _argumentsOgUniq _argumentsOgenerDerivMp _argumentsOidGam _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOpatchEhNmInInstance _argumentsOpragmas _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_SectionApplication :: Range -> + T_MaybeExpression -> + T_Expression -> + T_MaybeExpression -> + T_Expression +sem_Expression_SectionApplication range_ leftExpression_ operator_ rightExpression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _leftExpressionOgUniq :: UID + _lUniq_1_nm :: UID + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftExpressionOcaseId :: UID + _leftExpressionOfixityGam :: FixityGam + _leftExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _leftExpressionOidGam :: IdDefOccGam + _leftExpressionOmoduleNm :: HsName + _leftExpressionOnmLev :: NmLev + _leftExpressionOopts :: EHCOpts + _leftExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _leftExpressionOpragmas :: (Set.Set Pragma.Pragma) + _leftExpressionOtopInstanceNmL :: ([HsName]) + _operatorOcaseId :: UID + _operatorOfixityGam :: FixityGam + _operatorOgUniq :: UID + _operatorOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _operatorOidGam :: IdDefOccGam + _operatorOmoduleNm :: HsName + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOpatchEhNmInInstance :: PatchEhNmInInstance + _operatorOpragmas :: (Set.Set Pragma.Pragma) + _operatorOtopInstanceNmL :: ([HsName]) + _rightExpressionOcaseId :: UID + _rightExpressionOfixityGam :: FixityGam + _rightExpressionOgUniq :: UID + _rightExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _rightExpressionOidGam :: IdDefOccGam + _rightExpressionOmoduleNm :: HsName + _rightExpressionOnmLev :: NmLev + _rightExpressionOopts :: EHCOpts + _rightExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _rightExpressionOpragmas :: (Set.Set Pragma.Pragma) + _rightExpressionOtopInstanceNmL :: ([HsName]) + _leftExpressionIeh :: (Maybe EH.Expr) + _leftExpressionIerrSq :: ErrSq + _leftExpressionIgUniq :: UID + _leftExpressionIidUseOccGam :: IdUseOccGam + _leftExpressionIpp :: PP_Doc + _leftExpressionIppMb :: (Maybe PP_Doc) + _leftExpressionIppWrap :: (PP_Doc -> PP_Doc) + _leftExpressionItopInstanceNmL :: ([HsName]) + _leftExpressionIundefOccGam :: IdUseOccGam + _operatorIconNm :: Name + _operatorIeh :: (EH.Expr) + _operatorIerrSq :: ErrSq + _operatorIgUniq :: UID + _operatorIidUseOccGam :: IdUseOccGam + _operatorIopChain :: (OpChain EH.Expr) + _operatorIoperatorName :: MaybeName + _operatorIpp :: PP_Doc + _operatorIppWrap :: (PP_Doc -> PP_Doc) + _operatorItopInstanceNmL :: ([HsName]) + _operatorIundefOccGam :: IdUseOccGam + _rightExpressionIeh :: (Maybe EH.Expr) + _rightExpressionIerrSq :: ErrSq + _rightExpressionIgUniq :: UID + _rightExpressionIidUseOccGam :: IdUseOccGam + _rightExpressionIpp :: PP_Doc + _rightExpressionIppMb :: (Maybe PP_Doc) + _rightExpressionIppWrap :: (PP_Doc -> PP_Doc) + _rightExpressionItopInstanceNmL :: ([HsName]) + _rightExpressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 207, column 9) + _pp = + let e = case (_leftExpressionIppMb,_rightExpressionIppMb) of + (Just l ,Nothing) -> l >#< _operatorIpp + (Nothing,Just r ) -> _operatorIpp >#< r + (Nothing,Nothing) -> _operatorIpp + in ppParens e + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 487, column 9) + _eh = + ehSection + _lUniq_1_nm range_ + EH.Expr_Var EH.PatExpr_Var EH.Expr_Lam + _leftExpressionIeh _operatorIeh _rightExpressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- -- generated by the unique rule mechanism. + (_leftExpressionOgUniq,_lUniq_1_nm) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq_1_nm) -> (__cont,lUniq_1_nm)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftExpressionIerrSq `Seq.union` _operatorIerrSq `Seq.union` _rightExpressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftExpressionIidUseOccGam `gamAddGam` _operatorIidUseOccGam `gamAddGam` _rightExpressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftExpressionIppWrap . _operatorIppWrap . _rightExpressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftExpressionIundefOccGam `gamUnion` _operatorIundefOccGam `gamUnion` _rightExpressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _rightExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightExpressionItopInstanceNmL + -- copy rule (down) + _leftExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _leftExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _leftExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _leftExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _leftExpressionOopts = + _lhsIopts + -- copy rule (down) + _leftExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftExpressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _leftExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _operatorOcaseId = + _lhsIcaseId + -- copy rule (down) + _operatorOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _operatorOgUniq = + _leftExpressionIgUniq + -- copy rule (down) + _operatorOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _operatorOidGam = + _lhsIidGam + -- copy rule (down) + _operatorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (down) + _operatorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _operatorOpragmas = + _lhsIpragmas + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftExpressionItopInstanceNmL + -- copy rule (down) + _rightExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _rightExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightExpressionOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _rightExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _rightExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _rightExpressionOopts = + _lhsIopts + -- copy rule (down) + _rightExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _rightExpressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _rightExpressionOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftExpressionIeh,_leftExpressionIerrSq,_leftExpressionIgUniq,_leftExpressionIidUseOccGam,_leftExpressionIpp,_leftExpressionIppMb,_leftExpressionIppWrap,_leftExpressionItopInstanceNmL,_leftExpressionIundefOccGam) = + leftExpression_ _leftExpressionOcaseId _leftExpressionOfixityGam _leftExpressionOgUniq _leftExpressionOgenerDerivMp _leftExpressionOidGam _leftExpressionOmoduleNm _leftExpressionOnmLev _leftExpressionOopts _leftExpressionOpatchEhNmInInstance _leftExpressionOpragmas _leftExpressionOtopInstanceNmL + ( _operatorIconNm,_operatorIeh,_operatorIerrSq,_operatorIgUniq,_operatorIidUseOccGam,_operatorIopChain,_operatorIoperatorName,_operatorIpp,_operatorIppWrap,_operatorItopInstanceNmL,_operatorIundefOccGam) = + operator_ _operatorOcaseId _operatorOfixityGam _operatorOgUniq _operatorOgenerDerivMp _operatorOidGam _operatorOmoduleNm _operatorOnmLev _operatorOopts _operatorOpatchEhNmInInstance _operatorOpragmas _operatorOtopInstanceNmL + ( _rightExpressionIeh,_rightExpressionIerrSq,_rightExpressionIgUniq,_rightExpressionIidUseOccGam,_rightExpressionIpp,_rightExpressionIppMb,_rightExpressionIppWrap,_rightExpressionItopInstanceNmL,_rightExpressionIundefOccGam) = + rightExpression_ _rightExpressionOcaseId _rightExpressionOfixityGam _rightExpressionOgUniq _rightExpressionOgenerDerivMp _rightExpressionOidGam _rightExpressionOmoduleNm _rightExpressionOnmLev _rightExpressionOopts _rightExpressionOpatchEhNmInInstance _rightExpressionOpragmas _rightExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_InfixApplication :: Range -> + T_Expression -> + T_Expression -> + T_Expression -> + T_Expression +sem_Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftExpressionOcaseId :: UID + _leftExpressionOfixityGam :: FixityGam + _leftExpressionOgUniq :: UID + _leftExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _leftExpressionOidGam :: IdDefOccGam + _leftExpressionOmoduleNm :: HsName + _leftExpressionOnmLev :: NmLev + _leftExpressionOopts :: EHCOpts + _leftExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _leftExpressionOpragmas :: (Set.Set Pragma.Pragma) + _leftExpressionOtopInstanceNmL :: ([HsName]) + _operatorOcaseId :: UID + _operatorOfixityGam :: FixityGam + _operatorOgUniq :: UID + _operatorOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _operatorOidGam :: IdDefOccGam + _operatorOmoduleNm :: HsName + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOpatchEhNmInInstance :: PatchEhNmInInstance + _operatorOpragmas :: (Set.Set Pragma.Pragma) + _operatorOtopInstanceNmL :: ([HsName]) + _rightExpressionOcaseId :: UID + _rightExpressionOfixityGam :: FixityGam + _rightExpressionOgUniq :: UID + _rightExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _rightExpressionOidGam :: IdDefOccGam + _rightExpressionOmoduleNm :: HsName + _rightExpressionOnmLev :: NmLev + _rightExpressionOopts :: EHCOpts + _rightExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _rightExpressionOpragmas :: (Set.Set Pragma.Pragma) + _rightExpressionOtopInstanceNmL :: ([HsName]) + _leftExpressionIconNm :: Name + _leftExpressionIeh :: (EH.Expr) + _leftExpressionIerrSq :: ErrSq + _leftExpressionIgUniq :: UID + _leftExpressionIidUseOccGam :: IdUseOccGam + _leftExpressionIopChain :: (OpChain EH.Expr) + _leftExpressionIoperatorName :: MaybeName + _leftExpressionIpp :: PP_Doc + _leftExpressionIppWrap :: (PP_Doc -> PP_Doc) + _leftExpressionItopInstanceNmL :: ([HsName]) + _leftExpressionIundefOccGam :: IdUseOccGam + _operatorIconNm :: Name + _operatorIeh :: (EH.Expr) + _operatorIerrSq :: ErrSq + _operatorIgUniq :: UID + _operatorIidUseOccGam :: IdUseOccGam + _operatorIopChain :: (OpChain EH.Expr) + _operatorIoperatorName :: MaybeName + _operatorIpp :: PP_Doc + _operatorIppWrap :: (PP_Doc -> PP_Doc) + _operatorItopInstanceNmL :: ([HsName]) + _operatorIundefOccGam :: IdUseOccGam + _rightExpressionIconNm :: Name + _rightExpressionIeh :: (EH.Expr) + _rightExpressionIerrSq :: ErrSq + _rightExpressionIgUniq :: UID + _rightExpressionIidUseOccGam :: IdUseOccGam + _rightExpressionIopChain :: (OpChain EH.Expr) + _rightExpressionIoperatorName :: MaybeName + _rightExpressionIpp :: PP_Doc + _rightExpressionIppWrap :: (PP_Doc -> PP_Doc) + _rightExpressionItopInstanceNmL :: ([HsName]) + _rightExpressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 205, column 9) + _pp = + _leftExpressionIpp >#< _operatorIpp >#< _rightExpressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 58, column 9) + _fgi = + case _operatorIoperatorName of + Just n + -> fixityGamLookup n _lhsIfixityGam + _ -> defaultFixityGamInfo + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 100, column 9) + _lhsOopChain = + OpChain_Op _operatorIeh _operatorIpp (fgiFixity _fgi) (fgiPrio _fgi) range_ _leftExpressionIopChain _rightExpressionIopChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 483, column 9) + _eh = + appRngParApp range_ [_operatorIeh,_leftExpressionIeh,_rightExpressionIeh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftExpressionIerrSq `Seq.union` _operatorIerrSq `Seq.union` _rightExpressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftExpressionIidUseOccGam `gamAddGam` _operatorIidUseOccGam `gamAddGam` _rightExpressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftExpressionIppWrap . _operatorIppWrap . _rightExpressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftExpressionIundefOccGam `gamUnion` _operatorIundefOccGam `gamUnion` _rightExpressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _rightExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightExpressionItopInstanceNmL + -- copy rule (down) + _leftExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _leftExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftExpressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _leftExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _leftExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _leftExpressionOopts = + _lhsIopts + -- copy rule (down) + _leftExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftExpressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _leftExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _operatorOcaseId = + _lhsIcaseId + -- copy rule (down) + _operatorOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _operatorOgUniq = + _leftExpressionIgUniq + -- copy rule (down) + _operatorOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _operatorOidGam = + _lhsIidGam + -- copy rule (down) + _operatorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (down) + _operatorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _operatorOpragmas = + _lhsIpragmas + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftExpressionItopInstanceNmL + -- copy rule (down) + _rightExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _rightExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightExpressionOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _rightExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _rightExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _rightExpressionOopts = + _lhsIopts + -- copy rule (down) + _rightExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _rightExpressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _rightExpressionOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftExpressionIconNm,_leftExpressionIeh,_leftExpressionIerrSq,_leftExpressionIgUniq,_leftExpressionIidUseOccGam,_leftExpressionIopChain,_leftExpressionIoperatorName,_leftExpressionIpp,_leftExpressionIppWrap,_leftExpressionItopInstanceNmL,_leftExpressionIundefOccGam) = + leftExpression_ _leftExpressionOcaseId _leftExpressionOfixityGam _leftExpressionOgUniq _leftExpressionOgenerDerivMp _leftExpressionOidGam _leftExpressionOmoduleNm _leftExpressionOnmLev _leftExpressionOopts _leftExpressionOpatchEhNmInInstance _leftExpressionOpragmas _leftExpressionOtopInstanceNmL + ( _operatorIconNm,_operatorIeh,_operatorIerrSq,_operatorIgUniq,_operatorIidUseOccGam,_operatorIopChain,_operatorIoperatorName,_operatorIpp,_operatorIppWrap,_operatorItopInstanceNmL,_operatorIundefOccGam) = + operator_ _operatorOcaseId _operatorOfixityGam _operatorOgUniq _operatorOgenerDerivMp _operatorOidGam _operatorOmoduleNm _operatorOnmLev _operatorOopts _operatorOpatchEhNmInInstance _operatorOpragmas _operatorOtopInstanceNmL + ( _rightExpressionIconNm,_rightExpressionIeh,_rightExpressionIerrSq,_rightExpressionIgUniq,_rightExpressionIidUseOccGam,_rightExpressionIopChain,_rightExpressionIoperatorName,_rightExpressionIpp,_rightExpressionIppWrap,_rightExpressionItopInstanceNmL,_rightExpressionIundefOccGam) = + rightExpression_ _rightExpressionOcaseId _rightExpressionOfixityGam _rightExpressionOgUniq _rightExpressionOgenerDerivMp _rightExpressionOidGam _rightExpressionOmoduleNm _rightExpressionOnmLev _rightExpressionOopts _rightExpressionOpatchEhNmInInstance _rightExpressionOpragmas _rightExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_InfixApplicationChainTop :: Range -> + T_Expression -> + T_Expression +sem_Expression_InfixApplicationChainTop range_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 22, column 9) + _errSq = + Seq.unions [Seq.fromList _errRearr, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 106, column 25) + (_ehRearrOpChain,_errRearr) = + opChainReArrange _expressionIopChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 106, column 9) + _ehFromOpChain = + unOpChain _ehRearrOpChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 485, column 9) + _eh = + _ehFromOpChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _expressionIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Lambda :: Range -> + T_Patterns -> + T_Expression -> + T_Expression +sem_Expression_Lambda range_ patterns_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _expressionOidGam :: IdDefOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 344, column 9) + _expressionOidGam = + gamUnion _patternsIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 50, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 104, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _patternsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 20, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _patternsIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 213, column 9) + _pp = + "\\" >|< ppSpaces _patternsIppL >#< "->" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 493, column 9) + _eh = + foldr (rngLift range_ EH.Expr_Lam) _expressionIeh _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternsIidUseOccGam `gamAddGam` _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternsOnmLev = + _nmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _patternsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Let :: Range -> + Bool -> + T_Declarations -> + T_Expression -> + T_Expression +sem_Expression_Let range_ isStrict_ declarations_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOcaseId :: UID + _declarationsOfixityGam :: FixityGam + _declarationsOgUniq :: UID + _declarationsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _declarationsOidGam :: IdDefOccGam + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _declarationsOpragmas :: (Set.Set Pragma.Pragma) + _declarationsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _declarationsIeh :: ([EH.Decl]) + _declarationsIerrSq :: ErrSq + _declarationsIgUniq :: UID + _declarationsIgathFixityGam :: FixityGam + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidDefOccGam :: IdDefOccGam + _declarationsIidDpdMp :: IdDpdMp + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsIidTySigDefOccGam :: IdDefOccGam + _declarationsIidUseOccGam :: IdUseOccGam + _declarationsIneedsError :: Bool + _declarationsIpp :: PP_Doc + _declarationsIppWrap :: (PP_Doc -> PP_Doc) + _declarationsItopInstanceNmL :: ([HsName]) + _declarationsIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 342, column 9) + _idGam = + gamUnion _declarationsIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 890, column 9) + _sccOrder = + idDpdMp2SccOrder _declarationsIidDefOccGam _declarationsIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1020, column 29) + (_mkSccLet,_,_errReorder) = + mkIdOccSccEH range_ isStrict_ _declarationsIidDefOccGam (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 50, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 101, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _declarationsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 17, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, Seq.fromList _errReorder, _declarationsIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 215, column 9) + _pp = + "let" >|< (if isStrict_ then pp "!" else empty) >#< (_declarationsIpp >-< _ppExtra) >#< "in" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 216, column 17) + _ppExtra = + empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 26, column 9) + _fixityGam = + _declarationsIgathFixityGam `gamUnion` _lhsIfixityGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 495, column 9) + _eh = + _mkSccLet _expressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _declarationsIidUseOccGam `gamAddGam` _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _declarationsIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _declarationsIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _declarationsOcaseId = + _lhsIcaseId + -- copy rule (from local) + _declarationsOfixityGam = + _fixityGam + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _declarationsOidGam = + _idGam + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _declarationsOpragmas = + _lhsIpragmas + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (from local) + _expressionOfixityGam = + _fixityGam + -- copy rule (chain) + _expressionOgUniq = + _declarationsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _expressionOidGam = + _idGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _declarationsItopInstanceNmL + ( _declarationsIeh,_declarationsIerrSq,_declarationsIgUniq,_declarationsIgathFixityGam,_declarationsIgathPragmas,_declarationsIidDefOccGam,_declarationsIidDpdMp,_declarationsIidOccDefs,_declarationsIidTySigDefOccGam,_declarationsIidUseOccGam,_declarationsIneedsError,_declarationsIpp,_declarationsIppWrap,_declarationsItopInstanceNmL,_declarationsIundefOccGam) = + declarations_ _declarationsOcaseId _declarationsOfixityGam _declarationsOgUniq _declarationsOgenerDerivMp _declarationsOidGam _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOpatchEhNmInInstance _declarationsOpragmas _declarationsOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Tuple :: Range -> + T_Expressions -> + T_Expression +sem_Expression_Tuple range_ expressions_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionsOcaseId :: UID + _expressionsOfixityGam :: FixityGam + _expressionsOgUniq :: UID + _expressionsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionsOidGam :: IdDefOccGam + _expressionsOmoduleNm :: HsName + _expressionsOnmLev :: NmLev + _expressionsOopts :: EHCOpts + _expressionsOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionsOpragmas :: (Set.Set Pragma.Pragma) + _expressionsOtopInstanceNmL :: ([HsName]) + _expressionsIeh :: ([EH.Expr]) + _expressionsIerrSq :: ErrSq + _expressionsIgUniq :: UID + _expressionsIidUseOccGam :: IdUseOccGam + _expressionsIpp :: PP_Doc + _expressionsIppL :: ([PP_Doc]) + _expressionsIppWrap :: (PP_Doc -> PP_Doc) + _expressionsItopInstanceNmL :: ([HsName]) + _expressionsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 218, column 9) + _pp = + ppParensCommas _expressionsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 497, column 9) + _eh = + ehExpConApp range_ (hsnProd (length _expressionsIeh)) _expressionsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionsItopInstanceNmL + -- copy rule (down) + _expressionsOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionsOidGam = + _lhsIidGam + -- copy rule (down) + _expressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionsOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionsOopts = + _lhsIopts + -- copy rule (down) + _expressionsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionsOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionsIeh,_expressionsIerrSq,_expressionsIgUniq,_expressionsIidUseOccGam,_expressionsIpp,_expressionsIppL,_expressionsIppWrap,_expressionsItopInstanceNmL,_expressionsIundefOccGam) = + expressions_ _expressionsOcaseId _expressionsOfixityGam _expressionsOgUniq _expressionsOgenerDerivMp _expressionsOidGam _expressionsOmoduleNm _expressionsOnmLev _expressionsOopts _expressionsOpatchEhNmInInstance _expressionsOpragmas _expressionsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Typed :: Range -> + T_Expression -> + T_Type -> + T_Expression +sem_Expression_Typed range_ expression_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _lhsOconNm :: Name + _typeOnmLev :: NmLev + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 234, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 346, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 52, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 220, column 9) + _pp = + _expressionIpp >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 499, column 9) + _eh = + rngLift range_ EH.Expr_TypeAs False _typeIeh _expressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 218, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _expressionIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Negate :: Range -> + T_Expression -> + T_Expression +sem_Expression_Negate range_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 496, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnNegate] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 498, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_expressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 24, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 222, column 9) + _pp = + "-" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 501, column 9) + _eh = + ehExpVarApp range_ _refname [_expressionIeh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Annotate :: Range -> + T_ExpressionAnnotation -> + T_Expression -> + T_Expression +sem_Expression_Annotate range_ annotation_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOcaseId :: UID + _annotationOfixityGam :: FixityGam + _annotationOgUniq :: UID + _annotationOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _annotationOidGam :: IdDefOccGam + _annotationOmoduleNm :: HsName + _annotationOnmLev :: NmLev + _annotationOopts :: EHCOpts + _annotationOpatchEhNmInInstance :: PatchEhNmInInstance + _annotationOpragmas :: (Set.Set Pragma.Pragma) + _annotationOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _annotationIeh :: (EH.ExprAnn) + _annotationIerrSq :: ErrSq + _annotationIgUniq :: UID + _annotationIidUseOccGam :: IdUseOccGam + _annotationIpp :: PP_Doc + _annotationIppWrap :: (PP_Doc -> PP_Doc) + _annotationItopInstanceNmL :: ([HsName]) + _annotationIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 503, column 17) + _eh = + rngLift range_ EH.Expr_Ann _annotationIeh _expressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _annotationIerrSq `Seq.union` _expressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _annotationIidUseOccGam `gamAddGam` _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _annotationIpp >-< _expressionIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _annotationIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _annotationIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _annotationOcaseId = + _lhsIcaseId + -- copy rule (down) + _annotationOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _annotationOidGam = + _lhsIidGam + -- copy rule (down) + _annotationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOopts = + _lhsIopts + -- copy rule (down) + _annotationOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _annotationOpragmas = + _lhsIpragmas + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _annotationIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIeh,_annotationIerrSq,_annotationIgUniq,_annotationIidUseOccGam,_annotationIpp,_annotationIppWrap,_annotationItopInstanceNmL,_annotationIundefOccGam) = + annotation_ _annotationOcaseId _annotationOfixityGam _annotationOgUniq _annotationOgenerDerivMp _annotationOidGam _annotationOmoduleNm _annotationOnmLev _annotationOopts _annotationOpatchEhNmInInstance _annotationOpragmas _annotationOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_ImpredicativeApplication :: Range -> + T_Expression -> + T_Expressions -> + T_Expression +sem_Expression_ImpredicativeApplication range_ function_ arguments_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOcaseId :: UID + _functionOfixityGam :: FixityGam + _functionOgUniq :: UID + _functionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _functionOidGam :: IdDefOccGam + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOpatchEhNmInInstance :: PatchEhNmInInstance + _functionOpragmas :: (Set.Set Pragma.Pragma) + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOcaseId :: UID + _argumentsOfixityGam :: FixityGam + _argumentsOgUniq :: UID + _argumentsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _argumentsOidGam :: IdDefOccGam + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentsOpragmas :: (Set.Set Pragma.Pragma) + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIeh :: (EH.Expr) + _functionIerrSq :: ErrSq + _functionIgUniq :: UID + _functionIidUseOccGam :: IdUseOccGam + _functionIopChain :: (OpChain EH.Expr) + _functionIoperatorName :: MaybeName + _functionIpp :: PP_Doc + _functionIppWrap :: (PP_Doc -> PP_Doc) + _functionItopInstanceNmL :: ([HsName]) + _functionIundefOccGam :: IdUseOccGam + _argumentsIeh :: ([EH.Expr]) + _argumentsIerrSq :: ErrSq + _argumentsIgUniq :: UID + _argumentsIidUseOccGam :: IdUseOccGam + _argumentsIpp :: PP_Doc + _argumentsIppL :: ([PP_Doc]) + _argumentsIppWrap :: (PP_Doc -> PP_Doc) + _argumentsItopInstanceNmL :: ([HsName]) + _argumentsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 224, column 9) + _pp = + _functionIpp >#< "~" >|< _argumentsIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 505, column 9) + _eh = + ehExpApp' (rngLift range_ EH.Expr_AppImpred) range_ _functionIeh _argumentsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _functionIerrSq `Seq.union` _argumentsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _functionIidUseOccGam `gamAddGam` _argumentsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _functionIppWrap . _argumentsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _functionIundefOccGam `gamUnion` _argumentsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOcaseId = + _lhsIcaseId + -- copy rule (down) + _functionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _functionOidGam = + _lhsIidGam + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _functionOpragmas = + _lhsIpragmas + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _argumentsOcaseId = + _lhsIcaseId + -- copy rule (down) + _argumentsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _argumentsOidGam = + _lhsIidGam + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (down) + _argumentsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _argumentsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIeh,_functionIerrSq,_functionIgUniq,_functionIidUseOccGam,_functionIopChain,_functionIoperatorName,_functionIpp,_functionIppWrap,_functionItopInstanceNmL,_functionIundefOccGam) = + function_ _functionOcaseId _functionOfixityGam _functionOgUniq _functionOgenerDerivMp _functionOidGam _functionOmoduleNm _functionOnmLev _functionOopts _functionOpatchEhNmInInstance _functionOpragmas _functionOtopInstanceNmL + ( _argumentsIeh,_argumentsIerrSq,_argumentsIgUniq,_argumentsIidUseOccGam,_argumentsIpp,_argumentsIppL,_argumentsIppWrap,_argumentsItopInstanceNmL,_argumentsIundefOccGam) = + arguments_ _argumentsOcaseId _argumentsOfixityGam _argumentsOgUniq _argumentsOgenerDerivMp _argumentsOidGam _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOpatchEhNmInInstance _argumentsOpragmas _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_If :: Range -> + T_Expression -> + T_Expression -> + T_Expression -> + T_Expression +sem_Expression_If range_ guardExpression_ thenExpression_ elseExpression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardExpressionOcaseId :: UID + _guardExpressionOfixityGam :: FixityGam + _guardExpressionOgUniq :: UID + _guardExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _guardExpressionOidGam :: IdDefOccGam + _guardExpressionOmoduleNm :: HsName + _guardExpressionOnmLev :: NmLev + _guardExpressionOopts :: EHCOpts + _guardExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _guardExpressionOpragmas :: (Set.Set Pragma.Pragma) + _guardExpressionOtopInstanceNmL :: ([HsName]) + _thenExpressionOcaseId :: UID + _thenExpressionOfixityGam :: FixityGam + _thenExpressionOgUniq :: UID + _thenExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _thenExpressionOidGam :: IdDefOccGam + _thenExpressionOmoduleNm :: HsName + _thenExpressionOnmLev :: NmLev + _thenExpressionOopts :: EHCOpts + _thenExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _thenExpressionOpragmas :: (Set.Set Pragma.Pragma) + _thenExpressionOtopInstanceNmL :: ([HsName]) + _elseExpressionOcaseId :: UID + _elseExpressionOfixityGam :: FixityGam + _elseExpressionOgUniq :: UID + _elseExpressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _elseExpressionOidGam :: IdDefOccGam + _elseExpressionOmoduleNm :: HsName + _elseExpressionOnmLev :: NmLev + _elseExpressionOopts :: EHCOpts + _elseExpressionOpatchEhNmInInstance :: PatchEhNmInInstance + _elseExpressionOpragmas :: (Set.Set Pragma.Pragma) + _elseExpressionOtopInstanceNmL :: ([HsName]) + _guardExpressionIconNm :: Name + _guardExpressionIeh :: (EH.Expr) + _guardExpressionIerrSq :: ErrSq + _guardExpressionIgUniq :: UID + _guardExpressionIidUseOccGam :: IdUseOccGam + _guardExpressionIopChain :: (OpChain EH.Expr) + _guardExpressionIoperatorName :: MaybeName + _guardExpressionIpp :: PP_Doc + _guardExpressionIppWrap :: (PP_Doc -> PP_Doc) + _guardExpressionItopInstanceNmL :: ([HsName]) + _guardExpressionIundefOccGam :: IdUseOccGam + _thenExpressionIconNm :: Name + _thenExpressionIeh :: (EH.Expr) + _thenExpressionIerrSq :: ErrSq + _thenExpressionIgUniq :: UID + _thenExpressionIidUseOccGam :: IdUseOccGam + _thenExpressionIopChain :: (OpChain EH.Expr) + _thenExpressionIoperatorName :: MaybeName + _thenExpressionIpp :: PP_Doc + _thenExpressionIppWrap :: (PP_Doc -> PP_Doc) + _thenExpressionItopInstanceNmL :: ([HsName]) + _thenExpressionIundefOccGam :: IdUseOccGam + _elseExpressionIconNm :: Name + _elseExpressionIeh :: (EH.Expr) + _elseExpressionIerrSq :: ErrSq + _elseExpressionIgUniq :: UID + _elseExpressionIidUseOccGam :: IdUseOccGam + _elseExpressionIopChain :: (OpChain EH.Expr) + _elseExpressionIoperatorName :: MaybeName + _elseExpressionIpp :: PP_Doc + _elseExpressionIppWrap :: (PP_Doc -> PP_Doc) + _elseExpressionItopInstanceNmL :: ([HsName]) + _elseExpressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 508, column 29) + (_,_valrefnames,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnTrue,hsnFalse] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 510, column 29) + (_typerefname,_,_idUseOccGamType,_errIdUseType) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnBool] IdOcc_Type IdAsp_Type_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 508, column 9) + _idUseOccGam = + gamUnions [_idUseOccGamVal,_idUseOccGamType] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 513, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_guardExpressionIidUseOccGam,_thenExpressionIidUseOccGam,_elseExpressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 30, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUseVal, Seq.fromList _errIdUseType, _guardExpressionIerrSq, _thenExpressionIerrSq, _elseExpressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 226, column 9) + _pp = + "if" >#< _guardExpressionIpp >-< "then" >#< _thenExpressionIpp >-< "else" >#< _elseExpressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 507, column 9) + _eh = + EH.mkIf' (_typerefname : _valrefnames) range_ _guardExpressionIeh _thenExpressionIeh _elseExpressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _guardExpressionIppWrap . _thenExpressionIppWrap . _elseExpressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _guardExpressionIundefOccGam `gamUnion` _thenExpressionIundefOccGam `gamUnion` _elseExpressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _elseExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _elseExpressionItopInstanceNmL + -- copy rule (down) + _guardExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _guardExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _guardExpressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _guardExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _guardExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _guardExpressionOopts = + _lhsIopts + -- copy rule (down) + _guardExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _guardExpressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _guardExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _thenExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _thenExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _thenExpressionOgUniq = + _guardExpressionIgUniq + -- copy rule (down) + _thenExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _thenExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _thenExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _thenExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _thenExpressionOopts = + _lhsIopts + -- copy rule (down) + _thenExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _thenExpressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _thenExpressionOtopInstanceNmL = + _guardExpressionItopInstanceNmL + -- copy rule (down) + _elseExpressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _elseExpressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _elseExpressionOgUniq = + _thenExpressionIgUniq + -- copy rule (down) + _elseExpressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _elseExpressionOidGam = + _lhsIidGam + -- copy rule (down) + _elseExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _elseExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _elseExpressionOopts = + _lhsIopts + -- copy rule (down) + _elseExpressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _elseExpressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _elseExpressionOtopInstanceNmL = + _thenExpressionItopInstanceNmL + ( _guardExpressionIconNm,_guardExpressionIeh,_guardExpressionIerrSq,_guardExpressionIgUniq,_guardExpressionIidUseOccGam,_guardExpressionIopChain,_guardExpressionIoperatorName,_guardExpressionIpp,_guardExpressionIppWrap,_guardExpressionItopInstanceNmL,_guardExpressionIundefOccGam) = + guardExpression_ _guardExpressionOcaseId _guardExpressionOfixityGam _guardExpressionOgUniq _guardExpressionOgenerDerivMp _guardExpressionOidGam _guardExpressionOmoduleNm _guardExpressionOnmLev _guardExpressionOopts _guardExpressionOpatchEhNmInInstance _guardExpressionOpragmas _guardExpressionOtopInstanceNmL + ( _thenExpressionIconNm,_thenExpressionIeh,_thenExpressionIerrSq,_thenExpressionIgUniq,_thenExpressionIidUseOccGam,_thenExpressionIopChain,_thenExpressionIoperatorName,_thenExpressionIpp,_thenExpressionIppWrap,_thenExpressionItopInstanceNmL,_thenExpressionIundefOccGam) = + thenExpression_ _thenExpressionOcaseId _thenExpressionOfixityGam _thenExpressionOgUniq _thenExpressionOgenerDerivMp _thenExpressionOidGam _thenExpressionOmoduleNm _thenExpressionOnmLev _thenExpressionOopts _thenExpressionOpatchEhNmInInstance _thenExpressionOpragmas _thenExpressionOtopInstanceNmL + ( _elseExpressionIconNm,_elseExpressionIeh,_elseExpressionIerrSq,_elseExpressionIgUniq,_elseExpressionIidUseOccGam,_elseExpressionIopChain,_elseExpressionIoperatorName,_elseExpressionIpp,_elseExpressionIppWrap,_elseExpressionItopInstanceNmL,_elseExpressionIundefOccGam) = + elseExpression_ _elseExpressionOcaseId _elseExpressionOfixityGam _elseExpressionOgUniq _elseExpressionOgenerDerivMp _elseExpressionOidGam _elseExpressionOmoduleNm _elseExpressionOnmLev _elseExpressionOopts _elseExpressionOpatchEhNmInInstance _elseExpressionOpragmas _elseExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Case :: Range -> + T_Expression -> + T_Alternatives -> + T_Expression +sem_Expression_Case range_ expression_ alternatives_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _expressionOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _alternativesOcaseId :: UID + _alternativesOfixityGam :: FixityGam + _alternativesOgUniq :: UID + _alternativesOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _alternativesOidGam :: IdDefOccGam + _alternativesOmoduleNm :: HsName + _alternativesOnmLev :: NmLev + _alternativesOopts :: EHCOpts + _alternativesOpatchEhNmInInstance :: PatchEhNmInInstance + _alternativesOpragmas :: (Set.Set Pragma.Pragma) + _alternativesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _alternativesIeh :: ([EH.CaseAlt]) + _alternativesIerrSq :: ErrSq + _alternativesIgUniq :: UID + _alternativesIidUseOccGam :: IdUseOccGam + _alternativesIpp :: PP_Doc + _alternativesIppWrap :: (PP_Doc -> PP_Doc) + _alternativesItopInstanceNmL :: ([HsName]) + _alternativesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 228, column 9) + _pp = + "case" >#< _expressionIpp >#< "of" >-< indent 2 _alternativesIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 509, column 9) + _eh = + EH.mkCase' range_ _expressionIeh (Just $ Set.singleton _caseId) Set.empty False _alternativesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 868, column 9) + _caseId = + _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- -- generated by the unique rule mechanism. + (_expressionOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _alternativesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _alternativesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _alternativesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _alternativesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _alternativesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _alternativesItopInstanceNmL + -- copy rule (from local) + _expressionOcaseId = + _caseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _alternativesOcaseId = + _caseId + -- copy rule (down) + _alternativesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _alternativesOgUniq = + _expressionIgUniq + -- copy rule (down) + _alternativesOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _alternativesOidGam = + _lhsIidGam + -- copy rule (down) + _alternativesOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _alternativesOnmLev = + _lhsInmLev + -- copy rule (down) + _alternativesOopts = + _lhsIopts + -- copy rule (down) + _alternativesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _alternativesOpragmas = + _lhsIpragmas + -- copy rule (chain) + _alternativesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _alternativesIeh,_alternativesIerrSq,_alternativesIgUniq,_alternativesIidUseOccGam,_alternativesIpp,_alternativesIppWrap,_alternativesItopInstanceNmL,_alternativesIundefOccGam) = + alternatives_ _alternativesOcaseId _alternativesOfixityGam _alternativesOgUniq _alternativesOgenerDerivMp _alternativesOidGam _alternativesOmoduleNm _alternativesOnmLev _alternativesOopts _alternativesOpatchEhNmInInstance _alternativesOpragmas _alternativesOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_List :: Range -> + T_Expressions -> + T_Expression +sem_Expression_List range_ expressions_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionsOcaseId :: UID + _expressionsOfixityGam :: FixityGam + _expressionsOgUniq :: UID + _expressionsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionsOidGam :: IdDefOccGam + _expressionsOmoduleNm :: HsName + _expressionsOnmLev :: NmLev + _expressionsOopts :: EHCOpts + _expressionsOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionsOpragmas :: (Set.Set Pragma.Pragma) + _expressionsOtopInstanceNmL :: ([HsName]) + _expressionsIeh :: ([EH.Expr]) + _expressionsIerrSq :: ErrSq + _expressionsIgUniq :: UID + _expressionsIidUseOccGam :: IdUseOccGam + _expressionsIpp :: PP_Doc + _expressionsIppL :: ([PP_Doc]) + _expressionsIppWrap :: (PP_Doc -> PP_Doc) + _expressionsItopInstanceNmL :: ([HsName]) + _expressionsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 500, column 29) + (_,_refnames,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnDataListAltCons,hsnDataListAltNil] IdOcc_Val IdAsp_Val_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 502, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_expressionsIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 26, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _expressionsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 230, column 9) + _pp = + ppBracketsCommas _expressionsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 511, column 9) + _eh = + foldr (\l r -> ehExpConApp range_ (_refnames !! 0) [l,r]) (rngLift range_ EH.Expr_Con (_refnames !! 1)) _expressionsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionsItopInstanceNmL + -- copy rule (down) + _expressionsOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionsOidGam = + _lhsIidGam + -- copy rule (down) + _expressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionsOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionsOopts = + _lhsIopts + -- copy rule (down) + _expressionsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionsOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionsIeh,_expressionsIerrSq,_expressionsIgUniq,_expressionsIidUseOccGam,_expressionsIpp,_expressionsIppL,_expressionsIppWrap,_expressionsItopInstanceNmL,_expressionsIundefOccGam) = + expressions_ _expressionsOcaseId _expressionsOfixityGam _expressionsOgUniq _expressionsOgenerDerivMp _expressionsOidGam _expressionsOmoduleNm _expressionsOnmLev _expressionsOopts _expressionsOpatchEhNmInInstance _expressionsOpragmas _expressionsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Enum :: Range -> + T_Expression -> + T_MaybeExpression -> + T_MaybeExpression -> + T_Expression +sem_Expression_Enum range_ from_ then_ to_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _fromOcaseId :: UID + _fromOfixityGam :: FixityGam + _fromOgUniq :: UID + _fromOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _fromOidGam :: IdDefOccGam + _fromOmoduleNm :: HsName + _fromOnmLev :: NmLev + _fromOopts :: EHCOpts + _fromOpatchEhNmInInstance :: PatchEhNmInInstance + _fromOpragmas :: (Set.Set Pragma.Pragma) + _fromOtopInstanceNmL :: ([HsName]) + _thenOcaseId :: UID + _thenOfixityGam :: FixityGam + _thenOgUniq :: UID + _thenOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _thenOidGam :: IdDefOccGam + _thenOmoduleNm :: HsName + _thenOnmLev :: NmLev + _thenOopts :: EHCOpts + _thenOpatchEhNmInInstance :: PatchEhNmInInstance + _thenOpragmas :: (Set.Set Pragma.Pragma) + _thenOtopInstanceNmL :: ([HsName]) + _toOcaseId :: UID + _toOfixityGam :: FixityGam + _toOgUniq :: UID + _toOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _toOidGam :: IdDefOccGam + _toOmoduleNm :: HsName + _toOnmLev :: NmLev + _toOopts :: EHCOpts + _toOpatchEhNmInInstance :: PatchEhNmInInstance + _toOpragmas :: (Set.Set Pragma.Pragma) + _toOtopInstanceNmL :: ([HsName]) + _fromIconNm :: Name + _fromIeh :: (EH.Expr) + _fromIerrSq :: ErrSq + _fromIgUniq :: UID + _fromIidUseOccGam :: IdUseOccGam + _fromIopChain :: (OpChain EH.Expr) + _fromIoperatorName :: MaybeName + _fromIpp :: PP_Doc + _fromIppWrap :: (PP_Doc -> PP_Doc) + _fromItopInstanceNmL :: ([HsName]) + _fromIundefOccGam :: IdUseOccGam + _thenIeh :: (Maybe EH.Expr) + _thenIerrSq :: ErrSq + _thenIgUniq :: UID + _thenIidUseOccGam :: IdUseOccGam + _thenIpp :: PP_Doc + _thenIppMb :: (Maybe PP_Doc) + _thenIppWrap :: (PP_Doc -> PP_Doc) + _thenItopInstanceNmL :: ([HsName]) + _thenIundefOccGam :: IdUseOccGam + _toIeh :: (Maybe EH.Expr) + _toIerrSq :: ErrSq + _toIgUniq :: UID + _toIidUseOccGam :: IdUseOccGam + _toIpp :: PP_Doc + _toIppMb :: (Maybe PP_Doc) + _toIppWrap :: (PP_Doc -> PP_Doc) + _toItopInstanceNmL :: ([HsName]) + _toIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 504, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [_enumNm] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 506, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_fromIidUseOccGam,_thenIidUseOccGam,_toIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 28, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _fromIerrSq, _thenIerrSq, _toIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 232, column 9) + _pp = + case (_fromIpp,_thenIppMb,_toIppMb) of + (fr,Just th,Just to) -> ppBrackets (fr >|< "," >#< th >#< ".." >#< to) + (fr,Just th,Nothing) -> ppBrackets (fr >|< "," >#< th >#< ".." ) + (fr,Nothing,Just to) -> ppBrackets (fr >#< ".." >#< to ) + (fr,Nothing,Nothing) -> ppBrackets (fr >#< ".." ) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 513, column 9) + _enumNm = + case (_fromIeh,_thenIeh,_toIeh) of + (fr,Just th,Just to) -> hsnEnumFromThenTo + (fr,Just th,Nothing) -> hsnEnumFromThen + (fr,Nothing,Just to) -> hsnEnumFromTo + (fr,Nothing,Nothing) -> hsnEnumFrom + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 513, column 9) + _eh = + case (_fromIeh,_thenIeh,_toIeh) of + (fr,Just th,Just to) -> ehExpVarApp range_ _refname [fr,th,to] + (fr,Just th,Nothing) -> ehExpVarApp range_ _refname [fr,th ] + (fr,Nothing,Just to) -> ehExpVarApp range_ _refname [fr ,to] + (fr,Nothing,Nothing) -> ehExpVarApp range_ _refname [fr ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _fromIppWrap . _thenIppWrap . _toIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _fromIundefOccGam `gamUnion` _thenIundefOccGam `gamUnion` _toIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _toIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _toItopInstanceNmL + -- copy rule (down) + _fromOcaseId = + _lhsIcaseId + -- copy rule (down) + _fromOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _fromOgUniq = + _lhsIgUniq + -- copy rule (down) + _fromOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _fromOidGam = + _lhsIidGam + -- copy rule (down) + _fromOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _fromOnmLev = + _lhsInmLev + -- copy rule (down) + _fromOopts = + _lhsIopts + -- copy rule (down) + _fromOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _fromOpragmas = + _lhsIpragmas + -- copy rule (down) + _fromOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _thenOcaseId = + _lhsIcaseId + -- copy rule (down) + _thenOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _thenOgUniq = + _fromIgUniq + -- copy rule (down) + _thenOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _thenOidGam = + _lhsIidGam + -- copy rule (down) + _thenOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _thenOnmLev = + _lhsInmLev + -- copy rule (down) + _thenOopts = + _lhsIopts + -- copy rule (down) + _thenOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _thenOpragmas = + _lhsIpragmas + -- copy rule (chain) + _thenOtopInstanceNmL = + _fromItopInstanceNmL + -- copy rule (down) + _toOcaseId = + _lhsIcaseId + -- copy rule (down) + _toOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _toOgUniq = + _thenIgUniq + -- copy rule (down) + _toOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _toOidGam = + _lhsIidGam + -- copy rule (down) + _toOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _toOnmLev = + _lhsInmLev + -- copy rule (down) + _toOopts = + _lhsIopts + -- copy rule (down) + _toOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _toOpragmas = + _lhsIpragmas + -- copy rule (chain) + _toOtopInstanceNmL = + _thenItopInstanceNmL + ( _fromIconNm,_fromIeh,_fromIerrSq,_fromIgUniq,_fromIidUseOccGam,_fromIopChain,_fromIoperatorName,_fromIpp,_fromIppWrap,_fromItopInstanceNmL,_fromIundefOccGam) = + from_ _fromOcaseId _fromOfixityGam _fromOgUniq _fromOgenerDerivMp _fromOidGam _fromOmoduleNm _fromOnmLev _fromOopts _fromOpatchEhNmInInstance _fromOpragmas _fromOtopInstanceNmL + ( _thenIeh,_thenIerrSq,_thenIgUniq,_thenIidUseOccGam,_thenIpp,_thenIppMb,_thenIppWrap,_thenItopInstanceNmL,_thenIundefOccGam) = + then_ _thenOcaseId _thenOfixityGam _thenOgUniq _thenOgenerDerivMp _thenOidGam _thenOmoduleNm _thenOnmLev _thenOopts _thenOpatchEhNmInInstance _thenOpragmas _thenOtopInstanceNmL + ( _toIeh,_toIerrSq,_toIgUniq,_toIidUseOccGam,_toIpp,_toIppMb,_toIppWrap,_toItopInstanceNmL,_toIundefOccGam) = + to_ _toOcaseId _toOfixityGam _toOgUniq _toOgenerDerivMp _toOidGam _toOmoduleNm _toOnmLev _toOopts _toOpatchEhNmInInstance _toOpragmas _toOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Comprehension :: Range -> + T_Expression -> + T_Qualifiers -> + T_Expression +sem_Expression_Comprehension range_ expression_ qualifiers_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _expressionOidGam :: IdDefOccGam + _qualifiersOidGam :: IdDefOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _qualifiersOcaseId :: UID + _qualifiersOfixityGam :: FixityGam + _qualifiersOgUniq :: UID + _qualifiersOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _qualifiersOmoduleNm :: HsName + _qualifiersOnmLev :: NmLev + _qualifiersOopts :: EHCOpts + _qualifiersOpatchEhNmInInstance :: PatchEhNmInInstance + _qualifiersOpragmas :: (Set.Set Pragma.Pragma) + _qualifiersOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _qualifiersIeh :: ([EH.Expr -> EH.Expr]) + _qualifiersIerrSq :: ErrSq + _qualifiersIgUniq :: UID + _qualifiersIidGam :: IdDefOccGam + _qualifiersIidUseOccGam :: IdUseOccGam + _qualifiersIpp :: PP_Doc + _qualifiersIppL :: ([PP_Doc]) + _qualifiersIppWrap :: (PP_Doc -> PP_Doc) + _qualifiersItopInstanceNmL :: ([HsName]) + _qualifiersIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 348, column 9) + _expressionOidGam = + _qualifiersIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 349, column 9) + _qualifiersOidGam = + _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 238, column 9) + _pp = + ppBrackets (_expressionIpp >#< "|" >#< ppCommas' _qualifiersIppL) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 524, column 9) + _eh = + foldr ($) _expressionIeh _qualifiersIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _qualifiersIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _qualifiersIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _qualifiersIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _qualifiersIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _qualifiersIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _qualifiersItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _qualifiersOcaseId = + _lhsIcaseId + -- copy rule (down) + _qualifiersOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _qualifiersOgUniq = + _expressionIgUniq + -- copy rule (down) + _qualifiersOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _qualifiersOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _qualifiersOnmLev = + _lhsInmLev + -- copy rule (down) + _qualifiersOopts = + _lhsIopts + -- copy rule (down) + _qualifiersOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _qualifiersOpragmas = + _lhsIpragmas + -- copy rule (chain) + _qualifiersOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _qualifiersIeh,_qualifiersIerrSq,_qualifiersIgUniq,_qualifiersIidGam,_qualifiersIidUseOccGam,_qualifiersIpp,_qualifiersIppL,_qualifiersIppWrap,_qualifiersItopInstanceNmL,_qualifiersIundefOccGam) = + qualifiers_ _qualifiersOcaseId _qualifiersOfixityGam _qualifiersOgUniq _qualifiersOgenerDerivMp _qualifiersOidGam _qualifiersOmoduleNm _qualifiersOnmLev _qualifiersOopts _qualifiersOpatchEhNmInInstance _qualifiersOpragmas _qualifiersOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_RecordConstruction :: Range -> + Name -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordConstruction range_ name_ recordExpressionBindings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsOcaseId :: UID + _recordExpressionBindingsOfixityGam :: FixityGam + _recordExpressionBindingsOgUniq :: UID + _recordExpressionBindingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _recordExpressionBindingsOidGam :: IdDefOccGam + _recordExpressionBindingsOmoduleNm :: HsName + _recordExpressionBindingsOnmLev :: NmLev + _recordExpressionBindingsOopts :: EHCOpts + _recordExpressionBindingsOpatchEhNmInInstance :: PatchEhNmInInstance + _recordExpressionBindingsOpragmas :: (Set.Set Pragma.Pragma) + _recordExpressionBindingsOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsIeh :: ([EH.DataFieldExpr -> EH.DataFieldExpr]) + _recordExpressionBindingsIerrSq :: ErrSq + _recordExpressionBindingsIgUniq :: UID + _recordExpressionBindingsIidUseOccGam :: IdUseOccGam + _recordExpressionBindingsIpp :: PP_Doc + _recordExpressionBindingsIppL :: ([PP_Doc]) + _recordExpressionBindingsIppWrap :: (PP_Doc -> PP_Doc) + _recordExpressionBindingsItopInstanceNmL :: ([HsName]) + _recordExpressionBindingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 483, column 9) + _idAsp = + IdAsp_Val_Con + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 486, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + let x@(n,_,_,_) = mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Val _idAsp range_ + dbgnm = mkHNm "putStrLn" + dbgoc = IdOcc dbgnm IdOcc_Val + in + x + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 494, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_recordExpressionBindingsIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 32, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _recordExpressionBindingsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 240, column 9) + _pp = + name_ >#< ppCurlysCommas' _recordExpressionBindingsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 526, column 9) + _eh = + rngLift range_ EH.Expr_DataFields $ foldl (flip ($)) (rngLift range_ EH.DataFieldExpr_Con _refname) _recordExpressionBindingsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _recordExpressionBindingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _recordExpressionBindingsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _recordExpressionBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordExpressionBindingsItopInstanceNmL + -- copy rule (down) + _recordExpressionBindingsOcaseId = + _lhsIcaseId + -- copy rule (down) + _recordExpressionBindingsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _recordExpressionBindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _recordExpressionBindingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _recordExpressionBindingsOidGam = + _lhsIidGam + -- copy rule (down) + _recordExpressionBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordExpressionBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordExpressionBindingsOopts = + _lhsIopts + -- copy rule (down) + _recordExpressionBindingsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _recordExpressionBindingsOpragmas = + _lhsIpragmas + -- copy rule (down) + _recordExpressionBindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _recordExpressionBindingsIeh,_recordExpressionBindingsIerrSq,_recordExpressionBindingsIgUniq,_recordExpressionBindingsIidUseOccGam,_recordExpressionBindingsIpp,_recordExpressionBindingsIppL,_recordExpressionBindingsIppWrap,_recordExpressionBindingsItopInstanceNmL,_recordExpressionBindingsIundefOccGam) = + recordExpressionBindings_ _recordExpressionBindingsOcaseId _recordExpressionBindingsOfixityGam _recordExpressionBindingsOgUniq _recordExpressionBindingsOgenerDerivMp _recordExpressionBindingsOidGam _recordExpressionBindingsOmoduleNm _recordExpressionBindingsOnmLev _recordExpressionBindingsOopts _recordExpressionBindingsOpatchEhNmInInstance _recordExpressionBindingsOpragmas _recordExpressionBindingsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_RecordUpdate :: Range -> + T_Expression -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordUpdate range_ expression_ recordExpressionBindings_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsOcaseId :: UID + _recordExpressionBindingsOfixityGam :: FixityGam + _recordExpressionBindingsOgUniq :: UID + _recordExpressionBindingsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _recordExpressionBindingsOidGam :: IdDefOccGam + _recordExpressionBindingsOmoduleNm :: HsName + _recordExpressionBindingsOnmLev :: NmLev + _recordExpressionBindingsOopts :: EHCOpts + _recordExpressionBindingsOpatchEhNmInInstance :: PatchEhNmInInstance + _recordExpressionBindingsOpragmas :: (Set.Set Pragma.Pragma) + _recordExpressionBindingsOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _recordExpressionBindingsIeh :: ([EH.DataFieldExpr -> EH.DataFieldExpr]) + _recordExpressionBindingsIerrSq :: ErrSq + _recordExpressionBindingsIgUniq :: UID + _recordExpressionBindingsIidUseOccGam :: IdUseOccGam + _recordExpressionBindingsIpp :: PP_Doc + _recordExpressionBindingsIppL :: ([PP_Doc]) + _recordExpressionBindingsIppWrap :: (PP_Doc -> PP_Doc) + _recordExpressionBindingsItopInstanceNmL :: ([HsName]) + _recordExpressionBindingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 242, column 9) + _pp = + _expressionIpp >#< ppCurlysCommas' _recordExpressionBindingsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 528, column 9) + _eh = + case _recordExpressionBindingsIeh of + b@(_:_) -> rngLift range_ EH.Expr_DataFields $ foldl (flip ($)) (rngLift range_ EH.DataFieldExpr_Expr _expressionIeh) b + _ -> _expressionIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _recordExpressionBindingsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _recordExpressionBindingsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _recordExpressionBindingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _recordExpressionBindingsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _recordExpressionBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordExpressionBindingsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _recordExpressionBindingsOcaseId = + _lhsIcaseId + -- copy rule (down) + _recordExpressionBindingsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _recordExpressionBindingsOgUniq = + _expressionIgUniq + -- copy rule (down) + _recordExpressionBindingsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _recordExpressionBindingsOidGam = + _lhsIidGam + -- copy rule (down) + _recordExpressionBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordExpressionBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordExpressionBindingsOopts = + _lhsIopts + -- copy rule (down) + _recordExpressionBindingsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _recordExpressionBindingsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _recordExpressionBindingsOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _recordExpressionBindingsIeh,_recordExpressionBindingsIerrSq,_recordExpressionBindingsIgUniq,_recordExpressionBindingsIidUseOccGam,_recordExpressionBindingsIpp,_recordExpressionBindingsIppL,_recordExpressionBindingsIppWrap,_recordExpressionBindingsItopInstanceNmL,_recordExpressionBindingsIundefOccGam) = + recordExpressionBindings_ _recordExpressionBindingsOcaseId _recordExpressionBindingsOfixityGam _recordExpressionBindingsOgUniq _recordExpressionBindingsOgenerDerivMp _recordExpressionBindingsOidGam _recordExpressionBindingsOmoduleNm _recordExpressionBindingsOnmLev _recordExpressionBindingsOopts _recordExpressionBindingsOpatchEhNmInInstance _recordExpressionBindingsOpragmas _recordExpressionBindingsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_RowRecordUpdate :: Range -> + T_Expression -> + T_RowRecordExpressionUpdates -> + T_Expression +sem_Expression_RowRecordUpdate range_ expression_ rowRecordExpressionUpdates_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _rowRecordExpressionUpdatesOcaseId :: UID + _rowRecordExpressionUpdatesOfixityGam :: FixityGam + _rowRecordExpressionUpdatesOgUniq :: UID + _rowRecordExpressionUpdatesOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _rowRecordExpressionUpdatesOidGam :: IdDefOccGam + _rowRecordExpressionUpdatesOmoduleNm :: HsName + _rowRecordExpressionUpdatesOnmLev :: NmLev + _rowRecordExpressionUpdatesOopts :: EHCOpts + _rowRecordExpressionUpdatesOpatchEhNmInInstance :: PatchEhNmInInstance + _rowRecordExpressionUpdatesOpragmas :: (Set.Set Pragma.Pragma) + _rowRecordExpressionUpdatesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _rowRecordExpressionUpdatesIeh :: ([EH.Expr -> EH.Expr]) + _rowRecordExpressionUpdatesIerrSq :: ErrSq + _rowRecordExpressionUpdatesIgUniq :: UID + _rowRecordExpressionUpdatesIidUseOccGam :: IdUseOccGam + _rowRecordExpressionUpdatesIpp :: PP_Doc + _rowRecordExpressionUpdatesIppL :: ([PP_Doc]) + _rowRecordExpressionUpdatesIppWrap :: (PP_Doc -> PP_Doc) + _rowRecordExpressionUpdatesItopInstanceNmL :: ([HsName]) + _rowRecordExpressionUpdatesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 244, column 9) + _pp = + ppAppTop (hsnRec,mkPPAppFun hsnRowEmpty _expressionIpp) + _rowRecordExpressionUpdatesIppL _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 532, column 9) + _eh = + foldl (flip ($)) _expressionIeh _rowRecordExpressionUpdatesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq `Seq.union` _rowRecordExpressionUpdatesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _rowRecordExpressionUpdatesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _rowRecordExpressionUpdatesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _rowRecordExpressionUpdatesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _rowRecordExpressionUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowRecordExpressionUpdatesItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rowRecordExpressionUpdatesOcaseId = + _lhsIcaseId + -- copy rule (down) + _rowRecordExpressionUpdatesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rowRecordExpressionUpdatesOgUniq = + _expressionIgUniq + -- copy rule (down) + _rowRecordExpressionUpdatesOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _rowRecordExpressionUpdatesOidGam = + _lhsIidGam + -- copy rule (down) + _rowRecordExpressionUpdatesOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rowRecordExpressionUpdatesOnmLev = + _lhsInmLev + -- copy rule (down) + _rowRecordExpressionUpdatesOopts = + _lhsIopts + -- copy rule (down) + _rowRecordExpressionUpdatesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _rowRecordExpressionUpdatesOpragmas = + _lhsIpragmas + -- copy rule (chain) + _rowRecordExpressionUpdatesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _rowRecordExpressionUpdatesIeh,_rowRecordExpressionUpdatesIerrSq,_rowRecordExpressionUpdatesIgUniq,_rowRecordExpressionUpdatesIidUseOccGam,_rowRecordExpressionUpdatesIpp,_rowRecordExpressionUpdatesIppL,_rowRecordExpressionUpdatesIppWrap,_rowRecordExpressionUpdatesItopInstanceNmL,_rowRecordExpressionUpdatesIundefOccGam) = + rowRecordExpressionUpdates_ _rowRecordExpressionUpdatesOcaseId _rowRecordExpressionUpdatesOfixityGam _rowRecordExpressionUpdatesOgUniq _rowRecordExpressionUpdatesOgenerDerivMp _rowRecordExpressionUpdatesOidGam _rowRecordExpressionUpdatesOmoduleNm _rowRecordExpressionUpdatesOnmLev _rowRecordExpressionUpdatesOopts _rowRecordExpressionUpdatesOpatchEhNmInInstance _rowRecordExpressionUpdatesOpragmas _rowRecordExpressionUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_RowRecordEmpty :: Range -> + T_Expression +sem_Expression_RowRecordEmpty range_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 247, column 9) + _pp = + hsnORec >|< hsnCRec + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 534, column 9) + _eh = + rngLift range_ EH.Expr_Rec (rngLift range_ EH.RecExpr_Empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_RowRecordSelect :: Range -> + T_Expression -> + Name -> + T_Expression +sem_Expression_RowRecordSelect range_ expression_ name_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 249, column 9) + _pp = + _expressionIpp >|< "->" >|< name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 536, column 9) + _eh = + rngLift range_ EH.Expr_Sel _expressionIeh name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_Do :: Range -> + T_Statements -> + T_Expression +sem_Expression_Do range_ statements_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _statementsOcaseId :: UID + _statementsOfixityGam :: FixityGam + _statementsOgUniq :: UID + _statementsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _statementsOidGam :: IdDefOccGam + _statementsOmoduleNm :: HsName + _statementsOnmLev :: NmLev + _statementsOopts :: EHCOpts + _statementsOpatchEhNmInInstance :: PatchEhNmInInstance + _statementsOpragmas :: (Set.Set Pragma.Pragma) + _statementsOtopInstanceNmL :: ([HsName]) + _statementsIeh :: ([(EH.Expr,EH.Expr -> EH.Expr)]) + _statementsIerrSq :: ErrSq + _statementsIgUniq :: UID + _statementsIidUseOccGam :: IdUseOccGam + _statementsIpp :: PP_Doc + _statementsIppL :: ([PP_Doc]) + _statementsIppWrap :: (PP_Doc -> PP_Doc) + _statementsItopInstanceNmL :: ([HsName]) + _statementsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 251, column 9) + _pp = + "do" >#< vlist _statementsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 538, column 25) + (_eh,_) = + foldr1 (\(_,s) (e,_) -> (s e,undefined)) _statementsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _statementsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _statementsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _statementsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _statementsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _statementsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _statementsItopInstanceNmL + -- copy rule (down) + _statementsOcaseId = + _lhsIcaseId + -- copy rule (down) + _statementsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _statementsOgUniq = + _lhsIgUniq + -- copy rule (down) + _statementsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _statementsOidGam = + _lhsIidGam + -- copy rule (down) + _statementsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _statementsOnmLev = + _lhsInmLev + -- copy rule (down) + _statementsOopts = + _lhsIopts + -- copy rule (down) + _statementsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _statementsOpragmas = + _lhsIpragmas + -- copy rule (down) + _statementsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _statementsIeh,_statementsIerrSq,_statementsIgUniq,_statementsIidUseOccGam,_statementsIpp,_statementsIppL,_statementsIppWrap,_statementsItopInstanceNmL,_statementsIundefOccGam) = + statements_ _statementsOcaseId _statementsOfixityGam _statementsOgUniq _statementsOgenerDerivMp _statementsOidGam _statementsOmoduleNm _statementsOnmLev _statementsOopts _statementsOpatchEhNmInInstance _statementsOpragmas _statementsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_ImplicitApplication :: Range -> + T_Expression -> + T_ContextedExpressions -> + T_Expression +sem_Expression_ImplicitApplication range_ function_ arguments_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOcaseId :: UID + _functionOfixityGam :: FixityGam + _functionOgUniq :: UID + _functionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _functionOidGam :: IdDefOccGam + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOpatchEhNmInInstance :: PatchEhNmInInstance + _functionOpragmas :: (Set.Set Pragma.Pragma) + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOcaseId :: UID + _argumentsOfixityGam :: FixityGam + _argumentsOgUniq :: UID + _argumentsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _argumentsOidGam :: IdDefOccGam + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentsOpragmas :: (Set.Set Pragma.Pragma) + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIeh :: (EH.Expr) + _functionIerrSq :: ErrSq + _functionIgUniq :: UID + _functionIidUseOccGam :: IdUseOccGam + _functionIopChain :: (OpChain EH.Expr) + _functionIoperatorName :: MaybeName + _functionIpp :: PP_Doc + _functionIppWrap :: (PP_Doc -> PP_Doc) + _functionItopInstanceNmL :: ([HsName]) + _functionIundefOccGam :: IdUseOccGam + _argumentsIeh :: ([(EH.Expr,EH.PrExpr)]) + _argumentsIerrSq :: ErrSq + _argumentsIgUniq :: UID + _argumentsIidUseOccGam :: IdUseOccGam + _argumentsIpp :: PP_Doc + _argumentsIppL :: ([PP_Doc]) + _argumentsIppWrap :: (PP_Doc -> PP_Doc) + _argumentsItopInstanceNmL :: ([HsName]) + _argumentsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 253, column 9) + _pp = + _functionIpp >#< ppListSep hsnOImpl hsnCImpl ", " _argumentsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 540, column 9) + _eh = + ehExpApp' (\f (e,p) -> rngLift range_ EH.Expr_AppImpl f p e) range_ _functionIeh _argumentsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _functionIerrSq `Seq.union` _argumentsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _functionIidUseOccGam `gamAddGam` _argumentsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _functionIppWrap . _argumentsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _functionIundefOccGam `gamUnion` _argumentsIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOcaseId = + _lhsIcaseId + -- copy rule (down) + _functionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _functionOidGam = + _lhsIidGam + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _functionOpragmas = + _lhsIpragmas + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _argumentsOcaseId = + _lhsIcaseId + -- copy rule (down) + _argumentsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _argumentsOidGam = + _lhsIidGam + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (down) + _argumentsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _argumentsOpragmas = + _lhsIpragmas + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIeh,_functionIerrSq,_functionIgUniq,_functionIidUseOccGam,_functionIopChain,_functionIoperatorName,_functionIpp,_functionIppWrap,_functionItopInstanceNmL,_functionIundefOccGam) = + function_ _functionOcaseId _functionOfixityGam _functionOgUniq _functionOgenerDerivMp _functionOidGam _functionOmoduleNm _functionOnmLev _functionOopts _functionOpatchEhNmInInstance _functionOpragmas _functionOtopInstanceNmL + ( _argumentsIeh,_argumentsIerrSq,_argumentsIgUniq,_argumentsIidUseOccGam,_argumentsIpp,_argumentsIppL,_argumentsIppWrap,_argumentsItopInstanceNmL,_argumentsIundefOccGam) = + arguments_ _argumentsOcaseId _argumentsOfixityGam _argumentsOgUniq _argumentsOgenerDerivMp _argumentsOidGam _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOpatchEhNmInInstance _argumentsOpragmas _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expression_ImplicitLambda :: Range -> + T_ContextedPatterns -> + T_Expression -> + T_Expression +sem_Expression_ImplicitLambda range_ patterns_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _expressionOidGam :: IdDefOccGam + _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([(EH.PatExpr,EH.PrExpr)]) + _patternsIerrSq :: ErrSq + _patternsIfreeTvarS :: HsNameS + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 237, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _patternsIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 351, column 9) + _idGam = + gamUnions [_idDefOccGamType, _lhsIidGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 352, column 9) + _expressionOidGam = + gamUnions [_patternsIidDefOccGam, _idGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 104, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _patternsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 20, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _patternsIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 255, column 9) + _pp = + "\\" >|< ppListSep hsnOImpl hsnCImpl ", " _patternsIppL >#< "->" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 102, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 542, column 9) + _eh = + foldr (\(p,c) e -> rngLift range_ EH.Expr_LamImpl c p e) _expressionIeh _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternsIidUseOccGam `gamAddGam` _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (from local) + _patternsOidGam = + _idGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _patternsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIfreeTvarS,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ExpressionAnnotation ---------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.ExprAnn + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Empty: + visit 0: + local eh : _ +-} +-- cata +sem_ExpressionAnnotation :: ExpressionAnnotation -> + T_ExpressionAnnotation +sem_ExpressionAnnotation (ExpressionAnnotation_Empty) = + (sem_ExpressionAnnotation_Empty) +-- semantic domain +type T_ExpressionAnnotation = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.ExprAnn),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ExpressionAnnotation_Empty :: T_ExpressionAnnotation +sem_ExpressionAnnotation_Empty = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.ExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 908, column 17) + _eh = + EH.ExprAnn_Empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Expressions ------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Expr] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Expression + child tl : Expressions + alternative Nil: +-} +-- cata +sem_Expressions :: Expressions -> + T_Expressions +sem_Expressions list = + (Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list)) +-- semantic domain +type T_Expressions = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Expr]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Expressions_Cons :: T_Expression -> + T_Expressions -> + T_Expressions +sem_Expressions_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIconNm :: Name + _hdIeh :: (EH.Expr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIopChain :: (OpChain EH.Expr) + _hdIoperatorName :: MaybeName + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.Expr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 420, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 454, column 27) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconNm,_hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIopChain,_hdIoperatorName,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 422, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 454, column 27) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FieldDeclaration -------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.DataField + errSq : ErrSq + fldrefnames : Names + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative FieldDeclaration: + child range : {Range} + child names : {Names} + child type : Type + visit 0: + local fldrefnames : _ + local nmLev : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ +-} +-- cata +sem_FieldDeclaration :: FieldDeclaration -> + T_FieldDeclaration +sem_FieldDeclaration (FieldDeclaration_FieldDeclaration _range _names _type) = + (sem_FieldDeclaration_FieldDeclaration _range _names (sem_Type _type)) +-- semantic domain +type T_FieldDeclaration = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.DataField),ErrSq,Names,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FieldDeclaration_FieldDeclaration :: Range -> + Names -> + T_Type -> + T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration range_ names_ type_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.DataField) + _lhsOerrSq :: ErrSq + _lhsOfldrefnames :: Names + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 83, column 9) + _fldrefnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 42, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 190, column 9) + _pp = + ppCommas' names_ >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 340, column 9) + _lhsOeh = + rngLift range_ EH.DataField_Field (Just _fldrefnames) _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 178, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 231, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + _fldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfldrefnames,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FieldDeclarations ------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.DataField] + errSq : ErrSq + fldrefnames : Names + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : FieldDeclaration + child tl : FieldDeclarations + alternative Nil: +-} +-- cata +sem_FieldDeclarations :: FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations list = + (Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list)) +-- semantic domain +type T_FieldDeclarations = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.DataField]),ErrSq,Names,HsNameS,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> + T_FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataField]) + _lhsOerrSq :: ErrSq + _lhsOfldrefnames :: Names + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.DataField) + _hdIerrSq :: ErrSq + _hdIfldrefnames :: Names + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.DataField]) + _tlIerrSq :: ErrSq + _tlIfldrefnames :: Names + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 478, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 334, column 33) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + _hdIfldrefnames ++ _tlIfldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIfldrefnames,_hdIfreeTvarS,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIfldrefnames,_tlIfreeTvarS,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfldrefnames,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataField]) + _lhsOerrSq :: ErrSq + _lhsOfldrefnames :: Names + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 480, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 334, column 33) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfldrefnames,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FunctionBinding --------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Decl + errSq : ErrSq + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative FunctionBinding: + child range : {Range} + child lefthandside : LeftHandSide + child righthandside : RightHandSide + visit 0: + local idDefOccGam : _ + local idUseOccGam : _ + local idUseHereOccL : _ + local undefOccGam : _ + local idDpdMp : _ + local idOccDef : _ + local idOccDefs : _ + local nmLev : _ + local nmLevFun : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local caseId : _ + local lUniq : {UID} +-} +-- cata +sem_FunctionBinding :: FunctionBinding -> + T_FunctionBinding +sem_FunctionBinding (FunctionBinding_FunctionBinding _range _lefthandside _righthandside) = + (sem_FunctionBinding_FunctionBinding _range (sem_LeftHandSide _lefthandside) (sem_RightHandSide _righthandside)) +-- semantic domain +type T_FunctionBinding = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.Decl),ErrSq,UID,IdDefOccGam,IdDpdMp,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FunctionBinding_FunctionBinding :: Range -> + T_LeftHandSide -> + T_RightHandSide -> + T_FunctionBinding +sem_FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _righthandsideOidGam :: IdDefOccGam + _lhsOundefOccGam :: IdUseOccGam + _righthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _righthandsideOsepPP :: PP_Doc + _lhsOeh :: (EH.Decl) + _righthandsideOmustBeMono :: Bool + _lefthandsideOgUniq :: UID + _lUniq :: UID + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOcaseId :: UID + _lefthandsideOfixityGam :: FixityGam + _lefthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _lefthandsideOidGam :: IdDefOccGam + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _lefthandsideOpragmas :: (Set.Set Pragma.Pragma) + _lefthandsideOtopInstanceNmL :: ([HsName]) + _righthandsideOcaseId :: UID + _righthandsideOfixityGam :: FixityGam + _righthandsideOgUniq :: UID + _righthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOpragmas :: (Set.Set Pragma.Pragma) + _righthandsideOtopInstanceNmL :: ([HsName]) + _lefthandsideIeh :: ([EH.PatExpr]) + _lefthandsideIehTyMk :: (EH.Expr -> EH.Expr) + _lefthandsideIerrSq :: ErrSq + _lefthandsideIgUniq :: UID + _lefthandsideIidDefOccGam :: IdDefOccGam + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideIidUseOccGam :: IdUseOccGam + _lefthandsideIpp :: PP_Doc + _lefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _lefthandsideIundefOccGam :: IdUseOccGam + _righthandsideIeh :: (EH.Expr) + _righthandsideIerrSq :: ErrSq + _righthandsideIgUniq :: UID + _righthandsideIidUseOccGam :: IdUseOccGam + _righthandsideIpp :: PP_Doc + _righthandsideIppWrap :: (PP_Doc -> PP_Doc) + _righthandsideItopInstanceNmL :: ([HsName]) + _righthandsideIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 207, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ + (IdAsp_Val_Fun _lefthandsideIeh + (_lefthandsideIehTyMk _righthandsideIeh) + _lUniq) + _idOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 383, column 9) + _righthandsideOidGam = + gamUnion _lefthandsideIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 733, column 29) + (_idUseOccGam,_idUseHereOccL,_,_undefOccGam) = + splitIdUseOccGam _lhsInmLev + (gamUnions [_lefthandsideIidUseOccGam,_righthandsideIidUseOccGam]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 733, column 9) + _idDpdMp = + idToOccL2DpdMp [_idOccDef] _idUseHereOccL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 737, column 9) + _lhsOundefOccGam = + gamUnions [_undefOccGam,_lefthandsideIundefOccGam,_righthandsideIundefOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1082, column 9) + _righthandsideOpatchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 169, column 9) + _idOccDef = + IdOcc _lefthandsideIrefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 169, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 64, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 64, column 9) + _nmLevFun = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 108, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _lefthandsideIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 40, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _lefthandsideIerrSq, _righthandsideIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 311, column 9) + _pp = + _lefthandsideIpp >#< _righthandsideIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 312, column 9) + _righthandsideOsepPP = + pp "=" + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 718, column 9) + _lhsOeh = + let (h,t) = hdAndTl _lefthandsideIeh + in rngLift range_ EH.Decl_Val h + (foldr (rngLift range_ EH.Expr_Lam) + (_lefthandsideIehTyMk _righthandsideIeh) + t) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 873, column 9) + _caseId = + _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 274, column 9) + _righthandsideOmustBeMono = + False + -- -- generated by the unique rule mechanism. + (_lefthandsideOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _idDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _lefthandsideIppWrap . _righthandsideIppWrap + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (from local) + _lefthandsideOcaseId = + _caseId + -- copy rule (down) + _lefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _lefthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _lefthandsideOidGam = + _lhsIidGam + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _lefthandsideOnmLev = + _nmLev + -- copy rule (from local) + _lefthandsideOnmLevFun = + _nmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _lefthandsideOpragmas = + _lhsIpragmas + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _righthandsideOcaseId = + _caseId + -- copy rule (down) + _righthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _righthandsideOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _righthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _righthandsideOnmLev = + _nmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (down) + _righthandsideOpragmas = + _lhsIpragmas + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIeh,_lefthandsideIehTyMk,_lefthandsideIerrSq,_lefthandsideIgUniq,_lefthandsideIidDefOccGam,_lefthandsideIidOccDefs,_lefthandsideIidUseOccGam,_lefthandsideIpp,_lefthandsideIppWrap,_lefthandsideIrefname,_lefthandsideItopInstanceNmL,_lefthandsideIundefOccGam) = + lefthandside_ _lefthandsideOcaseId _lefthandsideOfixityGam _lefthandsideOgUniq _lefthandsideOgenerDerivMp _lefthandsideOidGam _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOpatchEhNmInInstance _lefthandsideOpragmas _lefthandsideOtopInstanceNmL + ( _righthandsideIeh,_righthandsideIerrSq,_righthandsideIgUniq,_righthandsideIidUseOccGam,_righthandsideIpp,_righthandsideIppWrap,_righthandsideItopInstanceNmL,_righthandsideIundefOccGam) = + righthandside_ _righthandsideOcaseId _righthandsideOfixityGam _righthandsideOgUniq _righthandsideOgenerDerivMp _righthandsideOidGam _righthandsideOmoduleNm _righthandsideOmustBeMono _righthandsideOnmLev _righthandsideOopts _righthandsideOpatchEhNmInInstance _righthandsideOpragmas _righthandsideOsepPP _righthandsideOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FunctionBindings -------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Decl] + errSq : ErrSq + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : FunctionBinding + child tl : FunctionBindings + alternative Nil: +-} +-- cata +sem_FunctionBindings :: FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings list = + (Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list)) +-- semantic domain +type T_FunctionBindings = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Decl]),ErrSq,UID,IdDefOccGam,IdDpdMp,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FunctionBindings_Cons :: T_FunctionBinding -> + T_FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.Decl) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidDefOccGam :: IdDefOccGam + _hdIidDpdMp :: IdDpdMp + _hdIidOccDefs :: ([IdOcc]) + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.Decl]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidDefOccGam :: IdDefOccGam + _tlIidDpdMp :: IdDpdMp + _tlIidOccDefs :: ([IdOcc]) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 712, column 32) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _hdIidDpdMp `idDpdMpUnion` _tlIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidDefOccGam,_hdIidDpdMp,_hdIidOccDefs,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidDefOccGam,_tlIidDpdMp,_tlIidOccDefs,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 712, column 32) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FunctionalDependencies -------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.FuncDep] + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : FunctionalDependency + child tl : FunctionalDependencies + alternative Nil: +-} +-- cata +sem_FunctionalDependencies :: FunctionalDependencies -> + T_FunctionalDependencies +sem_FunctionalDependencies list = + (Prelude.foldr sem_FunctionalDependencies_Cons sem_FunctionalDependencies_Nil (Prelude.map sem_FunctionalDependency list)) +-- semantic domain +type T_FunctionalDependencies = FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.FuncDep]),ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FunctionalDependencies_Cons :: T_FunctionalDependency -> + T_FunctionalDependencies -> + T_FunctionalDependencies +sem_FunctionalDependencies_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.FuncDep]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.FuncDep) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidDefOccGam :: IdDefOccGam + _hdIidDpdMp :: IdDpdMp + _hdIidOccDefs :: ([IdOcc]) + _hdIidTySigDefOccGam :: IdDefOccGam + _hdIidUseOccGam :: IdUseOccGam + _hdIneedsError :: Bool + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.FuncDep]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidDefOccGam :: IdDefOccGam + _tlIidDpdMp :: IdDpdMp + _tlIidOccDefs :: ([IdOcc]) + _tlIidTySigDefOccGam :: IdDefOccGam + _tlIidUseOccGam :: IdUseOccGam + _tlIneedsError :: Bool + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 150, column 38) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _hdIidDpdMp `idDpdMpUnion` _tlIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _hdIidTySigDefOccGam `gamAddGam` _tlIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _hdIneedsError || _tlIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIgathPragmas,_hdIidDefOccGam,_hdIidDpdMp,_hdIidOccDefs,_hdIidTySigDefOccGam,_hdIidUseOccGam,_hdIneedsError,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIgathPragmas,_tlIidDefOccGam,_tlIidDpdMp,_tlIidOccDefs,_tlIidTySigDefOccGam,_tlIidUseOccGam,_tlIneedsError,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_FunctionalDependencies_Nil :: T_FunctionalDependencies +sem_FunctionalDependencies_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.FuncDep]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 150, column 38) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- FunctionalDependency ---------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.FuncDep + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Dependency: + child range : {Range} + child fromtypevariables : {Names} + child totypevariables : {Names} + visit 0: + local pp : _ +-} +-- cata +sem_FunctionalDependency :: FunctionalDependency -> + T_FunctionalDependency +sem_FunctionalDependency (FunctionalDependency_Dependency _range _fromtypevariables _totypevariables) = + (sem_FunctionalDependency_Dependency _range _fromtypevariables _totypevariables) +-- semantic domain +type T_FunctionalDependency = FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.FuncDep),ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_FunctionalDependency_Dependency :: Range -> + Names -> + Names -> + T_FunctionalDependency +sem_FunctionalDependency_Dependency range_ fromtypevariables_ totypevariables_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.FuncDep) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 79, column 9) + _pp = + ppSpaces fromtypevariables_ >#< "->" >#< totypevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 156, column 9) + _lhsOeh = + rngLift range_ EH.FuncDep_Dep + (map (rngLift range_ EH.TyVar_Var) fromtypevariables_) + (map (rngLift range_ EH.TyVar_Var) totypevariables_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- GuardedExpression ------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + mustBeMono : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + sepPP : PP_Doc + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : UIDS -> EH.Expr -> EH.Expr + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative GuardedExpression: + child range : {Range} + child guard : Expression + child expression : Expression + visit 0: + local valrefnames : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local typerefname : _ + local idUseOccGamType : _ + local errIdUseType : _ + local idUseOccGam : _ + local errSq : _ + local pp : _ +-} +-- cata +sem_GuardedExpression :: GuardedExpression -> + T_GuardedExpression +sem_GuardedExpression (GuardedExpression_GuardedExpression _range _guard _expression) = + (sem_GuardedExpression_GuardedExpression _range (sem_Expression _guard) (sem_Expression _expression)) +-- semantic domain +type T_GuardedExpression = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + PP_Doc -> + ([HsName]) -> + ( (UIDS -> EH.Expr -> EH.Expr),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_GuardedExpression_GuardedExpression :: Range -> + T_Expression -> + T_Expression -> + T_GuardedExpression +sem_GuardedExpression_GuardedExpression range_ guard_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsImustBeMono + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsIsepPP + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: (UIDS -> EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardOcaseId :: UID + _guardOfixityGam :: FixityGam + _guardOgUniq :: UID + _guardOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _guardOidGam :: IdDefOccGam + _guardOmoduleNm :: HsName + _guardOnmLev :: NmLev + _guardOopts :: EHCOpts + _guardOpatchEhNmInInstance :: PatchEhNmInInstance + _guardOpragmas :: (Set.Set Pragma.Pragma) + _guardOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _guardIconNm :: Name + _guardIeh :: (EH.Expr) + _guardIerrSq :: ErrSq + _guardIgUniq :: UID + _guardIidUseOccGam :: IdUseOccGam + _guardIopChain :: (OpChain EH.Expr) + _guardIoperatorName :: MaybeName + _guardIpp :: PP_Doc + _guardIppWrap :: (PP_Doc -> PP_Doc) + _guardItopInstanceNmL :: ([HsName]) + _guardIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 548, column 29) + (_,_valrefnames,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnTrue,hsnFalse] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 550, column 29) + (_typerefname,_,_idUseOccGamType,_errIdUseType) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnBool] IdOcc_Type IdAsp_Type_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 548, column 9) + _idUseOccGam = + gamUnions [_idUseOccGamVal,_idUseOccGamType] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 553, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_guardIidUseOccGam,_expressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 89, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUseVal, Seq.fromList _errIdUseType, _guardIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 281, column 9) + _pp = + "|" >#< _guardIpp >#< _lhsIsepPP >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 634, column 9) + _lhsOeh = + \failS e -> EH.mkIf'' (_typerefname : _valrefnames) range_ _guardIeh (ehMkEnforceMono range_ _lhsImustBeMono _expressionIeh) e Nothing failS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _guardIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _guardIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _guardOcaseId = + _lhsIcaseId + -- copy rule (down) + _guardOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _guardOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _guardOidGam = + _lhsIidGam + -- copy rule (down) + _guardOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardOnmLev = + _lhsInmLev + -- copy rule (down) + _guardOopts = + _lhsIopts + -- copy rule (down) + _guardOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _guardOpragmas = + _lhsIpragmas + -- copy rule (down) + _guardOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _guardIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _guardItopInstanceNmL + ( _guardIconNm,_guardIeh,_guardIerrSq,_guardIgUniq,_guardIidUseOccGam,_guardIopChain,_guardIoperatorName,_guardIpp,_guardIppWrap,_guardItopInstanceNmL,_guardIundefOccGam) = + guard_ _guardOcaseId _guardOfixityGam _guardOgUniq _guardOgenerDerivMp _guardOidGam _guardOmoduleNm _guardOnmLev _guardOopts _guardOpatchEhNmInInstance _guardOpragmas _guardOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- GuardedExpressions ------------------------------------------ +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + mustBeMono : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + sepPP : PP_Doc + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [UIDS -> EH.Expr -> EH.Expr] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : GuardedExpression + child tl : GuardedExpressions + alternative Nil: +-} +-- cata +sem_GuardedExpressions :: GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions list = + (Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list)) +-- semantic domain +type T_GuardedExpressions = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + PP_Doc -> + ([HsName]) -> + ( ([UIDS -> EH.Expr -> EH.Expr]),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_GuardedExpressions_Cons :: T_GuardedExpression -> + T_GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsImustBeMono + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsIsepPP + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([UIDS -> EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOmustBeMono :: Bool + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOsepPP :: PP_Doc + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOmustBeMono :: Bool + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOsepPP :: PP_Doc + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (UIDS -> EH.Expr -> EH.Expr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([UIDS -> EH.Expr -> EH.Expr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 629, column 34) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOmustBeMono = + _lhsImustBeMono + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOsepPP = + _lhsIsepPP + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOmustBeMono = + _lhsImustBeMono + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (down) + _tlOsepPP = + _lhsIsepPP + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOmustBeMono _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOsepPP _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOmustBeMono _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOsepPP _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsImustBeMono + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsIsepPP + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([UIDS -> EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 629, column 34) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Import ------------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + alternative TypeOrClass: + child range : {Range} + child name : {Name} + child names : {MaybeNames} + alternative TypeOrClassComplete: + child range : {Range} + child name : {Name} +-} +-- cata +sem_Import :: Import -> + T_Import +sem_Import (Import_Variable _range _name) = + (sem_Import_Variable _range _name) +sem_Import (Import_TypeOrClass _range _name _names) = + (sem_Import_TypeOrClass _range _name _names) +sem_Import (Import_TypeOrClassComplete _range _name) = + (sem_Import_TypeOrClassComplete _range _name) +-- semantic domain +type T_Import = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Import_Variable :: Range -> + Name -> + T_Import +sem_Import_Variable range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Import_TypeOrClass :: Range -> + Name -> + MaybeNames -> + T_Import +sem_Import_TypeOrClass range_ name_ names_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Import_TypeOrClassComplete :: Range -> + Name -> + T_Import +sem_Import_TypeOrClassComplete range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ImportDeclaration ------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + modAsMp : Map.Map HsName HsName + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Import: + child range : {Range} + child qualified : {Bool} + child name : {Name} + child asname : {MaybeName} + child importspecification : MaybeImportSpecification + alternative Empty: + child range : {Range} +-} +-- cata +sem_ImportDeclaration :: ImportDeclaration -> + T_ImportDeclaration +sem_ImportDeclaration (ImportDeclaration_Import _range _qualified _name _asname _importspecification) = + (sem_ImportDeclaration_Import _range _qualified _name _asname (sem_MaybeImportSpecification _importspecification)) +sem_ImportDeclaration (ImportDeclaration_Empty _range) = + (sem_ImportDeclaration_Empty _range) +-- semantic domain +type T_ImportDeclaration = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,(Map.Map HsName HsName),PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ImportDeclaration_Import :: Range -> + Bool -> + Name -> + MaybeName -> + T_MaybeImportSpecification -> + T_ImportDeclaration +sem_ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmodAsMp :: (Map.Map HsName HsName) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _importspecificationOfixityGam :: FixityGam + _importspecificationOgUniq :: UID + _importspecificationOidGam :: IdDefOccGam + _importspecificationOisMainMod :: Bool + _importspecificationOisTopMod :: Bool + _importspecificationOmoduleNm :: HsName + _importspecificationOnmLev :: NmLev + _importspecificationOopts :: EHCOpts + _importspecificationOpatchEhNmInInstance :: PatchEhNmInInstance + _importspecificationOtopInstanceNmL :: ([HsName]) + _importspecificationIerrSq :: ErrSq + _importspecificationIgUniq :: UID + _importspecificationIgathFixityGam :: FixityGam + _importspecificationIidUseOccGam :: IdUseOccGam + _importspecificationIpp :: PP_Doc + _importspecificationIppWrap :: (PP_Doc -> PP_Doc) + _importspecificationItopInstanceNmL :: ([HsName]) + _importspecificationIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1048, column 9) + _lhsOmodAsMp = + maybe Map.empty (Map.singleton name_) asname_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _importspecificationIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _importspecificationIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _importspecificationIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _importspecificationIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _importspecificationIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _importspecificationIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _importspecificationIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _importspecificationItopInstanceNmL + -- copy rule (down) + _importspecificationOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _importspecificationOgUniq = + _lhsIgUniq + -- copy rule (down) + _importspecificationOidGam = + _lhsIidGam + -- copy rule (down) + _importspecificationOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _importspecificationOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _importspecificationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importspecificationOnmLev = + _lhsInmLev + -- copy rule (down) + _importspecificationOopts = + _lhsIopts + -- copy rule (down) + _importspecificationOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _importspecificationOtopInstanceNmL = + _lhsItopInstanceNmL + ( _importspecificationIerrSq,_importspecificationIgUniq,_importspecificationIgathFixityGam,_importspecificationIidUseOccGam,_importspecificationIpp,_importspecificationIppWrap,_importspecificationItopInstanceNmL,_importspecificationIundefOccGam) = + importspecification_ _importspecificationOfixityGam _importspecificationOgUniq _importspecificationOidGam _importspecificationOisMainMod _importspecificationOisTopMod _importspecificationOmoduleNm _importspecificationOnmLev _importspecificationOopts _importspecificationOpatchEhNmInInstance _importspecificationOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOmodAsMp,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ImportDeclaration_Empty :: Range -> + T_ImportDeclaration +sem_ImportDeclaration_Empty range_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmodAsMp :: (Map.Map HsName HsName) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1050, column 9) + _lhsOmodAsMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOmodAsMp,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ImportDeclarations ------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + modAsMp : Map.Map HsName HsName + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : ImportDeclaration + child tl : ImportDeclarations + alternative Nil: +-} +-- cata +sem_ImportDeclarations :: ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations list = + (Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list)) +-- semantic domain +type T_ImportDeclarations = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,(Map.Map HsName HsName),PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> + T_ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOmodAsMp :: (Map.Map HsName HsName) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOisMainMod :: Bool + _hdOisTopMod :: Bool + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOisMainMod :: Bool + _tlOisTopMod :: Bool + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIidUseOccGam :: IdUseOccGam + _hdImodAsMp :: (Map.Map HsName HsName) + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIidUseOccGam :: IdUseOccGam + _tlImodAsMp :: (Map.Map HsName HsName) + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1044, column 41) + _lhsOmodAsMp = + _hdImodAsMp `Map.union` _tlImodAsMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _hdOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _tlOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIidUseOccGam,_hdImodAsMp,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOisMainMod _hdOisTopMod _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIidUseOccGam,_tlImodAsMp,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOisMainMod _tlOisTopMod _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOmodAsMp,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOmodAsMp :: (Map.Map HsName HsName) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1044, column 41) + _lhsOmodAsMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOmodAsMp,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- ImportSpecification ----------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Import: + child range : {Range} + child hiding : {Bool} + child imports : Imports +-} +-- cata +sem_ImportSpecification :: ImportSpecification -> + T_ImportSpecification +sem_ImportSpecification (ImportSpecification_Import _range _hiding _imports) = + (sem_ImportSpecification_Import _range _hiding (sem_Imports _imports)) +-- semantic domain +type T_ImportSpecification = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_ImportSpecification_Import :: Range -> + Bool -> + T_Imports -> + T_ImportSpecification +sem_ImportSpecification_Import range_ hiding_ imports_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _importsOfixityGam :: FixityGam + _importsOgUniq :: UID + _importsOidGam :: IdDefOccGam + _importsOisMainMod :: Bool + _importsOisTopMod :: Bool + _importsOmoduleNm :: HsName + _importsOnmLev :: NmLev + _importsOopts :: EHCOpts + _importsOpatchEhNmInInstance :: PatchEhNmInInstance + _importsOtopInstanceNmL :: ([HsName]) + _importsIerrSq :: ErrSq + _importsIgUniq :: UID + _importsIgathFixityGam :: FixityGam + _importsIidUseOccGam :: IdUseOccGam + _importsIpp :: PP_Doc + _importsIppWrap :: (PP_Doc -> PP_Doc) + _importsItopInstanceNmL :: ([HsName]) + _importsIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _importsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _importsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _importsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _importsIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _importsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _importsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _importsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _importsItopInstanceNmL + -- copy rule (down) + _importsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _importsOgUniq = + _lhsIgUniq + -- copy rule (down) + _importsOidGam = + _lhsIidGam + -- copy rule (down) + _importsOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _importsOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _importsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importsOnmLev = + _lhsInmLev + -- copy rule (down) + _importsOopts = + _lhsIopts + -- copy rule (down) + _importsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _importsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _importsIerrSq,_importsIgUniq,_importsIgathFixityGam,_importsIidUseOccGam,_importsIpp,_importsIppWrap,_importsItopInstanceNmL,_importsIundefOccGam) = + imports_ _importsOfixityGam _importsOgUniq _importsOidGam _importsOisMainMod _importsOisTopMod _importsOmoduleNm _importsOnmLev _importsOopts _importsOpatchEhNmInInstance _importsOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Imports ----------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Import + child tl : Imports + alternative Nil: +-} +-- cata +sem_Imports :: Imports -> + T_Imports +sem_Imports list = + (Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list)) +-- semantic domain +type T_Imports = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Imports_Cons :: T_Import -> + T_Imports -> + T_Imports +sem_Imports_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOisMainMod :: Bool + _hdOisTopMod :: Bool + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOisMainMod :: Bool + _tlOisTopMod :: Bool + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathFixityGam :: FixityGam + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _hdIgathFixityGam `gamAddGam` _tlIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _hdOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _tlOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOisMainMod _hdOisTopMod _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIerrSq,_tlIgUniq,_tlIgathFixityGam,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOisMainMod _tlOisTopMod _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Kind -------------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conNm : Name + eh : EH.KiExpr + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative NormalApplication: + child range : {Range} + child function : Kind + child arguments : Kinds + visit 0: + local pp : _ + alternative InfixApplication: + child range : {Range} + child leftKind : Kind + child operator : Kind + child rightKind : Kind + visit 0: + local pp : _ + local eh : _ + alternative Constructor: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local idOccKind : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local pp : _ + alternative Parenthesized: + child range : {Range} + child kind : Kind + visit 0: + local pp : _ + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local idOccKind : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local pp : _ + alternative Forall: + child range : {Range} + child kindvariables : {Names} + child kind : Kind + visit 0: + local idDefOccGamInside : _ + local idGam : _ + local pp : _ + alternative Annotate: + child range : {Range} + child annotation : KindAnnotation + child kind : Kind + visit 0: + local eh : _ +-} +-- cata +sem_Kind :: Kind -> + T_Kind +sem_Kind (Kind_NormalApplication _range _function _arguments) = + (sem_Kind_NormalApplication _range (sem_Kind _function) (sem_Kinds _arguments)) +sem_Kind (Kind_InfixApplication _range _leftKind _operator _rightKind) = + (sem_Kind_InfixApplication _range (sem_Kind _leftKind) (sem_Kind _operator) (sem_Kind _rightKind)) +sem_Kind (Kind_Constructor _range _name) = + (sem_Kind_Constructor _range _name) +sem_Kind (Kind_Parenthesized _range _kind) = + (sem_Kind_Parenthesized _range (sem_Kind _kind)) +sem_Kind (Kind_Variable _range _name) = + (sem_Kind_Variable _range _name) +sem_Kind (Kind_Forall _range _kindvariables _kind) = + (sem_Kind_Forall _range _kindvariables (sem_Kind _kind)) +sem_Kind (Kind_Annotate _range _annotation _kind) = + (sem_Kind_Annotate _range (sem_KindAnnotation _annotation) (sem_Kind _kind)) +-- semantic domain +type T_Kind = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( Name,(EH.KiExpr),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Kind_NormalApplication :: Range -> + T_Kind -> + T_Kinds -> + T_Kind +sem_Kind_NormalApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.KiExpr) + _lhsOconNm :: Name + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOidGam :: IdDefOccGam + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOpatchEhNmInInstance :: PatchEhNmInInstance + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOidGam :: IdDefOccGam + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIeh :: (EH.KiExpr) + _functionIerrSq :: ErrSq + _functionIfreeTvarS :: HsNameS + _functionIgUniq :: UID + _functionIidUseOccGam :: IdUseOccGam + _functionIpp :: PP_Doc + _functionIppWrap :: (PP_Doc -> PP_Doc) + _functionItopInstanceNmL :: ([HsName]) + _functionIundefOccGam :: IdUseOccGam + _argumentsIeh :: ([EH.KiExpr]) + _argumentsIerrSq :: ErrSq + _argumentsIfreeTvarS :: HsNameS + _argumentsIgUniq :: UID + _argumentsIidUseOccGam :: IdUseOccGam + _argumentsIpp :: PP_Doc + _argumentsIppL :: ([PP_Doc]) + _argumentsIppWrap :: (PP_Doc -> PP_Doc) + _argumentsItopInstanceNmL :: ([HsName]) + _argumentsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 99, column 9) + _pp = + ppAppTop (_functionIconNm, _functionIpp) + _argumentsIppL (_functionIpp >#< ppSpaces _argumentsIppL) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 178, column 9) + _lhsOeh = + appTopApp (_functionIeh : _argumentsIeh) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _functionIerrSq `Seq.union` _argumentsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + _functionIfreeTvarS `Set.union` _argumentsIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _functionIidUseOccGam `gamAddGam` _argumentsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _functionIppWrap . _argumentsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _functionIundefOccGam `gamUnion` _argumentsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOidGam = + _lhsIidGam + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOidGam = + _lhsIidGam + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (down) + _argumentsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIeh,_functionIerrSq,_functionIfreeTvarS,_functionIgUniq,_functionIidUseOccGam,_functionIpp,_functionIppWrap,_functionItopInstanceNmL,_functionIundefOccGam) = + function_ _functionOgUniq _functionOidGam _functionOnmLev _functionOopts _functionOpatchEhNmInInstance _functionOtopInstanceNmL + ( _argumentsIeh,_argumentsIerrSq,_argumentsIfreeTvarS,_argumentsIgUniq,_argumentsIidUseOccGam,_argumentsIpp,_argumentsIppL,_argumentsIppWrap,_argumentsItopInstanceNmL,_argumentsIundefOccGam) = + arguments_ _argumentsOgUniq _argumentsOidGam _argumentsOnmLev _argumentsOopts _argumentsOpatchEhNmInInstance _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_InfixApplication :: Range -> + T_Kind -> + T_Kind -> + T_Kind -> + T_Kind +sem_Kind_InfixApplication range_ leftKind_ operator_ rightKind_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.KiExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftKindOgUniq :: UID + _leftKindOidGam :: IdDefOccGam + _leftKindOnmLev :: NmLev + _leftKindOopts :: EHCOpts + _leftKindOpatchEhNmInInstance :: PatchEhNmInInstance + _leftKindOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOidGam :: IdDefOccGam + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOpatchEhNmInInstance :: PatchEhNmInInstance + _operatorOtopInstanceNmL :: ([HsName]) + _rightKindOgUniq :: UID + _rightKindOidGam :: IdDefOccGam + _rightKindOnmLev :: NmLev + _rightKindOopts :: EHCOpts + _rightKindOpatchEhNmInInstance :: PatchEhNmInInstance + _rightKindOtopInstanceNmL :: ([HsName]) + _leftKindIconNm :: Name + _leftKindIeh :: (EH.KiExpr) + _leftKindIerrSq :: ErrSq + _leftKindIfreeTvarS :: HsNameS + _leftKindIgUniq :: UID + _leftKindIidUseOccGam :: IdUseOccGam + _leftKindIpp :: PP_Doc + _leftKindIppWrap :: (PP_Doc -> PP_Doc) + _leftKindItopInstanceNmL :: ([HsName]) + _leftKindIundefOccGam :: IdUseOccGam + _operatorIconNm :: Name + _operatorIeh :: (EH.KiExpr) + _operatorIerrSq :: ErrSq + _operatorIfreeTvarS :: HsNameS + _operatorIgUniq :: UID + _operatorIidUseOccGam :: IdUseOccGam + _operatorIpp :: PP_Doc + _operatorIppWrap :: (PP_Doc -> PP_Doc) + _operatorItopInstanceNmL :: ([HsName]) + _operatorIundefOccGam :: IdUseOccGam + _rightKindIconNm :: Name + _rightKindIeh :: (EH.KiExpr) + _rightKindIerrSq :: ErrSq + _rightKindIfreeTvarS :: HsNameS + _rightKindIgUniq :: UID + _rightKindIidUseOccGam :: IdUseOccGam + _rightKindIpp :: PP_Doc + _rightKindIppWrap :: (PP_Doc -> PP_Doc) + _rightKindItopInstanceNmL :: ([HsName]) + _rightKindIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 102, column 9) + _pp = + let args = [_leftKindIpp,_rightKindIpp] + in ppAppTop (_operatorIconNm, _operatorIpp) + args (_operatorIpp >#< ppSpaces args) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 180, column 9) + _eh = + appRngParApp range_ [_operatorIeh,_leftKindIeh,_rightKindIeh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftKindIerrSq `Seq.union` _operatorIerrSq `Seq.union` _rightKindIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + _leftKindIfreeTvarS `Set.union` _operatorIfreeTvarS `Set.union` _rightKindIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftKindIidUseOccGam `gamAddGam` _operatorIidUseOccGam `gamAddGam` _rightKindIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftKindIppWrap . _operatorIppWrap . _rightKindIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftKindIundefOccGam `gamUnion` _operatorIundefOccGam `gamUnion` _rightKindIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _rightKindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightKindItopInstanceNmL + -- copy rule (down) + _leftKindOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftKindOidGam = + _lhsIidGam + -- copy rule (down) + _leftKindOnmLev = + _lhsInmLev + -- copy rule (down) + _leftKindOopts = + _lhsIopts + -- copy rule (down) + _leftKindOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftKindOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftKindIgUniq + -- copy rule (down) + _operatorOidGam = + _lhsIidGam + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (down) + _operatorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftKindItopInstanceNmL + -- copy rule (chain) + _rightKindOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightKindOidGam = + _lhsIidGam + -- copy rule (down) + _rightKindOnmLev = + _lhsInmLev + -- copy rule (down) + _rightKindOopts = + _lhsIopts + -- copy rule (down) + _rightKindOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightKindOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftKindIconNm,_leftKindIeh,_leftKindIerrSq,_leftKindIfreeTvarS,_leftKindIgUniq,_leftKindIidUseOccGam,_leftKindIpp,_leftKindIppWrap,_leftKindItopInstanceNmL,_leftKindIundefOccGam) = + leftKind_ _leftKindOgUniq _leftKindOidGam _leftKindOnmLev _leftKindOopts _leftKindOpatchEhNmInInstance _leftKindOtopInstanceNmL + ( _operatorIconNm,_operatorIeh,_operatorIerrSq,_operatorIfreeTvarS,_operatorIgUniq,_operatorIidUseOccGam,_operatorIpp,_operatorIppWrap,_operatorItopInstanceNmL,_operatorIundefOccGam) = + operator_ _operatorOgUniq _operatorOidGam _operatorOnmLev _operatorOopts _operatorOpatchEhNmInInstance _operatorOtopInstanceNmL + ( _rightKindIconNm,_rightKindIeh,_rightKindIerrSq,_rightKindIfreeTvarS,_rightKindIgUniq,_rightKindIidUseOccGam,_rightKindIpp,_rightKindIppWrap,_rightKindItopInstanceNmL,_rightKindIundefOccGam) = + rightKind_ _rightKindOgUniq _rightKindOidGam _rightKindOnmLev _rightKindOopts _rightKindOpatchEhNmInInstance _rightKindOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_Constructor :: Range -> + Name -> + T_Kind +sem_Kind_Constructor range_ name_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.KiExpr) + _lhsOconNm :: Name + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 586, column 9) + _idAsp = + IdAsp_Kind_Con + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 586, column 9) + _idOccKind = + IdOcc_Kind + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 592, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] _idOccKind _idAsp range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 106, column 9) + _pp = + ppCon name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 182, column 9) + _lhsOeh = + rngLift range_ EH.KiExpr_Con _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 102, column 9) + _lhsOconNm = + name_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_Parenthesized :: Range -> + T_Kind -> + T_Kind +sem_Kind_Parenthesized range_ kind_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.KiExpr) + _lhsOconNm :: Name + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOidGam :: IdDefOccGam + _kindOnmLev :: NmLev + _kindOopts :: EHCOpts + _kindOpatchEhNmInInstance :: PatchEhNmInInstance + _kindOtopInstanceNmL :: ([HsName]) + _kindIconNm :: Name + _kindIeh :: (EH.KiExpr) + _kindIerrSq :: ErrSq + _kindIfreeTvarS :: HsNameS + _kindIgUniq :: UID + _kindIidUseOccGam :: IdUseOccGam + _kindIpp :: PP_Doc + _kindIppWrap :: (PP_Doc -> PP_Doc) + _kindItopInstanceNmL :: ([HsName]) + _kindIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 108, column 9) + _pp = + ppParens _kindIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 184, column 9) + _lhsOeh = + rngLift range_ EH.KiExpr_Parens _kindIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _kindIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + _kindIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _kindIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _kindIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _kindIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (down) + _kindOidGam = + _lhsIidGam + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (down) + _kindOopts = + _lhsIopts + -- copy rule (down) + _kindOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIconNm,_kindIeh,_kindIerrSq,_kindIfreeTvarS,_kindIgUniq,_kindIidUseOccGam,_kindIpp,_kindIppWrap,_kindItopInstanceNmL,_kindIundefOccGam) = + kind_ _kindOgUniq _kindOidGam _kindOnmLev _kindOopts _kindOpatchEhNmInInstance _kindOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_Variable :: Range -> + Name -> + T_Kind +sem_Kind_Variable range_ name_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.KiExpr) + _lhsOconNm :: Name + _lhsOfreeTvarS :: HsNameS + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 589, column 9) + _idAsp = + IdAsp_Kind_Var + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 589, column 9) + _idOccKind = + IdOcc_Kind + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 592, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] _idOccKind _idAsp range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 110, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 186, column 9) + _lhsOeh = + rngLift range_ EH.KiExpr_Var name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 110, column 9) + _lhsOfreeTvarS = + Set.singleton name_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_Forall :: Range -> + Names -> + T_Kind -> + T_Kind +sem_Kind_Forall range_ kindvariables_ kind_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.KiExpr) + _lhsOconNm :: Name + _lhsOfreeTvarS :: HsNameS + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOidGam :: IdDefOccGam + _kindOnmLev :: NmLev + _kindOopts :: EHCOpts + _kindOpatchEhNmInInstance :: PatchEhNmInInstance + _kindOtopInstanceNmL :: ([HsName]) + _kindIconNm :: Name + _kindIeh :: (EH.KiExpr) + _kindIerrSq :: ErrSq + _kindIfreeTvarS :: HsNameS + _kindIgUniq :: UID + _kindIidUseOccGam :: IdUseOccGam + _kindIpp :: PP_Doc + _kindIppWrap :: (PP_Doc -> PP_Doc) + _kindItopInstanceNmL :: ([HsName]) + _kindIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 247, column 9) + _idDefOccGamInside = + kvarL2IdDefOccGam _lhsInmLev range_ kindvariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 412, column 9) + _idGam = + gamUnion _idDefOccGamInside _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 112, column 9) + _pp = + "forall" >#< ppSpaces kindvariables_ >#< "." >#< _kindIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 188, column 9) + _lhsOeh = + _kindIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 112, column 9) + _lhsOfreeTvarS = + _kindIfreeTvarS `Set.difference` Set.fromList kindvariables_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _kindIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _kindIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _kindIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _kindIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (from local) + _kindOidGam = + _idGam + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (down) + _kindOopts = + _lhsIopts + -- copy rule (down) + _kindOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIconNm,_kindIeh,_kindIerrSq,_kindIfreeTvarS,_kindIgUniq,_kindIidUseOccGam,_kindIpp,_kindIppWrap,_kindItopInstanceNmL,_kindIundefOccGam) = + kind_ _kindOgUniq _kindOidGam _kindOnmLev _kindOopts _kindOpatchEhNmInInstance _kindOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kind_Annotate :: Range -> + T_KindAnnotation -> + T_Kind -> + T_Kind +sem_Kind_Annotate range_ annotation_ kind_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.KiExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOgUniq :: UID + _annotationOidGam :: IdDefOccGam + _annotationOnmLev :: NmLev + _annotationOopts :: EHCOpts + _annotationOpatchEhNmInInstance :: PatchEhNmInInstance + _annotationOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOidGam :: IdDefOccGam + _kindOnmLev :: NmLev + _kindOopts :: EHCOpts + _kindOpatchEhNmInInstance :: PatchEhNmInInstance + _kindOtopInstanceNmL :: ([HsName]) + _annotationIeh :: (EH.KiExprAnn) + _annotationIerrSq :: ErrSq + _annotationIfreeTvarS :: HsNameS + _annotationIgUniq :: UID + _annotationIidUseOccGam :: IdUseOccGam + _annotationIpp :: PP_Doc + _annotationIppWrap :: (PP_Doc -> PP_Doc) + _annotationItopInstanceNmL :: ([HsName]) + _annotationIundefOccGam :: IdUseOccGam + _kindIconNm :: Name + _kindIeh :: (EH.KiExpr) + _kindIerrSq :: ErrSq + _kindIfreeTvarS :: HsNameS + _kindIgUniq :: UID + _kindIidUseOccGam :: IdUseOccGam + _kindIpp :: PP_Doc + _kindIppWrap :: (PP_Doc -> PP_Doc) + _kindItopInstanceNmL :: ([HsName]) + _kindIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 190, column 17) + _eh = + rngLift range_ EH.KiExpr_Ann _annotationIeh _kindIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 104, column 9) + _lhsOconNm = + hsnUnknown + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _annotationIerrSq `Seq.union` _kindIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + _annotationIfreeTvarS `Set.union` _kindIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _annotationIidUseOccGam `gamAddGam` _kindIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _annotationIpp >-< _kindIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _annotationIppWrap . _kindIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _annotationIundefOccGam `gamUnion` _kindIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOidGam = + _lhsIidGam + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOopts = + _lhsIopts + -- copy rule (down) + _annotationOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _kindOgUniq = + _annotationIgUniq + -- copy rule (down) + _kindOidGam = + _lhsIidGam + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (down) + _kindOopts = + _lhsIopts + -- copy rule (down) + _kindOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _kindOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIeh,_annotationIerrSq,_annotationIfreeTvarS,_annotationIgUniq,_annotationIidUseOccGam,_annotationIpp,_annotationIppWrap,_annotationItopInstanceNmL,_annotationIundefOccGam) = + annotation_ _annotationOgUniq _annotationOidGam _annotationOnmLev _annotationOopts _annotationOpatchEhNmInInstance _annotationOtopInstanceNmL + ( _kindIconNm,_kindIeh,_kindIerrSq,_kindIfreeTvarS,_kindIgUniq,_kindIidUseOccGam,_kindIpp,_kindIppWrap,_kindItopInstanceNmL,_kindIundefOccGam) = + kind_ _kindOgUniq _kindOidGam _kindOnmLev _kindOopts _kindOpatchEhNmInInstance _kindOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- KindAnnotation ---------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.KiExprAnn + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Empty: + visit 0: + local eh : _ +-} +-- cata +sem_KindAnnotation :: KindAnnotation -> + T_KindAnnotation +sem_KindAnnotation (KindAnnotation_Empty) = + (sem_KindAnnotation_Empty) +-- semantic domain +type T_KindAnnotation = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.KiExprAnn),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_KindAnnotation_Empty :: T_KindAnnotation +sem_KindAnnotation_Empty = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.KiExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 914, column 17) + _eh = + EH.KiExprAnn_Empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Kinds ------------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.KiExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Kind + child tl : Kinds + alternative Nil: +-} +-- cata +sem_Kinds :: Kinds -> + T_Kinds +sem_Kinds list = + (Prelude.foldr sem_Kinds_Cons sem_Kinds_Nil (Prelude.map sem_Kind list)) +-- semantic domain +type T_Kinds = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.KiExpr]),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Kinds_Cons :: T_Kind -> + T_Kinds -> + T_Kinds +sem_Kinds_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.KiExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIconNm :: Name + _hdIeh :: (EH.KiExpr) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.KiExpr]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 448, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 172, column 21) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconNm,_hdIeh,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOgUniq _hdOidGam _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOgUniq _tlOidGam _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Kinds_Nil :: T_Kinds +sem_Kinds_Nil = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.KiExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 450, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 172, column 21) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 106, column 30) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- LeftHandSide ------------------------------------------------ +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + nmLevFun : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.PatExpr] + ehTyMk : EH.Expr -> EH.Expr + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + refname : HsName + undefOccGam : IdUseOccGam + alternatives: + alternative Function: + child range : {Range} + child name : {Name} + child patterns : Patterns + visit 0: + local refname : _ + local pp : _ + alternative Infix: + child range : {Range} + child leftPattern : Pattern + child operator : {Name} + child rightPattern : Pattern + visit 0: + local patchEhNmInInstance : _ + local refname : _ + local pp : _ + alternative Parenthesized: + child range : {Range} + child lefthandside : LeftHandSide + child patterns : Patterns + visit 0: + local pp : _ + alternative Typed: + child range : {Range} + child lefthandside : LeftHandSide + child type : Type + visit 0: + local idDefOccGamType : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ +-} +-- cata +sem_LeftHandSide :: LeftHandSide -> + T_LeftHandSide +sem_LeftHandSide (LeftHandSide_Function _range _name _patterns) = + (sem_LeftHandSide_Function _range _name (sem_Patterns _patterns)) +sem_LeftHandSide (LeftHandSide_Infix _range _leftPattern _operator _rightPattern) = + (sem_LeftHandSide_Infix _range (sem_Pattern _leftPattern) _operator (sem_Pattern _rightPattern)) +sem_LeftHandSide (LeftHandSide_Parenthesized _range _lefthandside _patterns) = + (sem_LeftHandSide_Parenthesized _range (sem_LeftHandSide _lefthandside) (sem_Patterns _patterns)) +sem_LeftHandSide (LeftHandSide_Typed _range _lefthandside _type) = + (sem_LeftHandSide_Typed _range (sem_LeftHandSide _lefthandside) (sem_Type _type)) +-- semantic domain +type T_LeftHandSide = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.PatExpr]),(EH.Expr -> EH.Expr),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),HsName,([HsName]),IdUseOccGam) +sem_LeftHandSide_Function :: Range -> + Name -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Function range_ name_ patterns_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _lhsOeh :: ([EH.PatExpr]) + _lhsOehTyMk :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1087, column 9) + _patternsOpatchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 47, column 9) + _refname = + hsnSetLevQual _lhsInmLevFun _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 317, column 9) + _pp = + name_ >#< ppSpaces _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 735, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Var + (_lhsIpatchEhNmInInstance _refname) + : _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 755, column 9) + _lhsOehTyMk = + id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (from local) + _lhsOrefname = + _refname + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOehTyMk,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOrefname,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_LeftHandSide_Infix :: Range -> + T_Pattern -> + Name -> + T_Pattern -> + T_LeftHandSide +sem_LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.PatExpr]) + _lhsOehTyMk :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOfixityGam :: FixityGam + _leftPatternOgUniq :: UID + _leftPatternOidGam :: IdDefOccGam + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOopts :: EHCOpts + _leftPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOfixityGam :: FixityGam + _rightPatternOgUniq :: UID + _rightPatternOidGam :: IdDefOccGam + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOopts :: EHCOpts + _rightPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIeh :: (EH.PatExpr) + _leftPatternIerrSq :: ErrSq + _leftPatternIgUniq :: UID + _leftPatternIidDefOccGam :: IdDefOccGam + _leftPatternIidOccDefs :: ([IdOcc]) + _leftPatternIidUseOccGam :: IdUseOccGam + _leftPatternIisVar :: Bool + _leftPatternImbTopRefname :: (Maybe HsName) + _leftPatternIpp :: PP_Doc + _leftPatternIppWrap :: (PP_Doc -> PP_Doc) + _leftPatternItopInstanceNmL :: ([HsName]) + _leftPatternIundefOccGam :: IdUseOccGam + _rightPatternIeh :: (EH.PatExpr) + _rightPatternIerrSq :: ErrSq + _rightPatternIgUniq :: UID + _rightPatternIidDefOccGam :: IdDefOccGam + _rightPatternIidOccDefs :: ([IdOcc]) + _rightPatternIidUseOccGam :: IdUseOccGam + _rightPatternIisVar :: Bool + _rightPatternImbTopRefname :: (Maybe HsName) + _rightPatternIpp :: PP_Doc + _rightPatternIppWrap :: (PP_Doc -> PP_Doc) + _rightPatternItopInstanceNmL :: ([HsName]) + _rightPatternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1090, column 9) + _patchEhNmInInstance = + id + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 49, column 9) + _refname = + hsnSetLevQual _lhsInmLevFun _lhsImoduleNm operator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 319, column 9) + _pp = + _leftPatternIpp >#< operator_ >#< _rightPatternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 739, column 9) + _lhsOeh = + [ rngLift range_ EH.PatExpr_Var + (_lhsIpatchEhNmInInstance _refname) + , _leftPatternIeh + , _rightPatternIeh + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 755, column 9) + _lhsOehTyMk = + id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftPatternIerrSq `Seq.union` _rightPatternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _leftPatternIidDefOccGam `gamAddGam` _rightPatternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _leftPatternIidOccDefs ++ _rightPatternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftPatternIidUseOccGam `gamAddGam` _rightPatternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftPatternIppWrap . _rightPatternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftPatternIundefOccGam `gamUnion` _rightPatternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (from local) + _lhsOrefname = + _refname + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOidGam = + _lhsIidGam + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOopts = + _lhsIopts + -- copy rule (from local) + _leftPatternOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rightPatternOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOidGam = + _lhsIidGam + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _rightPatternOopts = + _lhsIopts + -- copy rule (from local) + _rightPatternOpatchEhNmInInstance = + _patchEhNmInInstance + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIeh,_leftPatternIerrSq,_leftPatternIgUniq,_leftPatternIidDefOccGam,_leftPatternIidOccDefs,_leftPatternIidUseOccGam,_leftPatternIisVar,_leftPatternImbTopRefname,_leftPatternIpp,_leftPatternIppWrap,_leftPatternItopInstanceNmL,_leftPatternIundefOccGam) = + leftPattern_ _leftPatternOfixityGam _leftPatternOgUniq _leftPatternOidGam _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOopts _leftPatternOpatchEhNmInInstance _leftPatternOtopInstanceNmL + ( _rightPatternIeh,_rightPatternIerrSq,_rightPatternIgUniq,_rightPatternIidDefOccGam,_rightPatternIidOccDefs,_rightPatternIidUseOccGam,_rightPatternIisVar,_rightPatternImbTopRefname,_rightPatternIpp,_rightPatternIppWrap,_rightPatternItopInstanceNmL,_rightPatternIundefOccGam) = + rightPattern_ _rightPatternOfixityGam _rightPatternOgUniq _rightPatternOidGam _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOopts _rightPatternOpatchEhNmInInstance _rightPatternOtopInstanceNmL + in ( _lhsOeh,_lhsOehTyMk,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOrefname,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_LeftHandSide_Parenthesized :: Range -> + T_LeftHandSide -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Parenthesized range_ lefthandside_ patterns_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.PatExpr]) + _lhsOehTyMk :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOcaseId :: UID + _lefthandsideOfixityGam :: FixityGam + _lefthandsideOgUniq :: UID + _lefthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _lefthandsideOidGam :: IdDefOccGam + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _lefthandsideOpragmas :: (Set.Set Pragma.Pragma) + _lefthandsideOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _lefthandsideIeh :: ([EH.PatExpr]) + _lefthandsideIehTyMk :: (EH.Expr -> EH.Expr) + _lefthandsideIerrSq :: ErrSq + _lefthandsideIgUniq :: UID + _lefthandsideIidDefOccGam :: IdDefOccGam + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideIidUseOccGam :: IdUseOccGam + _lefthandsideIpp :: PP_Doc + _lefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _lefthandsideIundefOccGam :: IdUseOccGam + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 321, column 9) + _pp = + ppParens _lefthandsideIpp >#< ppSpaces _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 745, column 9) + _lhsOeh = + _lefthandsideIeh ++ _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 755, column 9) + _lhsOehTyMk = + id + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _lefthandsideIerrSq `Seq.union` _patternsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _lefthandsideIidDefOccGam `gamAddGam` _patternsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs ++ _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _lefthandsideIidUseOccGam `gamAddGam` _patternsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _lefthandsideIppWrap . _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _lefthandsideIundefOccGam `gamUnion` _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOrefname = + _lefthandsideIrefname + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _lefthandsideOcaseId = + _lhsIcaseId + -- copy rule (down) + _lefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _lefthandsideOidGam = + _lhsIidGam + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOnmLevFun = + _lhsInmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _lefthandsideOpragmas = + _lhsIpragmas + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _patternsOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _patternsOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIeh,_lefthandsideIehTyMk,_lefthandsideIerrSq,_lefthandsideIgUniq,_lefthandsideIidDefOccGam,_lefthandsideIidOccDefs,_lefthandsideIidUseOccGam,_lefthandsideIpp,_lefthandsideIppWrap,_lefthandsideIrefname,_lefthandsideItopInstanceNmL,_lefthandsideIundefOccGam) = + lefthandside_ _lefthandsideOcaseId _lefthandsideOfixityGam _lefthandsideOgUniq _lefthandsideOgenerDerivMp _lefthandsideOidGam _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOpatchEhNmInInstance _lefthandsideOpragmas _lefthandsideOtopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOehTyMk,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOrefname,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_LeftHandSide_Typed :: Range -> + T_LeftHandSide -> + T_Type -> + T_LeftHandSide +sem_LeftHandSide_Typed range_ lefthandside_ type_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _typeOnmLev :: NmLev + _lhsOeh :: ([EH.PatExpr]) + _lhsOehTyMk :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOcaseId :: UID + _lefthandsideOfixityGam :: FixityGam + _lefthandsideOgUniq :: UID + _lefthandsideOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _lefthandsideOidGam :: IdDefOccGam + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _lefthandsideOpragmas :: (Set.Set Pragma.Pragma) + _lefthandsideOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _lefthandsideIeh :: ([EH.PatExpr]) + _lefthandsideIehTyMk :: (EH.Expr -> EH.Expr) + _lefthandsideIerrSq :: ErrSq + _lefthandsideIgUniq :: UID + _lefthandsideIidDefOccGam :: IdDefOccGam + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideIidUseOccGam :: IdUseOccGam + _lefthandsideIpp :: PP_Doc + _lefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _lefthandsideIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 225, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 360, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 60, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 323, column 9) + _pp = + _lefthandsideIpp >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 747, column 9) + _lhsOeh = + _lefthandsideIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 753, column 9) + _lhsOehTyMk = + rngLift range_ EH.Expr_TypeAs True _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 197, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 206, column 9) + _doGenVarWild = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _lefthandsideIerrSq `Seq.union` _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _lefthandsideIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _lefthandsideIidUseOccGam `gamAddGam` _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _lefthandsideIppWrap . _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _lefthandsideIundefOccGam `gamUnion` _typeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOrefname = + _lefthandsideIrefname + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _lefthandsideOcaseId = + _lhsIcaseId + -- copy rule (down) + _lefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _lefthandsideOidGam = + _lhsIidGam + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOnmLevFun = + _lhsInmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _lefthandsideOpragmas = + _lhsIpragmas + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _lefthandsideIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIeh,_lefthandsideIehTyMk,_lefthandsideIerrSq,_lefthandsideIgUniq,_lefthandsideIidDefOccGam,_lefthandsideIidOccDefs,_lefthandsideIidUseOccGam,_lefthandsideIpp,_lefthandsideIppWrap,_lefthandsideIrefname,_lefthandsideItopInstanceNmL,_lefthandsideIundefOccGam) = + lefthandside_ _lefthandsideOcaseId _lefthandsideOfixityGam _lefthandsideOgUniq _lefthandsideOgenerDerivMp _lefthandsideOidGam _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOpatchEhNmInInstance _lefthandsideOpragmas _lefthandsideOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOehTyMk,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOrefname,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Literal ----------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : Literal + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Int: + child range : {Range} + child base : {Int} + child value : {String} + visit 0: + local pp : _ + local eh : _ + alternative Char: + child range : {Range} + child value : {String} + visit 0: + local pp : _ + local eh : _ + alternative String: + child range : {Range} + child value : {String} + visit 0: + local pp : _ + local eh : _ + alternative Float: + child range : {Range} + child value : {String} + visit 0: + local pp : _ + local eh : _ +-} +-- cata +sem_Literal :: Literal -> + T_Literal +sem_Literal (Literal_Int _range _base _value) = + (sem_Literal_Int _range _base _value) +sem_Literal (Literal_Char _range _value) = + (sem_Literal_Char _range _value) +sem_Literal (Literal_String _range _value) = + (sem_Literal_String _range _value) +sem_Literal (Literal_Float _range _value) = + (sem_Literal_Float _range _value) +-- semantic domain +type T_Literal = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( Literal,ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Literal_Int :: Range -> + Int -> + String -> + T_Literal +sem_Literal_Int range_ base_ value_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: Literal + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 384, column 9) + _pp = + pp value_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- self rule + _eh = + Literal_Int range_ base_ value_ + -- self rule + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Literal_Char :: Range -> + String -> + T_Literal +sem_Literal_Char range_ value_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: Literal + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 386, column 9) + _pp = + pp ("'" ++ value_ ++ "'") + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- self rule + _eh = + Literal_Char range_ value_ + -- self rule + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Literal_String :: Range -> + String -> + T_Literal +sem_Literal_String range_ value_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: Literal + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 388, column 9) + _pp = + pp (show value_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- self rule + _eh = + Literal_String range_ value_ + -- self rule + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Literal_Float :: Range -> + String -> + T_Literal +sem_Literal_Float range_ value_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: Literal + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 390, column 9) + _pp = + pp value_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- self rule + _eh = + Literal_Float range_ value_ + -- self rule + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- MaybeDeclarations ------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : Maybe [EH.Decl] + errSq : ErrSq + gathFixityGam : FixityGam + gathPragmas : Set.Set Pragma.Pragma + idDefOccGam : IdDefOccGam + idDpdMp : IdDpdMp + idOccDefs : [IdOcc] + idTySigDefOccGam : IdDefOccGam + idUseOccGam : IdUseOccGam + needsError : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Just: + child just : Declarations + visit 0: + local pp : _ + alternative Nothing: +-} +-- cata +sem_MaybeDeclarations :: MaybeDeclarations -> + T_MaybeDeclarations +sem_MaybeDeclarations (Prelude.Just x) = + (sem_MaybeDeclarations_Just (sem_Declarations x)) +sem_MaybeDeclarations Prelude.Nothing = + sem_MaybeDeclarations_Nothing +-- semantic domain +type T_MaybeDeclarations = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (Maybe [EH.Decl]),ErrSq,UID,FixityGam,(Set.Set Pragma.Pragma),IdDefOccGam,IdDpdMp,([IdOcc]),IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_MaybeDeclarations_Just :: T_Declarations -> + T_MaybeDeclarations +sem_MaybeDeclarations_Just just_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (Maybe [EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOcaseId :: UID + _justOfixityGam :: FixityGam + _justOgUniq :: UID + _justOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _justOidGam :: IdDefOccGam + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOpatchEhNmInInstance :: PatchEhNmInInstance + _justOpragmas :: (Set.Set Pragma.Pragma) + _justOtopInstanceNmL :: ([HsName]) + _justIeh :: ([EH.Decl]) + _justIerrSq :: ErrSq + _justIgUniq :: UID + _justIgathFixityGam :: FixityGam + _justIgathPragmas :: (Set.Set Pragma.Pragma) + _justIidDefOccGam :: IdDefOccGam + _justIidDpdMp :: IdDpdMp + _justIidOccDefs :: ([IdOcc]) + _justIidTySigDefOccGam :: IdDefOccGam + _justIidUseOccGam :: IdUseOccGam + _justIneedsError :: Bool + _justIpp :: PP_Doc + _justIppWrap :: (PP_Doc -> PP_Doc) + _justItopInstanceNmL :: ([HsName]) + _justIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 25, column 9) + _pp = + "where" >#< _justIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 72, column 9) + _lhsOeh = + Just _justIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _justIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _justIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _justIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _justIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + _justIidDpdMp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _justIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + _justIidTySigDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _justIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + _justIneedsError + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _justIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _justIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOcaseId = + _lhsIcaseId + -- copy rule (down) + _justOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _justOidGam = + _lhsIidGam + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _justOpragmas = + _lhsIpragmas + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIeh,_justIerrSq,_justIgUniq,_justIgathFixityGam,_justIgathPragmas,_justIidDefOccGam,_justIidDpdMp,_justIidOccDefs,_justIidTySigDefOccGam,_justIidUseOccGam,_justIneedsError,_justIpp,_justIppWrap,_justItopInstanceNmL,_justIundefOccGam) = + just_ _justOcaseId _justOfixityGam _justOgUniq _justOgenerDerivMp _justOidGam _justOmoduleNm _justOnmLev _justOopts _justOpatchEhNmInInstance _justOpragmas _justOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (Maybe [EH.Decl]) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidDpdMp :: IdDpdMp + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidTySigDefOccGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOneedsError :: Bool + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 64, column 33) + _lhsOeh = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 728, column 19) + _lhsOidDpdMp = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 269, column 28) + _lhsOidTySigDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 693, column 38) + _lhsOneedsError = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathPragmas,_lhsOidDefOccGam,_lhsOidDpdMp,_lhsOidOccDefs,_lhsOidTySigDefOccGam,_lhsOidUseOccGam,_lhsOneedsError,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- MaybeExports ------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Just: + child just : Exports + alternative Nothing: +-} +-- cata +sem_MaybeExports :: MaybeExports -> + T_MaybeExports +sem_MaybeExports (Prelude.Just x) = + (sem_MaybeExports_Just (sem_Exports x)) +sem_MaybeExports Prelude.Nothing = + sem_MaybeExports_Nothing +-- semantic domain +type T_MaybeExports = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_MaybeExports_Just :: T_Exports -> + T_MaybeExports +sem_MaybeExports_Just just_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOfixityGam :: FixityGam + _justOgUniq :: UID + _justOidGam :: IdDefOccGam + _justOisMainMod :: Bool + _justOisTopMod :: Bool + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOpatchEhNmInInstance :: PatchEhNmInInstance + _justOtopInstanceNmL :: ([HsName]) + _justIerrSq :: ErrSq + _justIgUniq :: UID + _justIgathFixityGam :: FixityGam + _justIidUseOccGam :: IdUseOccGam + _justIpp :: PP_Doc + _justIppWrap :: (PP_Doc -> PP_Doc) + _justItopInstanceNmL :: ([HsName]) + _justIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _justIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _justIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _justIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _justIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _justIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _justIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOidGam = + _lhsIidGam + -- copy rule (down) + _justOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _justOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIerrSq,_justIgUniq,_justIgathFixityGam,_justIidUseOccGam,_justIpp,_justIppWrap,_justItopInstanceNmL,_justIundefOccGam) = + just_ _justOfixityGam _justOgUniq _justOidGam _justOisMainMod _justOisTopMod _justOmoduleNm _justOnmLev _justOopts _justOpatchEhNmInInstance _justOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- MaybeExpression --------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : Maybe EH.Expr + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppMb : Maybe PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Just: + child just : Expression + alternative Nothing: +-} +-- cata +sem_MaybeExpression :: MaybeExpression -> + T_MaybeExpression +sem_MaybeExpression (Prelude.Just x) = + (sem_MaybeExpression_Just (sem_Expression x)) +sem_MaybeExpression Prelude.Nothing = + sem_MaybeExpression_Nothing +-- semantic domain +type T_MaybeExpression = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (Maybe EH.Expr),ErrSq,UID,IdUseOccGam,PP_Doc,(Maybe PP_Doc),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_MaybeExpression_Just :: T_Expression -> + T_MaybeExpression +sem_MaybeExpression_Just just_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppMb :: (Maybe PP_Doc) + _lhsOeh :: (Maybe EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOcaseId :: UID + _justOfixityGam :: FixityGam + _justOgUniq :: UID + _justOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _justOidGam :: IdDefOccGam + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOpatchEhNmInInstance :: PatchEhNmInInstance + _justOpragmas :: (Set.Set Pragma.Pragma) + _justOtopInstanceNmL :: ([HsName]) + _justIconNm :: Name + _justIeh :: (EH.Expr) + _justIerrSq :: ErrSq + _justIgUniq :: UID + _justIidUseOccGam :: IdUseOccGam + _justIopChain :: (OpChain EH.Expr) + _justIoperatorName :: MaybeName + _justIpp :: PP_Doc + _justIppWrap :: (PP_Doc -> PP_Doc) + _justItopInstanceNmL :: ([HsName]) + _justIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 400, column 9) + _lhsOppMb = + Just _justIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 462, column 9) + _lhsOeh = + Just _justIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _justIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _justIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _justIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _justIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _justIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOcaseId = + _lhsIcaseId + -- copy rule (down) + _justOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _justOidGam = + _lhsIidGam + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _justOpragmas = + _lhsIpragmas + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIconNm,_justIeh,_justIerrSq,_justIgUniq,_justIidUseOccGam,_justIopChain,_justIoperatorName,_justIpp,_justIppWrap,_justItopInstanceNmL,_justIundefOccGam) = + just_ _justOcaseId _justOfixityGam _justOgUniq _justOgenerDerivMp _justOidGam _justOmoduleNm _justOnmLev _justOopts _justOpatchEhNmInInstance _justOpragmas _justOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppMb,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppMb :: (Maybe PP_Doc) + _lhsOeh :: (Maybe EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 402, column 9) + _lhsOppMb = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 456, column 31) + _lhsOeh = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppMb,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- MaybeImportSpecification ------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Just: + child just : ImportSpecification + alternative Nothing: +-} +-- cata +sem_MaybeImportSpecification :: MaybeImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification (Prelude.Just x) = + (sem_MaybeImportSpecification_Just (sem_ImportSpecification x)) +sem_MaybeImportSpecification Prelude.Nothing = + sem_MaybeImportSpecification_Nothing +-- semantic domain +type T_MaybeImportSpecification = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,FixityGam,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification_Just just_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOfixityGam :: FixityGam + _justOgUniq :: UID + _justOidGam :: IdDefOccGam + _justOisMainMod :: Bool + _justOisTopMod :: Bool + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOpatchEhNmInInstance :: PatchEhNmInInstance + _justOtopInstanceNmL :: ([HsName]) + _justIerrSq :: ErrSq + _justIgUniq :: UID + _justIgathFixityGam :: FixityGam + _justIidUseOccGam :: IdUseOccGam + _justIpp :: PP_Doc + _justIppWrap :: (PP_Doc -> PP_Doc) + _justItopInstanceNmL :: ([HsName]) + _justIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _justIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _justIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _justIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _justIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _justIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _justIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOidGam = + _lhsIidGam + -- copy rule (down) + _justOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _justOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIerrSq,_justIgUniq,_justIgathFixityGam,_justIidUseOccGam,_justIpp,_justIppWrap,_justItopInstanceNmL,_justIundefOccGam) = + just_ _justOfixityGam _justOgUniq _justOidGam _justOisMainMod _justOisTopMod _justOmoduleNm _justOnmLev _justOopts _justOpatchEhNmInInstance _justOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- MaybeType --------------------------------------------------- +{- + visit 0: + inherited attributes: + doGenVarWild : Bool + fixityGam : FixityGam + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : Maybe EH.TyExpr + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppMb : Maybe PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Just: + child just : Type + visit 0: + local isAsPred : _ + alternative Nothing: + visit 0: + local isAsPred : _ +-} +-- cata +sem_MaybeType :: MaybeType -> + T_MaybeType +sem_MaybeType (Prelude.Just x) = + (sem_MaybeType_Just (sem_Type x)) +sem_MaybeType Prelude.Nothing = + sem_MaybeType_Nothing +-- semantic domain +type T_MaybeType = Bool -> + FixityGam -> + UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (Maybe EH.TyExpr),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(Maybe PP_Doc),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_MaybeType_Just :: T_Type -> + T_MaybeType +sem_MaybeType_Just just_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppMb :: (Maybe PP_Doc) + _lhsOeh :: (Maybe EH.TyExpr) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOdoGenVarWild :: Bool + _justOfixityGam :: FixityGam + _justOgUniq :: UID + _justOidGam :: IdDefOccGam + _justOisAsPred :: Bool + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOpatchEhNmInInstance :: PatchEhNmInInstance + _justOtopInstanceNmL :: ([HsName]) + _justIconNm :: Name + _justIeh :: (EH.TyExpr) + _justIehMbAsPr :: (Maybe EH.PrExpr) + _justIehMbAsPrL :: ([Maybe EH.PrExpr]) + _justIehMbAsTyPr :: (Maybe EH.TyExpr) + _justIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _justIerrSq :: ErrSq + _justIfreeTvarS :: HsNameS + _justIgUniq :: UID + _justIidUseOccGam :: IdUseOccGam + _justImbRefConNm :: (Maybe Name) + _justIopChain :: (OpChain EH.TyExpr) + _justIoperatorName :: MaybeName + _justIpp :: PP_Doc + _justIppWrap :: (PP_Doc -> PP_Doc) + _justItopInstanceNmL :: ([HsName]) + _justItyConIs :: TypeConFixedMeaning + _justIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 406, column 9) + _lhsOppMb = + Just _justIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 205, column 9) + _lhsOeh = + Just _justIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _justIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _justIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _justIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _justIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _justIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _justIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _justOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOidGam = + _lhsIidGam + -- copy rule (from local) + _justOisAsPred = + _isAsPred + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIconNm,_justIeh,_justIehMbAsPr,_justIehMbAsPrL,_justIehMbAsTyPr,_justIehMbAsTyPrL,_justIerrSq,_justIfreeTvarS,_justIgUniq,_justIidUseOccGam,_justImbRefConNm,_justIopChain,_justIoperatorName,_justIpp,_justIppWrap,_justItopInstanceNmL,_justItyConIs,_justIundefOccGam) = + just_ _justOdoGenVarWild _justOfixityGam _justOgUniq _justOidGam _justOisAsPred _justOnmLev _justOopts _justOpatchEhNmInInstance _justOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppMb,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_MaybeType_Nothing :: T_MaybeType +sem_MaybeType_Nothing = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppMb :: (Maybe PP_Doc) + _lhsOeh :: (Maybe EH.TyExpr) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 408, column 9) + _lhsOppMb = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 201, column 25) + _lhsOeh = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppMb,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Module ------------------------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isMainMod : Bool + isTopMod : Bool + modEntToOrig : ModEntRngMp + modInScope : ModEntDomMp + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Expr + errSq : ErrSq + fileHeaderPragmas : Set.Set Pragma.Pragma + gathFixityGam : FixityGam + gathIdGam : IdDefOccGam + idUseOccGam : IdUseOccGam + mainValExists : Bool + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Module: + child range : {Range} + child name : {MaybeName} + child fileheaderpragmas : Pragmas + child exports : MaybeExports + child body : Body + visit 0: + local fileHeaderPragmas : _ + local opts : _ + local errUndef : _ + local errModName : _ +-} +-- cata +sem_Module :: Module -> + T_Module +sem_Module (Module_Module _range _name _fileheaderpragmas _exports _body) = + (sem_Module_Module _range _name (sem_Pragmas _fileheaderpragmas) (sem_MaybeExports _exports) (sem_Body _body)) +-- semantic domain +type T_Module = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + Bool -> + ModEntRngMp -> + ModEntDomMp -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.Expr),ErrSq,(Set.Set Pragma.Pragma),UID,FixityGam,IdDefOccGam,IdUseOccGam,Bool,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Module_Module :: Range -> + MaybeName -> + T_Pragmas -> + T_MaybeExports -> + T_Body -> + T_Module +sem_Module_Module range_ name_ fileheaderpragmas_ exports_ body_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisMainMod + _lhsIisTopMod + _lhsImodEntToOrig + _lhsImodInScope + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _bodyOpragmas :: (Set.Set Pragma.Pragma) + _lhsOfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr) + _lhsOgUniq :: UID + _lhsOgathIdGam :: IdDefOccGam + _lhsOmainValExists :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _fileheaderpragmasOgUniq :: UID + _fileheaderpragmasOidGam :: IdDefOccGam + _fileheaderpragmasOnmLev :: NmLev + _fileheaderpragmasOopts :: EHCOpts + _fileheaderpragmasOpatchEhNmInInstance :: PatchEhNmInInstance + _fileheaderpragmasOtopInstanceNmL :: ([HsName]) + _exportsOfixityGam :: FixityGam + _exportsOgUniq :: UID + _exportsOidGam :: IdDefOccGam + _exportsOisMainMod :: Bool + _exportsOisTopMod :: Bool + _exportsOmoduleNm :: HsName + _exportsOnmLev :: NmLev + _exportsOopts :: EHCOpts + _exportsOpatchEhNmInInstance :: PatchEhNmInInstance + _exportsOtopInstanceNmL :: ([HsName]) + _bodyOfixityGam :: FixityGam + _bodyOgUniq :: UID + _bodyOidGam :: IdDefOccGam + _bodyOisMainMod :: Bool + _bodyOisTopMod :: Bool + _bodyOmodEntToOrig :: ModEntRngMp + _bodyOmodInScope :: ModEntDomMp + _bodyOmoduleNm :: HsName + _bodyOnmLev :: NmLev + _bodyOopts :: EHCOpts + _bodyOpatchEhNmInInstance :: PatchEhNmInInstance + _bodyOtopInstanceNmL :: ([HsName]) + _fileheaderpragmasIerrSq :: ErrSq + _fileheaderpragmasIgUniq :: UID + _fileheaderpragmasIgathPragmas :: (Set.Set Pragma.Pragma) + _fileheaderpragmasIidUseOccGam :: IdUseOccGam + _fileheaderpragmasIpp :: PP_Doc + _fileheaderpragmasIppWrap :: (PP_Doc -> PP_Doc) + _fileheaderpragmasItopInstanceNmL :: ([HsName]) + _fileheaderpragmasIundefOccGam :: IdUseOccGam + _exportsIerrSq :: ErrSq + _exportsIgUniq :: UID + _exportsIgathFixityGam :: FixityGam + _exportsIidUseOccGam :: IdUseOccGam + _exportsIpp :: PP_Doc + _exportsIppWrap :: (PP_Doc -> PP_Doc) + _exportsItopInstanceNmL :: ([HsName]) + _exportsIundefOccGam :: IdUseOccGam + _bodyIeh :: (EH.Expr) + _bodyIerrSq :: ErrSq + _bodyIextraModImpL :: ([ModImp]) + _bodyIgUniq :: UID + _bodyIgathFixityGam :: FixityGam + _bodyIgathIdGam :: IdDefOccGam + _bodyIidUseOccGam :: IdUseOccGam + _bodyImainValExists :: Bool + _bodyIpp :: PP_Doc + _bodyIppWrap :: (PP_Doc -> PP_Doc) + _bodyItopInstanceNmL :: ([HsName]) + _bodyIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 23, column 9) + _fileHeaderPragmas = + _fileheaderpragmasIgathPragmas + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 23, column 9) + _opts = + fst $ ehcOptUpdateWithPragmas _fileHeaderPragmas _lhsIopts + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 3, column 9) + _errUndef = + let ns = [ (ioccNm o >#< ppParens (ioccKind o),Just (map (\o -> (uoccRange o,Nothing)) os)) + | (o,os) <- gamToAssocDupL _bodyIundefOccGam, not $ hsnIsProd $ ioccNm $ o + ] + in (if null ns then [] else [rngLift range_ mkErr_NamesNotIntrod' "" ns]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 16, column 9) + _errModName = + case name_ of + Just n | n /= _lhsImoduleNm && not _lhsIisTopMod + -> [rngLift range_ Err_ModNameMismatch _lhsImoduleNm n] + _ -> [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 5, column 9) + _lhsOerrSq = + Seq.firstNotEmpty [Seq.fromList _errUndef,Seq.fromList _errModName,_bodyIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 305, column 9) + _bodyOpragmas = + _fileHeaderPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 2, column 43) + _lhsOfileHeaderPragmas = + _fileHeaderPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _exportsIgathFixityGam `gamAddGam` _bodyIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _fileheaderpragmasIidUseOccGam `gamAddGam` _exportsIidUseOccGam `gamAddGam` _bodyIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _fileheaderpragmasIpp >-< _exportsIpp >-< _bodyIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _fileheaderpragmasIppWrap . _exportsIppWrap . _bodyIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _fileheaderpragmasIundefOccGam `gamUnion` _exportsIundefOccGam `gamUnion` _bodyIundefOccGam + -- copy rule (up) + _lhsOeh = + _bodyIeh + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (up) + _lhsOgathIdGam = + _bodyIgathIdGam + -- copy rule (up) + _lhsOmainValExists = + _bodyImainValExists + -- copy rule (up) + _lhsOtopInstanceNmL = + _bodyItopInstanceNmL + -- copy rule (down) + _fileheaderpragmasOgUniq = + _lhsIgUniq + -- copy rule (down) + _fileheaderpragmasOidGam = + _lhsIidGam + -- copy rule (down) + _fileheaderpragmasOnmLev = + _lhsInmLev + -- copy rule (from local) + _fileheaderpragmasOopts = + _opts + -- copy rule (down) + _fileheaderpragmasOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _fileheaderpragmasOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _exportsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _exportsOgUniq = + _fileheaderpragmasIgUniq + -- copy rule (down) + _exportsOidGam = + _lhsIidGam + -- copy rule (down) + _exportsOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _exportsOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _exportsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _exportsOnmLev = + _lhsInmLev + -- copy rule (from local) + _exportsOopts = + _opts + -- copy rule (down) + _exportsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _exportsOtopInstanceNmL = + _fileheaderpragmasItopInstanceNmL + -- copy rule (down) + _bodyOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _bodyOgUniq = + _exportsIgUniq + -- copy rule (down) + _bodyOidGam = + _lhsIidGam + -- copy rule (down) + _bodyOisMainMod = + _lhsIisMainMod + -- copy rule (down) + _bodyOisTopMod = + _lhsIisTopMod + -- copy rule (down) + _bodyOmodEntToOrig = + _lhsImodEntToOrig + -- copy rule (down) + _bodyOmodInScope = + _lhsImodInScope + -- copy rule (down) + _bodyOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _bodyOnmLev = + _lhsInmLev + -- copy rule (from local) + _bodyOopts = + _opts + -- copy rule (down) + _bodyOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _bodyOtopInstanceNmL = + _exportsItopInstanceNmL + ( _fileheaderpragmasIerrSq,_fileheaderpragmasIgUniq,_fileheaderpragmasIgathPragmas,_fileheaderpragmasIidUseOccGam,_fileheaderpragmasIpp,_fileheaderpragmasIppWrap,_fileheaderpragmasItopInstanceNmL,_fileheaderpragmasIundefOccGam) = + fileheaderpragmas_ _fileheaderpragmasOgUniq _fileheaderpragmasOidGam _fileheaderpragmasOnmLev _fileheaderpragmasOopts _fileheaderpragmasOpatchEhNmInInstance _fileheaderpragmasOtopInstanceNmL + ( _exportsIerrSq,_exportsIgUniq,_exportsIgathFixityGam,_exportsIidUseOccGam,_exportsIpp,_exportsIppWrap,_exportsItopInstanceNmL,_exportsIundefOccGam) = + exports_ _exportsOfixityGam _exportsOgUniq _exportsOidGam _exportsOisMainMod _exportsOisTopMod _exportsOmoduleNm _exportsOnmLev _exportsOopts _exportsOpatchEhNmInInstance _exportsOtopInstanceNmL + ( _bodyIeh,_bodyIerrSq,_bodyIextraModImpL,_bodyIgUniq,_bodyIgathFixityGam,_bodyIgathIdGam,_bodyIidUseOccGam,_bodyImainValExists,_bodyIpp,_bodyIppWrap,_bodyItopInstanceNmL,_bodyIundefOccGam) = + body_ _bodyOfixityGam _bodyOgUniq _bodyOidGam _bodyOisMainMod _bodyOisTopMod _bodyOmodEntToOrig _bodyOmodInScope _bodyOmoduleNm _bodyOnmLev _bodyOopts _bodyOpatchEhNmInInstance _bodyOpragmas _bodyOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfileHeaderPragmas,_lhsOgUniq,_lhsOgathFixityGam,_lhsOgathIdGam,_lhsOidUseOccGam,_lhsOmainValExists,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.PatExpr + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + isVar : Bool + mbTopRefname : Maybe HsName + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Literal: + child range : {Range} + child sign : {Int} + child literal : Literal + visit 0: + local eqrefname : _ + local idUseOccGamEq : _ + local errIdUseEq : _ + local litnames : _ + local litrefname : _ + local litrefnames : _ + local idUseOccGam : _ + local errIdUse : _ + local eqclassrefname : _ + local idUseOccGamCls : _ + local errIdUseCls : _ + local errSq : _ + local isAsPred : _ + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local idDefOccGam : _ + local refname : _ + local isWildcard : _ + local idOccDef : _ + local idOccDefsNoWildcard : _ + local idOccDefs : _ + local pp : _ + local isAsPred : _ + alternative Constructor: + child range : {Range} + child name : {Name} + child patterns : Patterns + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local conNm : _ + local errSq : _ + local pp : _ + local isAsPred : _ + alternative Parenthesized: + child range : {Range} + child pattern : Pattern + visit 0: + local pp : _ + local isAsPred : _ + alternative As: + child range : {Range} + child name : {Name} + child pattern : Pattern + visit 0: + local idDefOccGam : _ + local refname : _ + local isWildcard : _ + local idOccDef : _ + local idOccDefsNoWildcard : _ + local idOccDefs : _ + local pp : _ + local isAsPred : _ + alternative Wildcard: + child range : {Range} + visit 0: + local pp : _ + local isAsPred : _ + alternative Tuple: + child range : {Range} + child arity : {Int} + child patterns : Patterns + visit 0: + local errArity : _ + local errSq : _ + local pp : _ + local isAsPred : _ + alternative Annotate: + child range : {Range} + child annotation : PatternAnnotation + child pattern : Pattern + visit 0: + local eh : _ + local isAsPred : _ + alternative Typed: + child range : {Range} + child pattern : Pattern + child type : Type + visit 0: + local idDefOccGamType : _ + local pp : _ + local isAsPred : _ + local doGenVarWild : _ + alternative InfixConstructor: + child range : {Range} + child leftPattern : Pattern + child constructorOperator : {Name} + child rightPattern : Pattern + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local conNm : _ + local errSq : _ + local pp : _ + local isAsPred : _ + alternative List: + child range : {Range} + child patterns : Patterns + visit 0: + local refnames : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local isAsPred : _ + alternative Record: + child range : {Range} + child name : {Name} + child recordPatternBindings : RecordPatternBindings + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local conNm : _ + local errSq : _ + local pp : _ + local isAsPred : _ + alternative RowRecordBinding: + child range : {Range} + child pattern : Pattern + child rowRecordPattternBindings : RowRecordPatternBindings + visit 0: + local pp : _ + local isAsPred : _ + alternative RowRecordEmpty: + child range : {Range} + visit 0: + local pp : _ + local isAsPred : _ + alternative Irrefutable: + child range : {Range} + child pattern : Pattern + visit 0: + local pp : _ + local isAsPred : _ + alternative Bang: + child range : {Range} + child pattern : Pattern + visit 0: + local pp : _ + local isAsPred : _ +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Pattern_Literal _range _sign _literal) = + (sem_Pattern_Literal _range _sign (sem_Literal _literal)) +sem_Pattern (Pattern_Variable _range _name) = + (sem_Pattern_Variable _range _name) +sem_Pattern (Pattern_Constructor _range _name _patterns) = + (sem_Pattern_Constructor _range _name (sem_Patterns _patterns)) +sem_Pattern (Pattern_Parenthesized _range _pattern) = + (sem_Pattern_Parenthesized _range (sem_Pattern _pattern)) +sem_Pattern (Pattern_As _range _name _pattern) = + (sem_Pattern_As _range _name (sem_Pattern _pattern)) +sem_Pattern (Pattern_Wildcard _range) = + (sem_Pattern_Wildcard _range) +sem_Pattern (Pattern_Tuple _range _arity _patterns) = + (sem_Pattern_Tuple _range _arity (sem_Patterns _patterns)) +sem_Pattern (Pattern_Annotate _range _annotation _pattern) = + (sem_Pattern_Annotate _range (sem_PatternAnnotation _annotation) (sem_Pattern _pattern)) +sem_Pattern (Pattern_Typed _range _pattern _type) = + (sem_Pattern_Typed _range (sem_Pattern _pattern) (sem_Type _type)) +sem_Pattern (Pattern_InfixConstructor _range _leftPattern _constructorOperator _rightPattern) = + (sem_Pattern_InfixConstructor _range (sem_Pattern _leftPattern) _constructorOperator (sem_Pattern _rightPattern)) +sem_Pattern (Pattern_List _range _patterns) = + (sem_Pattern_List _range (sem_Patterns _patterns)) +sem_Pattern (Pattern_Record _range _name _recordPatternBindings) = + (sem_Pattern_Record _range _name (sem_RecordPatternBindings _recordPatternBindings)) +sem_Pattern (Pattern_RowRecordBinding _range _pattern _rowRecordPattternBindings) = + (sem_Pattern_RowRecordBinding _range (sem_Pattern _pattern) (sem_RowRecordPatternBindings _rowRecordPattternBindings)) +sem_Pattern (Pattern_RowRecordEmpty _range) = + (sem_Pattern_RowRecordEmpty _range) +sem_Pattern (Pattern_Irrefutable _range _pattern) = + (sem_Pattern_Irrefutable _range (sem_Pattern _pattern)) +sem_Pattern (Pattern_Bang _range _pattern) = + (sem_Pattern_Bang _range (sem_Pattern _pattern)) +-- semantic domain +type T_Pattern = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.PatExpr),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,Bool,(Maybe HsName),PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Pattern_Literal :: Range -> + Int -> + T_Literal -> + T_Pattern +sem_Pattern_Literal range_ sign_ literal_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _literalOgUniq :: UID + _literalOidGam :: IdDefOccGam + _literalOnmLev :: NmLev + _literalOopts :: EHCOpts + _literalOpatchEhNmInInstance :: PatchEhNmInInstance + _literalOtopInstanceNmL :: ([HsName]) + _literalIeh :: Literal + _literalIerrSq :: ErrSq + _literalIgUniq :: UID + _literalIidUseOccGam :: IdUseOccGam + _literalIpp :: PP_Doc + _literalIppWrap :: (PP_Doc -> PP_Doc) + _literalItopInstanceNmL :: ([HsName]) + _literalIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 517, column 29) + (_eqrefname,_,_idUseOccGamEq,_errIdUseEq) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnClassEqFldEq] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 517, column 9) + _litnames = + litNames _lhsIopts _literalIeh True sign_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 520, column 29) + (_litrefname,_litrefnames,_idUseOccGam,_errIdUse) = + mkUseOccGam' _lhsIopts _lhsIidGam _litnames range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 522, column 29) + (_eqclassrefname,_,_idUseOccGamCls,_errIdUseCls) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnClassEq] IdOcc_Class IdAsp_Class_Class range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 524, column 9) + _lhsOidUseOccGam = + gamUnions + [ _idUseOccGam, _idUseOccGamEq + , _idUseOccGamCls + , _literalIidUseOccGam + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 49, column 9) + _errSq = + Seq.unions [ Seq.fromList _errIdUse, Seq.fromList _errIdUseEq + , Seq.fromList _errIdUseCls + , _literalIerrSq + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 801, column 9) + _lhsOeh = + let + mkc r = \c -> mke r (rngLift r EH.Expr_CConst c, Just $ SrcConst_Char c) + mke r = uncurry (rngLift r EH.PatExpr_Expr) + in case _literalIeh of + Literal_Char r s -> mkc r $ head s + Literal_Int r b s -> mke r (ehExpLitInt r b s sign_ _litrefnames) + Literal_String r s + | ehcOptOverloadedStrings _lhsIopts -> mke r (ehExpLitString _lhsIopts r s _litrefnames) + | otherwise -> foldr (\c p -> ehPatConApp r (_litrefnames !! 0) [mkc r c,p]) (ehPatConApp r (_litrefnames !! 1) []) s + Literal_Float r s -> mke r (ehExpLitFloat r s sign_ _litrefnames) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _literalIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _literalIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _literalIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _literalIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _literalItopInstanceNmL + -- copy rule (down) + _literalOgUniq = + _lhsIgUniq + -- copy rule (down) + _literalOidGam = + _lhsIidGam + -- copy rule (down) + _literalOnmLev = + _lhsInmLev + -- copy rule (down) + _literalOopts = + _lhsIopts + -- copy rule (down) + _literalOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _literalOtopInstanceNmL = + _lhsItopInstanceNmL + ( _literalIeh,_literalIerrSq,_literalIgUniq,_literalIidUseOccGam,_literalIpp,_literalIppWrap,_literalItopInstanceNmL,_literalIundefOccGam) = + literal_ _literalOgUniq _literalOidGam _literalOnmLev _literalOopts _literalOpatchEhNmInInstance _literalOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Variable :: Range -> + Name -> + T_Pattern +sem_Pattern_Variable range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 216, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ IdAsp_Val_Var _idOccDefsNoWildcard + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 54, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 100, column 9) + _isWildcard = + hsnIsWild name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDefsNoWildcard = + if _isWildcard then [] else [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 178, column 9) + _idOccDefs = + _idOccDefsNoWildcard + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 227, column 9) + _lhsOmbTopRefname = + if _isWildcard then Just _refname else Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 341, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 812, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Var + (_lhsIpatchEhNmInInstance _refname) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 260, column 9) + _lhsOisVar = + True + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Constructor :: Range -> + Name -> + T_Patterns -> + T_Pattern +sem_Pattern_Constructor range_ name_ patterns_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 559, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [_conNm] IdOcc_Val IdAsp_Val_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 562, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_patternsIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 219, column 9) + _conNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 45, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _patternsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 343, column 9) + _pp = + name_ >#< ppSpaces _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 815, column 9) + _lhsOeh = + ehPatConApp range_ _refname _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Parenthesized :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Parenthesized range_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 345, column 9) + _pp = + ppParens _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 817, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Parens _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_As :: Range -> + Name -> + T_Pattern -> + T_Pattern +sem_Pattern_As range_ name_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidDefOccGam :: IdDefOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 216, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ IdAsp_Val_Var _idOccDefsNoWildcard + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 218, column 9) + _lhsOidDefOccGam = + _idDefOccGam `gamAddGam` _patternIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 54, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 100, column 9) + _isWildcard = + hsnIsWild name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDefsNoWildcard = + if _isWildcard then [] else [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 180, column 9) + _idOccDefs = + _idOccDefsNoWildcard ++ _patternIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 227, column 9) + _lhsOmbTopRefname = + if _isWildcard then Just _refname else Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 349, column 9) + _pp = + name_ >|< "@" >|< _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 823, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_VarAs + (_lhsIpatchEhNmInInstance _refname) + _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Wildcard :: Range -> + T_Pattern +sem_Pattern_Wildcard range_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 351, column 9) + _pp = + pp hsnWild + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 827, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Var hsnWild + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Tuple :: Range -> + Int -> + T_Patterns -> + T_Pattern +sem_Pattern_Tuple range_ arity_ patterns_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 10, column 9) + _errArity = + if arity_ == length _patternsIeh + then [] + else [rngLift range_ Err_PatArity2 "pat " _pp arity_] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 56, column 9) + _errSq = + Seq.unions [Seq.fromList _errArity, _patternsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 347, column 9) + _pp = + ppParensCommas' $ _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 819, column 9) + _lhsOeh = + foldl (\eh (n,p) -> ehRowRecPatExprUpd range_ (Just n) (rngLift range_ EH.RecPatExpr_Ext) p eh) + (rngLift range_ EH.PatExpr_Rec $ rngLift range_ EH.RecPatExpr_Empty) + $ zip positionalFldNames _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Annotate :: Range -> + T_PatternAnnotation -> + T_Pattern -> + T_Pattern +sem_Pattern_Annotate range_ annotation_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PatExpr) + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOfixityGam :: FixityGam + _annotationOgUniq :: UID + _annotationOidGam :: IdDefOccGam + _annotationOmoduleNm :: HsName + _annotationOnmLev :: NmLev + _annotationOopts :: EHCOpts + _annotationOpatchEhNmInInstance :: PatchEhNmInInstance + _annotationOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _annotationIeh :: (EH.PatExprAnn) + _annotationIerrSq :: ErrSq + _annotationIgUniq :: UID + _annotationIidDefOccGam :: IdDefOccGam + _annotationIidOccDefs :: ([IdOcc]) + _annotationIidUseOccGam :: IdUseOccGam + _annotationIpp :: PP_Doc + _annotationIppWrap :: (PP_Doc -> PP_Doc) + _annotationItopInstanceNmL :: ([HsName]) + _annotationIundefOccGam :: IdUseOccGam + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 829, column 17) + _eh = + rngLift range_ EH.PatExpr_Ann _annotationIeh _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _annotationIerrSq `Seq.union` _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _annotationIidDefOccGam `gamAddGam` _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _annotationIidOccDefs ++ _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _annotationIidUseOccGam `gamAddGam` _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _annotationIpp >-< _patternIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _annotationIppWrap . _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _annotationIundefOccGam `gamUnion` _patternIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _annotationOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOidGam = + _lhsIidGam + -- copy rule (down) + _annotationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOopts = + _lhsIopts + -- copy rule (down) + _annotationOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _patternOgUniq = + _annotationIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _patternOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIeh,_annotationIerrSq,_annotationIgUniq,_annotationIidDefOccGam,_annotationIidOccDefs,_annotationIidUseOccGam,_annotationIpp,_annotationIppWrap,_annotationItopInstanceNmL,_annotationIundefOccGam) = + annotation_ _annotationOfixityGam _annotationOgUniq _annotationOidGam _annotationOmoduleNm _annotationOnmLev _annotationOopts _annotationOpatchEhNmInInstance _annotationOtopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Typed :: Range -> + T_Pattern -> + T_Type -> + T_Pattern +sem_Pattern_Typed range_ pattern_ type_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _typeOidGam :: IdDefOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _typeOnmLev :: NmLev + _lhsOeh :: (EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOisAsPred :: Bool + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 220, column 9) + _idDefOccGamType = + tvarS2IdDefOccGam _lhsInmLev range_ _typeIfreeTvarS + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 356, column 9) + _typeOidGam = + gamUnion _idDefOccGamType _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 56, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 354, column 9) + _pp = + _patternIpp >#< "::" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 831, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_TypeAs _typeIeh _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 214, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq `Seq.union` _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam `gamAddGam` _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _typeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _typeOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _patternIgUniq + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_InfixConstructor :: Range -> + T_Pattern -> + Name -> + T_Pattern -> + T_Pattern +sem_Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOfixityGam :: FixityGam + _leftPatternOgUniq :: UID + _leftPatternOidGam :: IdDefOccGam + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOopts :: EHCOpts + _leftPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOfixityGam :: FixityGam + _rightPatternOgUniq :: UID + _rightPatternOidGam :: IdDefOccGam + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOopts :: EHCOpts + _rightPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIeh :: (EH.PatExpr) + _leftPatternIerrSq :: ErrSq + _leftPatternIgUniq :: UID + _leftPatternIidDefOccGam :: IdDefOccGam + _leftPatternIidOccDefs :: ([IdOcc]) + _leftPatternIidUseOccGam :: IdUseOccGam + _leftPatternIisVar :: Bool + _leftPatternImbTopRefname :: (Maybe HsName) + _leftPatternIpp :: PP_Doc + _leftPatternIppWrap :: (PP_Doc -> PP_Doc) + _leftPatternItopInstanceNmL :: ([HsName]) + _leftPatternIundefOccGam :: IdUseOccGam + _rightPatternIeh :: (EH.PatExpr) + _rightPatternIerrSq :: ErrSq + _rightPatternIgUniq :: UID + _rightPatternIidDefOccGam :: IdDefOccGam + _rightPatternIidOccDefs :: ([IdOcc]) + _rightPatternIidUseOccGam :: IdUseOccGam + _rightPatternIisVar :: Bool + _rightPatternImbTopRefname :: (Maybe HsName) + _rightPatternIpp :: PP_Doc + _rightPatternIppWrap :: (PP_Doc -> PP_Doc) + _rightPatternItopInstanceNmL :: ([HsName]) + _rightPatternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 559, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [_conNm] IdOcc_Val IdAsp_Val_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 564, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_leftPatternIidUseOccGam,_rightPatternIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 221, column 9) + _conNm = + constructorOperator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 47, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _leftPatternIerrSq, _rightPatternIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 356, column 9) + _pp = + _leftPatternIpp >#< constructorOperator_ >#< _rightPatternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 833, column 9) + _lhsOeh = + ehPatConApp range_ _refname [_leftPatternIeh,_rightPatternIeh] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _leftPatternIidDefOccGam `gamAddGam` _rightPatternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _leftPatternIidOccDefs ++ _rightPatternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftPatternIppWrap . _rightPatternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftPatternIundefOccGam `gamUnion` _rightPatternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOidGam = + _lhsIidGam + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOopts = + _lhsIopts + -- copy rule (down) + _leftPatternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rightPatternOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOidGam = + _lhsIidGam + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _rightPatternOopts = + _lhsIopts + -- copy rule (down) + _rightPatternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIeh,_leftPatternIerrSq,_leftPatternIgUniq,_leftPatternIidDefOccGam,_leftPatternIidOccDefs,_leftPatternIidUseOccGam,_leftPatternIisVar,_leftPatternImbTopRefname,_leftPatternIpp,_leftPatternIppWrap,_leftPatternItopInstanceNmL,_leftPatternIundefOccGam) = + leftPattern_ _leftPatternOfixityGam _leftPatternOgUniq _leftPatternOidGam _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOopts _leftPatternOpatchEhNmInInstance _leftPatternOtopInstanceNmL + ( _rightPatternIeh,_rightPatternIerrSq,_rightPatternIgUniq,_rightPatternIidDefOccGam,_rightPatternIidOccDefs,_rightPatternIidUseOccGam,_rightPatternIisVar,_rightPatternImbTopRefname,_rightPatternIpp,_rightPatternIppWrap,_rightPatternItopInstanceNmL,_rightPatternIundefOccGam) = + rightPattern_ _rightPatternOfixityGam _rightPatternOgUniq _rightPatternOidGam _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOopts _rightPatternOpatchEhNmInInstance _rightPatternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_List :: Range -> + T_Patterns -> + T_Pattern +sem_Pattern_List range_ patterns_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOfixityGam :: FixityGam + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.PatExpr]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidDefOccGam :: IdDefOccGam + _patternsIidOccDefs :: ([IdOcc]) + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 566, column 29) + (_,_refnames,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnDataListAltCons,hsnDataListAltNil] IdOcc_Val IdAsp_Val_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 568, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_patternsIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 45, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _patternsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 358, column 9) + _pp = + ppBracketsCommas _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 835, column 9) + _lhsOeh = + foldr (\l r -> ehPatConApp range_ (_refnames !! 0) [l,r]) (appCon (_refnames !! 1)) _patternsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidDefOccGam,_patternsIidOccDefs,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsIundefOccGam) = + patterns_ _patternsOfixityGam _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Record :: Range -> + Name -> + T_RecordPatternBindings -> + T_Pattern +sem_Pattern_Record range_ name_ recordPatternBindings_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _recordPatternBindingsOfixityGam :: FixityGam + _recordPatternBindingsOgUniq :: UID + _recordPatternBindingsOidGam :: IdDefOccGam + _recordPatternBindingsOmoduleNm :: HsName + _recordPatternBindingsOnmLev :: NmLev + _recordPatternBindingsOopts :: EHCOpts + _recordPatternBindingsOpatchEhNmInInstance :: PatchEhNmInInstance + _recordPatternBindingsOtopInstanceNmL :: ([HsName]) + _recordPatternBindingsIeh :: ([EH.DataFieldPatExpr -> EH.DataFieldPatExpr]) + _recordPatternBindingsIerrSq :: ErrSq + _recordPatternBindingsIgUniq :: UID + _recordPatternBindingsIidDefOccGam :: IdDefOccGam + _recordPatternBindingsIidOccDefs :: ([IdOcc]) + _recordPatternBindingsIidUseOccGam :: IdUseOccGam + _recordPatternBindingsIpp :: PP_Doc + _recordPatternBindingsIppL :: ([PP_Doc]) + _recordPatternBindingsIppWrap :: (PP_Doc -> PP_Doc) + _recordPatternBindingsItopInstanceNmL :: ([HsName]) + _recordPatternBindingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 559, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [_conNm] IdOcc_Val IdAsp_Val_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 570, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_recordPatternBindingsIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 219, column 9) + _conNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 54, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _recordPatternBindingsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 360, column 9) + _pp = + name_ >#< ppCurlysCommas' _recordPatternBindingsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 837, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_DataFields $ foldl (flip ($)) (rngLift range_ EH.DataFieldPatExpr_Con _refname) _recordPatternBindingsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _recordPatternBindingsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _recordPatternBindingsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _recordPatternBindingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _recordPatternBindingsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _recordPatternBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordPatternBindingsItopInstanceNmL + -- copy rule (down) + _recordPatternBindingsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _recordPatternBindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _recordPatternBindingsOidGam = + _lhsIidGam + -- copy rule (down) + _recordPatternBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordPatternBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordPatternBindingsOopts = + _lhsIopts + -- copy rule (down) + _recordPatternBindingsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _recordPatternBindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _recordPatternBindingsIeh,_recordPatternBindingsIerrSq,_recordPatternBindingsIgUniq,_recordPatternBindingsIidDefOccGam,_recordPatternBindingsIidOccDefs,_recordPatternBindingsIidUseOccGam,_recordPatternBindingsIpp,_recordPatternBindingsIppL,_recordPatternBindingsIppWrap,_recordPatternBindingsItopInstanceNmL,_recordPatternBindingsIundefOccGam) = + recordPatternBindings_ _recordPatternBindingsOfixityGam _recordPatternBindingsOgUniq _recordPatternBindingsOidGam _recordPatternBindingsOmoduleNm _recordPatternBindingsOnmLev _recordPatternBindingsOopts _recordPatternBindingsOpatchEhNmInInstance _recordPatternBindingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_RowRecordBinding :: Range -> + T_Pattern -> + T_RowRecordPatternBindings -> + T_Pattern +sem_Pattern_RowRecordBinding range_ pattern_ rowRecordPattternBindings_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _rowRecordPattternBindingsOfixityGam :: FixityGam + _rowRecordPattternBindingsOgUniq :: UID + _rowRecordPattternBindingsOidGam :: IdDefOccGam + _rowRecordPattternBindingsOmoduleNm :: HsName + _rowRecordPattternBindingsOnmLev :: NmLev + _rowRecordPattternBindingsOopts :: EHCOpts + _rowRecordPattternBindingsOpatchEhNmInInstance :: PatchEhNmInInstance + _rowRecordPattternBindingsOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _rowRecordPattternBindingsIeh :: ([EH.PatExpr -> EH.PatExpr]) + _rowRecordPattternBindingsIerrSq :: ErrSq + _rowRecordPattternBindingsIgUniq :: UID + _rowRecordPattternBindingsIidDefOccGam :: IdDefOccGam + _rowRecordPattternBindingsIidOccDefs :: ([IdOcc]) + _rowRecordPattternBindingsIidUseOccGam :: IdUseOccGam + _rowRecordPattternBindingsIpp :: PP_Doc + _rowRecordPattternBindingsIppL :: ([PP_Doc]) + _rowRecordPattternBindingsIppWrap :: (PP_Doc -> PP_Doc) + _rowRecordPattternBindingsItopInstanceNmL :: ([HsName]) + _rowRecordPattternBindingsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 362, column 9) + _pp = + ppAppTop (hsnRec,mkPPAppFun hsnRowEmpty _patternIpp) + _rowRecordPattternBindingsIppL _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 839, column 9) + _lhsOeh = + foldl (flip ($)) _patternIeh _rowRecordPattternBindingsIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq `Seq.union` _rowRecordPattternBindingsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam `gamAddGam` _rowRecordPattternBindingsIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs ++ _rowRecordPattternBindingsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam `gamAddGam` _rowRecordPattternBindingsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _rowRecordPattternBindingsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _rowRecordPattternBindingsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _rowRecordPattternBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowRecordPattternBindingsItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rowRecordPattternBindingsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rowRecordPattternBindingsOgUniq = + _patternIgUniq + -- copy rule (down) + _rowRecordPattternBindingsOidGam = + _lhsIidGam + -- copy rule (down) + _rowRecordPattternBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rowRecordPattternBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _rowRecordPattternBindingsOopts = + _lhsIopts + -- copy rule (down) + _rowRecordPattternBindingsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rowRecordPattternBindingsOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _rowRecordPattternBindingsIeh,_rowRecordPattternBindingsIerrSq,_rowRecordPattternBindingsIgUniq,_rowRecordPattternBindingsIidDefOccGam,_rowRecordPattternBindingsIidOccDefs,_rowRecordPattternBindingsIidUseOccGam,_rowRecordPattternBindingsIpp,_rowRecordPattternBindingsIppL,_rowRecordPattternBindingsIppWrap,_rowRecordPattternBindingsItopInstanceNmL,_rowRecordPattternBindingsIundefOccGam) = + rowRecordPattternBindings_ _rowRecordPattternBindingsOfixityGam _rowRecordPattternBindingsOgUniq _rowRecordPattternBindingsOidGam _rowRecordPattternBindingsOmoduleNm _rowRecordPattternBindingsOnmLev _rowRecordPattternBindingsOopts _rowRecordPattternBindingsOpatchEhNmInInstance _rowRecordPattternBindingsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_RowRecordEmpty :: Range -> + T_Pattern +sem_Pattern_RowRecordEmpty range_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOisVar :: Bool + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 365, column 9) + _pp = + hsnORec >|< hsnCRec + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 841, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Rec (rngLift range_ EH.RecPatExpr_Empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 264, column 9) + _lhsOisVar = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Irrefutable :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable range_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 367, column 9) + _pp = + "~" >|< _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 843, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Irrefutable _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pattern_Bang :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Bang range_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOeh :: (EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOisVar :: Bool + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 369, column 9) + _pp = + "!" >|< _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 845, column 9) + _lhsOeh = + rngLift range_ EH.PatExpr_Bang _patternIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 188, column 9) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOisVar = + _patternIisVar + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOisVar,_lhsOmbTopRefname,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- PatternAnnotation ------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.PatExprAnn + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Empty: + visit 0: + local eh : _ +-} +-- cata +sem_PatternAnnotation :: PatternAnnotation -> + T_PatternAnnotation +sem_PatternAnnotation (PatternAnnotation_Empty) = + (sem_PatternAnnotation_Empty) +-- semantic domain +type T_PatternAnnotation = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.PatExprAnn),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_PatternAnnotation_Empty :: T_PatternAnnotation +sem_PatternAnnotation_Empty = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.PatExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 902, column 17) + _eh = + EH.PatExprAnn_Empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.PatExpr] + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + alternative Nil: +-} +-- cata +sem_Patterns :: Patterns -> + T_Patterns +sem_Patterns list = + (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) +-- semantic domain +type T_Patterns = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.PatExpr]),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.PatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.PatExpr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidDefOccGam :: IdDefOccGam + _hdIidOccDefs :: ([IdOcc]) + _hdIidUseOccGam :: IdUseOccGam + _hdIisVar :: Bool + _hdImbTopRefname :: (Maybe HsName) + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.PatExpr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidDefOccGam :: IdDefOccGam + _tlIidOccDefs :: ([IdOcc]) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 426, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 795, column 24) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidDefOccGam,_hdIidOccDefs,_hdIidUseOccGam,_hdIisVar,_hdImbTopRefname,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidDefOccGam,_tlIidOccDefs,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.PatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 428, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 795, column 24) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Pragma ------------------------------------------------------ +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathPragmas : Set.Set Pragma.Pragma + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Language: + child range : {Range} + child pragmas : {Names} + visit 0: + local pragmaNames : _ + local pp : _ + alternative OptionsUHC: + child range : {Range} + child options : {String} + visit 0: + local pragmaNames : _ + alternative Derivable: + child range : {Range} + child className : {Name} + child fieldName : {Name} + child defaultName : {Name} + visit 0: + local pp : _ + alternative ExcludeIfTarget: + child range : {Range} + child targetNames : {[String]} + visit 0: + local targets : _ + local pp : _ +-} +-- cata +sem_Pragma :: Pragma -> + T_Pragma +sem_Pragma (Pragma_Language _range _pragmas) = + (sem_Pragma_Language _range _pragmas) +sem_Pragma (Pragma_OptionsUHC _range _options) = + (sem_Pragma_OptionsUHC _range _options) +sem_Pragma (Pragma_Derivable _range _className _fieldName _defaultName) = + (sem_Pragma_Derivable _range _className _fieldName _defaultName) +sem_Pragma (Pragma_ExcludeIfTarget _range _targetNames) = + (sem_Pragma_ExcludeIfTarget _range _targetNames) +-- semantic domain +type T_Pragma = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,(Set.Set Pragma.Pragma),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Pragma_Language :: Range -> + Names -> + T_Pragma +sem_Pragma_Language range_ pragmas_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 6, column 9) + _pragmaNames = + [ p | p <- map show pragmas_ ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 12, column 9) + _lhsOgathPragmas = + Set.fromList $ catMaybes [ Map.lookup p Pragma.allSimplePragmaMp | p <- _pragmaNames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 91, column 17) + _pp = + "LANGUAGE" >#< ppCommas pragmas_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pragma_OptionsUHC :: Range -> + String -> + T_Pragma +sem_Pragma_OptionsUHC range_ options_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 8, column 9) + _pragmaNames = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 16, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_OptionsUHC options_) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pragma_Derivable :: Range -> + Name -> + Name -> + Name -> + T_Pragma +sem_Pragma_Derivable range_ className_ fieldName_ defaultName_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 14, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_Derivable className_ fieldName_ defaultName_) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 93, column 17) + _pp = + "DERIVABLE" >#< className_ >#< fieldName_ >#< defaultName_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pragma_ExcludeIfTarget :: Range -> + ([String]) -> + T_Pragma +sem_Pragma_ExcludeIfTarget range_ targetNames_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 18, column 9) + _targets = + catMaybes $ map (\t -> Map.lookup t supportedTargetMp) targetNames_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 19, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_ExcludeIfTarget _targets) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 95, column 17) + _pp = + "EXCLUDE_IF_TARGET" >#< ppCommas targetNames_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Pragmas ----------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + errSq : ErrSq + gathPragmas : Set.Set Pragma.Pragma + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Pragma + child tl : Pragmas + alternative Nil: +-} +-- cata +sem_Pragmas :: Pragmas -> + T_Pragmas +sem_Pragmas list = + (Prelude.foldr sem_Pragmas_Cons sem_Pragmas_Nil (Prelude.map sem_Pragma list)) +-- semantic domain +type T_Pragmas = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ErrSq,UID,(Set.Set Pragma.Pragma),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Pragmas_Cons :: T_Pragma -> + T_Pragmas -> + T_Pragmas +sem_Pragmas_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIerrSq,_hdIgUniq,_hdIgathPragmas,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOgUniq _hdOidGam _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIerrSq,_tlIgUniq,_tlIgathPragmas,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOgUniq _tlOidGam _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Pragmas_Nil :: T_Pragmas +sem_Pragmas_Nil = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOerrSq,_lhsOgUniq,_lhsOgathPragmas,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Qualifier --------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + moduleNm : HsName + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + idGam : IdDefOccGam + nmLev : NmLev + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Expr -> EH.Expr + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Guard: + child range : {Range} + child guard : Expression + visit 0: + local valrefnames : _ + local idUseOccGamVal : _ + local errIdUseVal : _ + local typerefname : _ + local idUseOccGamType : _ + local errIdUseType : _ + local idUseOccGam : _ + local errSq : _ + alternative Let: + child range : {Range} + child declarations : Declarations + visit 0: + local idGam : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + alternative Generator: + child range : {Range} + child pattern : Pattern + child expression : Expression + visit 0: + local refnames : _ + local idUseOccGam : _ + local errIdUse : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + alternative Empty: + child range : {Range} + visit 0: + local refnames : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ +-} +-- cata +sem_Qualifier :: Qualifier -> + T_Qualifier +sem_Qualifier (Qualifier_Guard _range _guard) = + (sem_Qualifier_Guard _range (sem_Expression _guard)) +sem_Qualifier (Qualifier_Let _range _declarations) = + (sem_Qualifier_Let _range (sem_Declarations _declarations)) +sem_Qualifier (Qualifier_Generator _range _pattern _expression) = + (sem_Qualifier_Generator _range (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Qualifier (Qualifier_Empty _range) = + (sem_Qualifier_Empty _range) +-- semantic domain +type T_Qualifier = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.Expr -> EH.Expr),ErrSq,UID,FixityGam,IdDefOccGam,IdUseOccGam,NmLev,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Qualifier_Guard :: Range -> + T_Expression -> + T_Qualifier +sem_Qualifier_Guard range_ guard_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _guardOcaseId :: UID + _guardOfixityGam :: FixityGam + _guardOgUniq :: UID + _guardOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _guardOidGam :: IdDefOccGam + _guardOmoduleNm :: HsName + _guardOnmLev :: NmLev + _guardOopts :: EHCOpts + _guardOpatchEhNmInInstance :: PatchEhNmInInstance + _guardOpragmas :: (Set.Set Pragma.Pragma) + _guardOtopInstanceNmL :: ([HsName]) + _guardIconNm :: Name + _guardIeh :: (EH.Expr) + _guardIerrSq :: ErrSq + _guardIgUniq :: UID + _guardIidUseOccGam :: IdUseOccGam + _guardIopChain :: (OpChain EH.Expr) + _guardIoperatorName :: MaybeName + _guardIpp :: PP_Doc + _guardIppWrap :: (PP_Doc -> PP_Doc) + _guardItopInstanceNmL :: ([HsName]) + _guardIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 532, column 29) + (_,_valrefnames,_idUseOccGamVal,_errIdUseVal) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnTrue,hsnFalse,hsnDataListAltNil] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 534, column 29) + (_typerefname,_,_idUseOccGamType,_errIdUseType) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnBool] IdOcc_Type IdAsp_Type_Con range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 532, column 9) + _idUseOccGam = + gamUnions [_idUseOccGamVal,_idUseOccGamType] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 537, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_guardIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 99, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUseVal, Seq.fromList _errIdUseType, _guardIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 608, column 9) + _lhsOeh = + \e -> EH.mkIf' (_typerefname : _valrefnames) range_ _guardIeh e (appCon (_valrefnames !! 2)) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _guardIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _guardIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _guardIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _guardIgUniq + -- copy rule (chain) + _lhsOidGam = + _lhsIidGam + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _guardItopInstanceNmL + -- copy rule (down) + _guardOcaseId = + _lhsIcaseId + -- copy rule (down) + _guardOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _guardOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _guardOidGam = + _lhsIidGam + -- copy rule (down) + _guardOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardOnmLev = + _lhsInmLev + -- copy rule (down) + _guardOopts = + _lhsIopts + -- copy rule (down) + _guardOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _guardOpragmas = + _lhsIpragmas + -- copy rule (down) + _guardOtopInstanceNmL = + _lhsItopInstanceNmL + ( _guardIconNm,_guardIeh,_guardIerrSq,_guardIgUniq,_guardIidUseOccGam,_guardIopChain,_guardIoperatorName,_guardIpp,_guardIppWrap,_guardItopInstanceNmL,_guardIundefOccGam) = + guard_ _guardOcaseId _guardOfixityGam _guardOgUniq _guardOgenerDerivMp _guardOidGam _guardOmoduleNm _guardOnmLev _guardOopts _guardOpatchEhNmInInstance _guardOpragmas _guardOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Qualifier_Let :: Range -> + T_Declarations -> + T_Qualifier +sem_Qualifier_Let range_ declarations_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOcaseId :: UID + _declarationsOfixityGam :: FixityGam + _declarationsOgUniq :: UID + _declarationsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _declarationsOidGam :: IdDefOccGam + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _declarationsOpragmas :: (Set.Set Pragma.Pragma) + _declarationsOtopInstanceNmL :: ([HsName]) + _declarationsIeh :: ([EH.Decl]) + _declarationsIerrSq :: ErrSq + _declarationsIgUniq :: UID + _declarationsIgathFixityGam :: FixityGam + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidDefOccGam :: IdDefOccGam + _declarationsIidDpdMp :: IdDpdMp + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsIidTySigDefOccGam :: IdDefOccGam + _declarationsIidUseOccGam :: IdUseOccGam + _declarationsIneedsError :: Bool + _declarationsIpp :: PP_Doc + _declarationsIppWrap :: (PP_Doc -> PP_Doc) + _declarationsItopInstanceNmL :: ([HsName]) + _declarationsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 396, column 9) + _idGam = + gamUnion _declarationsIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 899, column 9) + _sccOrder = + idDpdMp2SccOrder _declarationsIidDefOccGam _declarationsIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1031, column 29) + (_mkSccLet,_,_errReorder) = + mkIdOccSccEH range_ False _declarationsIidDefOccGam (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 77, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 127, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _declarationsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 97, column 9) + _errSq = + Seq.firstNotEmpty [Seq.fromList _errDupIntro, _declarationsIerrSq, Seq.fromList _errReorder] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 269, column 9) + _pp = + "let" >#< _declarationsIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 610, column 9) + _lhsOeh = + _mkSccLet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _declarationsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _declarationsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _declarationsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _declarationsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (from local) + _lhsOidGam = + _idGam + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _declarationsOcaseId = + _lhsIcaseId + -- copy rule (down) + _declarationsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _declarationsOidGam = + _idGam + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _declarationsOpragmas = + _lhsIpragmas + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _declarationsIeh,_declarationsIerrSq,_declarationsIgUniq,_declarationsIgathFixityGam,_declarationsIgathPragmas,_declarationsIidDefOccGam,_declarationsIidDpdMp,_declarationsIidOccDefs,_declarationsIidTySigDefOccGam,_declarationsIidUseOccGam,_declarationsIneedsError,_declarationsIpp,_declarationsIppWrap,_declarationsItopInstanceNmL,_declarationsIundefOccGam) = + declarations_ _declarationsOcaseId _declarationsOfixityGam _declarationsOgUniq _declarationsOgenerDerivMp _declarationsOidGam _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOpatchEhNmInInstance _declarationsOpragmas _declarationsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Qualifier_Generator :: Range -> + T_Pattern -> + T_Expression -> + T_Qualifier +sem_Qualifier_Generator range_ pattern_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 398, column 9) + _lhsOidGam = + gamUnion _patternIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 539, column 29) + (_,_refnames,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnPrelConcatMap,hsnDataListAltNil] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 541, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_patternIidUseOccGam,_expressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 77, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 125, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _patternIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 101, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, Seq.fromList _errIdUse, _patternIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 271, column 9) + _pp = + _patternIpp >#< "<-" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 612, column 9) + _lhsOeh = + ehGenerator + range_ _patternIeh + (\e -> ehExpVarApp range_ (_refnames !! 0) [e,_expressionIeh]) + (appCon (_refnames !! 1)) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _patternIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Qualifier_Empty :: Range -> + T_Qualifier +sem_Qualifier_Empty range_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 543, column 29) + (_,_refnames,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnDataListAltCons,hsnDataListAltNil] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 103, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 617, column 9) + _lhsOeh = + \e -> ehExpConApp range_ (_refnames !! 0) [e,appCon (_refnames !! 1)] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOidGam = + _lhsIidGam + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Qualifiers -------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + idGam : IdDefOccGam + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Expr -> EH.Expr] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Qualifier + child tl : Qualifiers + visit 0: + local fixityGam : _ + alternative Nil: +-} +-- cata +sem_Qualifiers :: Qualifiers -> + T_Qualifiers +sem_Qualifiers list = + (Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list)) +-- semantic domain +type T_Qualifiers = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Expr -> EH.Expr]),ErrSq,UID,IdDefOccGam,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Qualifiers_Cons :: T_Qualifier -> + T_Qualifiers -> + T_Qualifiers +sem_Qualifiers_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.Expr -> EH.Expr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIidGam :: IdDefOccGam + _hdIidUseOccGam :: IdUseOccGam + _hdInmLev :: NmLev + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.Expr -> EH.Expr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidGam :: IdDefOccGam + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 434, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 35, column 9) + _fixityGam = + _hdIgathFixityGam `gamUnion` _lhsIfixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 602, column 26) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOidGam = + _tlIidGam + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (from local) + _hdOfixityGam = + _fixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (from local) + _tlOfixityGam = + _fixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (chain) + _tlOidGam = + _hdIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (chain) + _tlOnmLev = + _hdInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIidGam,_hdIidUseOccGam,_hdInmLev,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidGam,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 436, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 602, column 26) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOidGam = + _lhsIidGam + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidGam,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RecordExpressionBinding ------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.DataFieldExpr -> EH.DataFieldExpr + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Binding: + child range : {Range} + child name : {Name} + child expression : Expression + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ +-} +-- cata +sem_RecordExpressionBinding :: RecordExpressionBinding -> + T_RecordExpressionBinding +sem_RecordExpressionBinding (RecordExpressionBinding_Binding _range _name _expression) = + (sem_RecordExpressionBinding_Binding _range _name (sem_Expression _expression)) +-- semantic domain +type T_RecordExpressionBinding = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.DataFieldExpr -> EH.DataFieldExpr),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RecordExpressionBinding_Binding :: Range -> + Name -> + T_Expression -> + T_RecordExpressionBinding +sem_RecordExpressionBinding_Binding range_ name_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: (EH.DataFieldExpr -> EH.DataFieldExpr) + _lhsOerrSq :: ErrSq + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 604, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Fld (IdAsp_Val_Fld hsnUnknown hsnUnknown) range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 606, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_expressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 107, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 285, column 9) + _pp = + name_ >|< "=" >|< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 642, column 9) + _lhsOeh = + \df -> rngLift range_ EH.DataFieldExpr_Upd df _refname _expressionIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RecordExpressionBindings ------------------------------------ +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.DataFieldExpr -> EH.DataFieldExpr] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : RecordExpressionBinding + child tl : RecordExpressionBindings + alternative Nil: +-} +-- cata +sem_RecordExpressionBindings :: RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings list = + (Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list)) +-- semantic domain +type T_RecordExpressionBindings = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.DataFieldExpr -> EH.DataFieldExpr]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> + T_RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataFieldExpr -> EH.DataFieldExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.DataFieldExpr -> EH.DataFieldExpr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.DataFieldExpr -> EH.DataFieldExpr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 466, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 636, column 40) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataFieldExpr -> EH.DataFieldExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 468, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 636, column 40) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RecordPatternBinding ---------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.DataFieldPatExpr -> EH.DataFieldPatExpr + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Binding: + child range : {Range} + child name : {Name} + child pattern : Pattern + visit 0: + local fldrefname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + alternative Pun: + child range : {Range} + child name : {Name} + visit 0: + local idDefOccGam : _ + local fldrefname : _ + local idUseOccGam : _ + local errIdUse : _ + local refname : _ + local idOccDef : _ + local errSq : _ + local pp : _ +-} +-- cata +sem_RecordPatternBinding :: RecordPatternBinding -> + T_RecordPatternBinding +sem_RecordPatternBinding (RecordPatternBinding_Binding _range _name _pattern) = + (sem_RecordPatternBinding_Binding _range _name (sem_Pattern _pattern)) +sem_RecordPatternBinding (RecordPatternBinding_Pun _range _name) = + (sem_RecordPatternBinding_Pun _range _name) +-- semantic domain +type T_RecordPatternBinding = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.DataFieldPatExpr -> EH.DataFieldPatExpr),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RecordPatternBinding_Binding :: Range -> + Name -> + T_Pattern -> + T_RecordPatternBinding +sem_RecordPatternBinding_Binding range_ name_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: (EH.DataFieldPatExpr -> EH.DataFieldPatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 610, column 29) + (_fldrefname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Fld (IdAsp_Val_Fld hsnUnknown hsnUnknown) range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 613, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_patternIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 111, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _patternIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 305, column 9) + _pp = + name_ >|< "=" >|< _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 708, column 9) + _lhsOeh = + \df -> rngLift range_ EH.DataFieldPatExpr_Ext df _fldrefname _patternIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RecordPatternBinding_Pun :: Range -> + Name -> + T_RecordPatternBinding +sem_RecordPatternBinding_Pun range_ name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.DataFieldPatExpr -> EH.DataFieldPatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 230, column 9) + _idDefOccGam = + mkDefOccGam _lhsInmLev range_ IdAsp_Val_Var [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 610, column 29) + (_fldrefname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] IdOcc_Fld (IdAsp_Val_Fld hsnUnknown hsnUnknown) range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 92, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 184, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 113, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 307, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 710, column 9) + _lhsOeh = + \df -> rngLift range_ EH.DataFieldPatExpr_Ext df _fldrefname (rngLift range_ EH.PatExpr_Var _refname) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _idDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RecordPatternBindings --------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.DataFieldPatExpr -> EH.DataFieldPatExpr] + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : RecordPatternBinding + child tl : RecordPatternBindings + alternative Nil: +-} +-- cata +sem_RecordPatternBindings :: RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings list = + (Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list)) +-- semantic domain +type T_RecordPatternBindings = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.DataFieldPatExpr -> EH.DataFieldPatExpr]),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> + T_RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataFieldPatExpr -> EH.DataFieldPatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.DataFieldPatExpr -> EH.DataFieldPatExpr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidDefOccGam :: IdDefOccGam + _hdIidOccDefs :: ([IdOcc]) + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.DataFieldPatExpr -> EH.DataFieldPatExpr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidDefOccGam :: IdDefOccGam + _tlIidOccDefs :: ([IdOcc]) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 472, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 702, column 37) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidDefOccGam,_hdIidOccDefs,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidDefOccGam,_tlIidOccDefs,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.DataFieldPatExpr -> EH.DataFieldPatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 474, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 702, column 37) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RightHandSide ----------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + mustBeMono : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + sepPP : PP_Doc + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Expr + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Expression: + child range : {Range} + child expression : Expression + child where : MaybeDeclarations + visit 0: + local idGam : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local nmLev : _ + local errSq : _ + local pp : _ + local fixityGam : _ + alternative Guarded: + child range : {Range} + child guardedexpressions : GuardedExpressions + child where : MaybeDeclarations + visit 0: + local idGam : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local nmLev : _ + local pp : _ + local fixityGam : _ +-} +-- cata +sem_RightHandSide :: RightHandSide -> + T_RightHandSide +sem_RightHandSide (RightHandSide_Expression _range _expression _where) = + (sem_RightHandSide_Expression _range (sem_Expression _expression) (sem_MaybeDeclarations _where)) +sem_RightHandSide (RightHandSide_Guarded _range _guardedexpressions _where) = + (sem_RightHandSide_Guarded _range (sem_GuardedExpressions _guardedexpressions) (sem_MaybeDeclarations _where)) +-- semantic domain +type T_RightHandSide = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + PP_Doc -> + ([HsName]) -> + ( (EH.Expr),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RightHandSide_Expression :: Range -> + T_Expression -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Expression range_ expression_ where_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsImustBeMono + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsIsepPP + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _whereOcaseId :: UID + _whereOfixityGam :: FixityGam + _whereOgUniq :: UID + _whereOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _whereOidGam :: IdDefOccGam + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOpatchEhNmInInstance :: PatchEhNmInInstance + _whereOpragmas :: (Set.Set Pragma.Pragma) + _whereOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + _whereIeh :: (Maybe [EH.Decl]) + _whereIerrSq :: ErrSq + _whereIgUniq :: UID + _whereIgathFixityGam :: FixityGam + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidDefOccGam :: IdDefOccGam + _whereIidDpdMp :: IdDpdMp + _whereIidOccDefs :: ([IdOcc]) + _whereIidTySigDefOccGam :: IdDefOccGam + _whereIidUseOccGam :: IdUseOccGam + _whereIneedsError :: Bool + _whereIpp :: PP_Doc + _whereIppWrap :: (PP_Doc -> PP_Doc) + _whereItopInstanceNmL :: ([HsName]) + _whereIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 388, column 9) + _idGam = + gamUnion _whereIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 895, column 9) + _sccOrder = + idDpdMp2SccOrder _whereIidDefOccGam _whereIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1026, column 29) + (_mkSccLet,_,_errReorder) = + mkIdOccSccEH range_ False _whereIidDefOccGam (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 69, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 36, column 9) + _errSq = + Seq.unions [Seq.fromList _errReorder, _expressionIerrSq, _whereIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 327, column 9) + _pp = + _lhsIsepPP >#< _expressionIpp >-< _whereIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 31, column 9) + _fixityGam = + _whereIgathFixityGam `gamUnion` _lhsIfixityGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 761, column 9) + _lhsOeh = + _mkSccLet + $ ehMkEnforceMono range_ _lhsImustBeMono + _expressionIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam `gamAddGam` _whereIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap . _whereIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam `gamUnion` _whereIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _whereItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (from local) + _expressionOfixityGam = + _fixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _expressionOidGam = + _idGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _whereOcaseId = + _lhsIcaseId + -- copy rule (from local) + _whereOfixityGam = + _fixityGam + -- copy rule (chain) + _whereOgUniq = + _expressionIgUniq + -- copy rule (down) + _whereOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _whereOidGam = + _idGam + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (down) + _whereOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _whereOpragmas = + _lhsIpragmas + -- copy rule (chain) + _whereOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + ( _whereIeh,_whereIerrSq,_whereIgUniq,_whereIgathFixityGam,_whereIgathPragmas,_whereIidDefOccGam,_whereIidDpdMp,_whereIidOccDefs,_whereIidTySigDefOccGam,_whereIidUseOccGam,_whereIneedsError,_whereIpp,_whereIppWrap,_whereItopInstanceNmL,_whereIundefOccGam) = + where_ _whereOcaseId _whereOfixityGam _whereOgUniq _whereOgenerDerivMp _whereOidGam _whereOmoduleNm _whereOnmLev _whereOopts _whereOpatchEhNmInInstance _whereOpragmas _whereOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RightHandSide_Guarded :: Range -> + T_GuardedExpressions -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Guarded range_ guardedexpressions_ where_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsImustBeMono + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsIsepPP + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardedexpressionsOcaseId :: UID + _guardedexpressionsOfixityGam :: FixityGam + _guardedexpressionsOgUniq :: UID + _guardedexpressionsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _guardedexpressionsOidGam :: IdDefOccGam + _guardedexpressionsOmoduleNm :: HsName + _guardedexpressionsOmustBeMono :: Bool + _guardedexpressionsOnmLev :: NmLev + _guardedexpressionsOopts :: EHCOpts + _guardedexpressionsOpatchEhNmInInstance :: PatchEhNmInInstance + _guardedexpressionsOpragmas :: (Set.Set Pragma.Pragma) + _guardedexpressionsOsepPP :: PP_Doc + _guardedexpressionsOtopInstanceNmL :: ([HsName]) + _whereOcaseId :: UID + _whereOfixityGam :: FixityGam + _whereOgUniq :: UID + _whereOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _whereOidGam :: IdDefOccGam + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOpatchEhNmInInstance :: PatchEhNmInInstance + _whereOpragmas :: (Set.Set Pragma.Pragma) + _whereOtopInstanceNmL :: ([HsName]) + _guardedexpressionsIeh :: ([UIDS -> EH.Expr -> EH.Expr]) + _guardedexpressionsIerrSq :: ErrSq + _guardedexpressionsIgUniq :: UID + _guardedexpressionsIidUseOccGam :: IdUseOccGam + _guardedexpressionsIpp :: PP_Doc + _guardedexpressionsIppWrap :: (PP_Doc -> PP_Doc) + _guardedexpressionsItopInstanceNmL :: ([HsName]) + _guardedexpressionsIundefOccGam :: IdUseOccGam + _whereIeh :: (Maybe [EH.Decl]) + _whereIerrSq :: ErrSq + _whereIgUniq :: UID + _whereIgathFixityGam :: FixityGam + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidDefOccGam :: IdDefOccGam + _whereIidDpdMp :: IdDpdMp + _whereIidOccDefs :: ([IdOcc]) + _whereIidTySigDefOccGam :: IdDefOccGam + _whereIidUseOccGam :: IdUseOccGam + _whereIneedsError :: Bool + _whereIpp :: PP_Doc + _whereIppWrap :: (PP_Doc -> PP_Doc) + _whereItopInstanceNmL :: ([HsName]) + _whereIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 388, column 9) + _idGam = + gamUnion _whereIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 895, column 9) + _sccOrder = + idDpdMp2SccOrder _whereIidDefOccGam _whereIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1026, column 29) + (_mkSccLet,_,_errReorder) = + mkIdOccSccEH range_ False _whereIidDefOccGam (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 69, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 329, column 9) + _pp = + _guardedexpressionsIpp >-< _whereIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 31, column 9) + _fixityGam = + _whereIgathFixityGam `gamUnion` _lhsIfixityGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 765, column 9) + _lhsOeh = + _mkSccLet (foldr (\(mk,failS) e -> mk failS e) + (rngLift range_ EH.Expr_CaseAltFail _lhsIcaseId) + (zip _guardedexpressionsIeh (Set.singleton _lhsIcaseId : repeat Set.empty))) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _guardedexpressionsIerrSq `Seq.union` _whereIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _guardedexpressionsIidUseOccGam `gamAddGam` _whereIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _guardedexpressionsIppWrap . _whereIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _guardedexpressionsIundefOccGam `gamUnion` _whereIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _whereItopInstanceNmL + -- copy rule (down) + _guardedexpressionsOcaseId = + _lhsIcaseId + -- copy rule (from local) + _guardedexpressionsOfixityGam = + _fixityGam + -- copy rule (down) + _guardedexpressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardedexpressionsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _guardedexpressionsOidGam = + _idGam + -- copy rule (down) + _guardedexpressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardedexpressionsOmustBeMono = + _lhsImustBeMono + -- copy rule (from local) + _guardedexpressionsOnmLev = + _nmLev + -- copy rule (down) + _guardedexpressionsOopts = + _lhsIopts + -- copy rule (down) + _guardedexpressionsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _guardedexpressionsOpragmas = + _lhsIpragmas + -- copy rule (down) + _guardedexpressionsOsepPP = + _lhsIsepPP + -- copy rule (down) + _guardedexpressionsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _whereOcaseId = + _lhsIcaseId + -- copy rule (from local) + _whereOfixityGam = + _fixityGam + -- copy rule (chain) + _whereOgUniq = + _guardedexpressionsIgUniq + -- copy rule (down) + _whereOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _whereOidGam = + _idGam + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (down) + _whereOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _whereOpragmas = + _lhsIpragmas + -- copy rule (chain) + _whereOtopInstanceNmL = + _guardedexpressionsItopInstanceNmL + ( _guardedexpressionsIeh,_guardedexpressionsIerrSq,_guardedexpressionsIgUniq,_guardedexpressionsIidUseOccGam,_guardedexpressionsIpp,_guardedexpressionsIppWrap,_guardedexpressionsItopInstanceNmL,_guardedexpressionsIundefOccGam) = + guardedexpressions_ _guardedexpressionsOcaseId _guardedexpressionsOfixityGam _guardedexpressionsOgUniq _guardedexpressionsOgenerDerivMp _guardedexpressionsOidGam _guardedexpressionsOmoduleNm _guardedexpressionsOmustBeMono _guardedexpressionsOnmLev _guardedexpressionsOopts _guardedexpressionsOpatchEhNmInInstance _guardedexpressionsOpragmas _guardedexpressionsOsepPP _guardedexpressionsOtopInstanceNmL + ( _whereIeh,_whereIerrSq,_whereIgUniq,_whereIgathFixityGam,_whereIgathPragmas,_whereIidDefOccGam,_whereIidDpdMp,_whereIidOccDefs,_whereIidTySigDefOccGam,_whereIidUseOccGam,_whereIneedsError,_whereIpp,_whereIppWrap,_whereItopInstanceNmL,_whereIundefOccGam) = + where_ _whereOcaseId _whereOfixityGam _whereOgUniq _whereOgenerDerivMp _whereOidGam _whereOmoduleNm _whereOnmLev _whereOopts _whereOpatchEhNmInInstance _whereOpragmas _whereOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowRecordExpressionUpdate ----------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.Expr -> EH.Expr + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Update: + child range : {Range} + child name : {Name} + child expression : Expression + visit 0: + local pp : _ + alternative Extends: + child range : {Range} + child name : {MaybeName} + child expression : Expression + visit 0: + local pp : _ +-} +-- cata +sem_RowRecordExpressionUpdate :: RowRecordExpressionUpdate -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate (RowRecordExpressionUpdate_Update _range _name _expression) = + (sem_RowRecordExpressionUpdate_Update _range _name (sem_Expression _expression)) +sem_RowRecordExpressionUpdate (RowRecordExpressionUpdate_Extends _range _name _expression) = + (sem_RowRecordExpressionUpdate_Extends _range _name (sem_Expression _expression)) +-- semantic domain +type T_RowRecordExpressionUpdate = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( (EH.Expr -> EH.Expr),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowRecordExpressionUpdate_Update :: Range -> + Name -> + T_Expression -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate_Update range_ name_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 291, column 9) + _pp = + name_ >|< ":=" >|< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 684, column 9) + _lhsOeh = + ehRowRecExprUpd range_ name_ (rngLift range_ EH.RecExpr_Upd) _expressionIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RowRecordExpressionUpdate_Extends :: Range -> + MaybeName -> + T_Expression -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate_Extends range_ name_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.Expr -> EH.Expr) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 289, column 9) + _pp = + name_ >|< "=" >|< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 682, column 9) + _lhsOeh = + ehRowRecExprUpd range_ name_ (rngLift range_ EH.RecExpr_Ext) _expressionIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _expressionIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _expressionIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowRecordExpressionUpdates ---------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.Expr -> EH.Expr] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : RowRecordExpressionUpdate + child tl : RowRecordExpressionUpdates + alternative Nil: +-} +-- cata +sem_RowRecordExpressionUpdates :: RowRecordExpressionUpdates -> + T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates list = + (Prelude.foldr sem_RowRecordExpressionUpdates_Cons sem_RowRecordExpressionUpdates_Nil (Prelude.map sem_RowRecordExpressionUpdate list)) +-- semantic domain +type T_RowRecordExpressionUpdates = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([EH.Expr -> EH.Expr]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowRecordExpressionUpdates_Cons :: T_RowRecordExpressionUpdate -> + T_RowRecordExpressionUpdates -> + T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.Expr -> EH.Expr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.Expr -> EH.Expr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 484, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 676, column 42) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RowRecordExpressionUpdates_Nil :: T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.Expr -> EH.Expr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 486, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 676, column 42) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowRecordPatternBinding ------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.PatExpr -> EH.PatExpr + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Binding: + child range : {Range} + child name : {MaybeName} + child pattern : Pattern + visit 0: + local pp : _ +-} +-- cata +sem_RowRecordPatternBinding :: RowRecordPatternBinding -> + T_RowRecordPatternBinding +sem_RowRecordPatternBinding (RowRecordPatternBinding_Binding _range _name _pattern) = + (sem_RowRecordPatternBinding_Binding _range _name (sem_Pattern _pattern)) +-- semantic domain +type T_RowRecordPatternBinding = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.PatExpr -> EH.PatExpr),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowRecordPatternBinding_Binding :: Range -> + MaybeName -> + T_Pattern -> + T_RowRecordPatternBinding +sem_RowRecordPatternBinding_Binding range_ name_ pattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.PatExpr -> EH.PatExpr) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 295, column 9) + _pp = + case name_ of + Just n -> n >|< "=" >|< _patternIpp + Nothing -> _patternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 692, column 9) + _lhsOeh = + ehRowRecPatExprUpd range_ name_ (rngLift range_ EH.RecPatExpr_Ext) _patternIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _patternIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowRecordPatternBindings ------------------------------------ +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.PatExpr -> EH.PatExpr] + errSq : ErrSq + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : RowRecordPatternBinding + child tl : RowRecordPatternBindings + alternative Nil: +-} +-- cata +sem_RowRecordPatternBindings :: RowRecordPatternBindings -> + T_RowRecordPatternBindings +sem_RowRecordPatternBindings list = + (Prelude.foldr sem_RowRecordPatternBindings_Cons sem_RowRecordPatternBindings_Nil (Prelude.map sem_RowRecordPatternBinding list)) +-- semantic domain +type T_RowRecordPatternBindings = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.PatExpr -> EH.PatExpr]),ErrSq,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowRecordPatternBindings_Cons :: T_RowRecordPatternBinding -> + T_RowRecordPatternBindings -> + T_RowRecordPatternBindings +sem_RowRecordPatternBindings_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.PatExpr -> EH.PatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.PatExpr -> EH.PatExpr) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidDefOccGam :: IdDefOccGam + _hdIidOccDefs :: ([IdOcc]) + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.PatExpr -> EH.PatExpr]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidDefOccGam :: IdDefOccGam + _tlIidOccDefs :: ([IdOcc]) + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 490, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 686, column 40) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _hdIidDefOccGam `gamAddGam` _tlIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidDefOccGam,_hdIidOccDefs,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOfixityGam _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidDefOccGam,_tlIidOccDefs,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RowRecordPatternBindings_Nil :: T_RowRecordPatternBindings +sem_RowRecordPatternBindings_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.PatExpr -> EH.PatExpr]) + _lhsOerrSq :: ErrSq + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 492, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 686, column 40) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowTypeUpdate ----------------------------------------------- +{- + visit 0: + inherited attributes: + doGenVarWild : Bool + fixityGam : FixityGam + idGam : IdDefOccGam + isAsPred : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.TyExpr -> EH.TyExpr + ehMbAsPrL : [Maybe EH.PrExpr] + ehMbAsTyPrL : [Maybe EH.TyExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Extends: + child range : {Range} + child name : {MaybeName} + child type : Type + visit 0: + local pp : _ + local ehMbAsPrL : _ +-} +-- cata +sem_RowTypeUpdate :: RowTypeUpdate -> + T_RowTypeUpdate +sem_RowTypeUpdate (RowTypeUpdate_Extends _range _name _type) = + (sem_RowTypeUpdate_Extends _range _name (sem_Type _type)) +-- semantic domain +type T_RowTypeUpdate = Bool -> + FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.TyExpr -> EH.TyExpr),([Maybe EH.PrExpr]),([Maybe EH.TyExpr]),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowTypeUpdate_Extends :: Range -> + MaybeName -> + T_Type -> + T_RowTypeUpdate +sem_RowTypeUpdate_Extends range_ name_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: (EH.TyExpr -> EH.TyExpr) + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 301, column 9) + _pp = + name_ >|< "::" >|< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 379, column 9) + _ehMbAsPrL = + [_typeIehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 700, column 9) + _lhsOeh = + ehRowRowTyExprUpd range_ name_ (rngLift range_ EH.RowTyExpr_Ext) _typeIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _typeIehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (down) + _typeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOeh,_lhsOehMbAsPrL,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- RowTypeUpdates ---------------------------------------------- +{- + visit 0: + inherited attributes: + doGenVarWild : Bool + fixityGam : FixityGam + idGam : IdDefOccGam + isAsPred : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.TyExpr -> EH.TyExpr] + ehMbAsPrL : [Maybe EH.PrExpr] + ehMbAsTyPrL : [Maybe EH.TyExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : RowTypeUpdate + child tl : RowTypeUpdates + alternative Nil: +-} +-- cata +sem_RowTypeUpdates :: RowTypeUpdates -> + T_RowTypeUpdates +sem_RowTypeUpdates list = + (Prelude.foldr sem_RowTypeUpdates_Cons sem_RowTypeUpdates_Nil (Prelude.map sem_RowTypeUpdate list)) +-- semantic domain +type T_RowTypeUpdates = Bool -> + FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.TyExpr -> EH.TyExpr]),([Maybe EH.PrExpr]),([Maybe EH.TyExpr]),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_RowTypeUpdates_Cons :: T_RowTypeUpdate -> + T_RowTypeUpdates -> + T_RowTypeUpdates +sem_RowTypeUpdates_Cons hd_ tl_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyExpr -> EH.TyExpr]) + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOdoGenVarWild :: Bool + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOisAsPred :: Bool + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOdoGenVarWild :: Bool + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOisAsPred :: Bool + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.TyExpr -> EH.TyExpr) + _hdIehMbAsPrL :: ([Maybe EH.PrExpr]) + _hdIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.TyExpr -> EH.TyExpr]) + _tlIehMbAsPrL :: ([Maybe EH.PrExpr]) + _tlIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 460, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 694, column 30) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _hdIehMbAsPrL ++ _tlIehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _hdIehMbAsTyPrL ++ _tlIehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIehMbAsPrL,_hdIehMbAsTyPrL,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOdoGenVarWild _hdOfixityGam _hdOgUniq _hdOidGam _hdOisAsPred _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIehMbAsPrL,_tlIehMbAsTyPrL,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOdoGenVarWild _tlOfixityGam _tlOgUniq _tlOidGam _tlOisAsPred _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOehMbAsPrL,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_RowTypeUpdates_Nil :: T_RowTypeUpdates +sem_RowTypeUpdates_Nil = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyExpr -> EH.TyExpr]) + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 462, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 694, column 30) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOehMbAsPrL,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Statement --------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + moduleNm : HsName + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + idGam : IdDefOccGam + nmLev : NmLev + topInstanceNmL : [HsName] + synthesized attributes: + eh : (EH.Expr,EH.Expr -> EH.Expr) + errSq : ErrSq + gathFixityGam : FixityGam + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Expression: + child range : {Range} + child expression : Expression + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + alternative Let: + child range : {Range} + child declarations : Declarations + visit 0: + local idGam : _ + local sccOrder : _ + local mkSccLet : _ + local errReorder : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + alternative Generator: + child range : {Range} + child pattern : Pattern + child expression : Expression + visit 0: + local refnames : _ + local idUseOccGam : _ + local errIdUse : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + alternative Empty: + child range : {Range} +-} +-- cata +sem_Statement :: Statement -> + T_Statement +sem_Statement (Statement_Expression _range _expression) = + (sem_Statement_Expression _range (sem_Expression _expression)) +sem_Statement (Statement_Let _range _declarations) = + (sem_Statement_Let _range (sem_Declarations _declarations)) +sem_Statement (Statement_Generator _range _pattern _expression) = + (sem_Statement_Generator _range (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Statement (Statement_Empty _range) = + (sem_Statement_Empty _range) +-- semantic domain +type T_Statement = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ((EH.Expr,EH.Expr -> EH.Expr)),ErrSq,UID,FixityGam,IdDefOccGam,IdUseOccGam,NmLev,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Statement_Expression :: Range -> + T_Expression -> + T_Statement +sem_Statement_Expression range_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: ((EH.Expr,EH.Expr -> EH.Expr)) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 640, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnMonadSeq] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 642, column 9) + _lhsOidUseOccGam = + _idUseOccGam `gamUnion` _expressionIidUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 119, column 9) + _errSq = + Seq.unions [Seq.fromList _errIdUse, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 589, column 9) + _lhsOeh = + (_expressionIeh,\e -> ehExpVarApp range_ _refname [_expressionIeh,e]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _expressionIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (chain) + _lhsOidGam = + _lhsIidGam + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Statement_Let :: Range -> + T_Declarations -> + T_Statement +sem_Statement_Let range_ declarations_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ((EH.Expr,EH.Expr -> EH.Expr)) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOcaseId :: UID + _declarationsOfixityGam :: FixityGam + _declarationsOgUniq :: UID + _declarationsOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _declarationsOidGam :: IdDefOccGam + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOpatchEhNmInInstance :: PatchEhNmInInstance + _declarationsOpragmas :: (Set.Set Pragma.Pragma) + _declarationsOtopInstanceNmL :: ([HsName]) + _declarationsIeh :: ([EH.Decl]) + _declarationsIerrSq :: ErrSq + _declarationsIgUniq :: UID + _declarationsIgathFixityGam :: FixityGam + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidDefOccGam :: IdDefOccGam + _declarationsIidDpdMp :: IdDpdMp + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsIidTySigDefOccGam :: IdDefOccGam + _declarationsIidUseOccGam :: IdUseOccGam + _declarationsIneedsError :: Bool + _declarationsIpp :: PP_Doc + _declarationsIppWrap :: (PP_Doc -> PP_Doc) + _declarationsItopInstanceNmL :: ([HsName]) + _declarationsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 402, column 9) + _idGam = + gamUnion _declarationsIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 903, column 9) + _sccOrder = + idDpdMp2SccOrder _declarationsIidDefOccGam _declarationsIidDpdMp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 1041, column 29) + (_mkSccLet,_,_errReorder) = + mkIdOccSccEH range_ False _declarationsIidDefOccGam (Just _sccOrder) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 81, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 137, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _declarationsIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 117, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, Seq.fromList _errReorder, _declarationsIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 263, column 9) + _pp = + "let" >#< _declarationsIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 591, column 9) + _lhsOeh = + (EH.mkUnit range_,_mkSccLet) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + _declarationsIgathFixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _declarationsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _declarationsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _declarationsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (from local) + _lhsOidGam = + _idGam + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _declarationsOcaseId = + _lhsIcaseId + -- copy rule (down) + _declarationsOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (from local) + _declarationsOidGam = + _idGam + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _declarationsOpragmas = + _lhsIpragmas + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _declarationsIeh,_declarationsIerrSq,_declarationsIgUniq,_declarationsIgathFixityGam,_declarationsIgathPragmas,_declarationsIidDefOccGam,_declarationsIidDpdMp,_declarationsIidOccDefs,_declarationsIidTySigDefOccGam,_declarationsIidUseOccGam,_declarationsIneedsError,_declarationsIpp,_declarationsIppWrap,_declarationsItopInstanceNmL,_declarationsIundefOccGam) = + declarations_ _declarationsOcaseId _declarationsOfixityGam _declarationsOgUniq _declarationsOgenerDerivMp _declarationsOidGam _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOpatchEhNmInInstance _declarationsOpragmas _declarationsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Statement_Generator :: Range -> + T_Pattern -> + T_Expression -> + T_Statement +sem_Statement_Generator range_ pattern_ expression_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOidGam :: IdDefOccGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOeh :: ((EH.Expr,EH.Expr -> EH.Expr)) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _patternOfixityGam :: FixityGam + _patternOgUniq :: UID + _patternOidGam :: IdDefOccGam + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOopts :: EHCOpts + _patternOpatchEhNmInInstance :: PatchEhNmInInstance + _patternOtopInstanceNmL :: ([HsName]) + _expressionOcaseId :: UID + _expressionOfixityGam :: FixityGam + _expressionOgUniq :: UID + _expressionOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _expressionOidGam :: IdDefOccGam + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOpatchEhNmInInstance :: PatchEhNmInInstance + _expressionOpragmas :: (Set.Set Pragma.Pragma) + _expressionOtopInstanceNmL :: ([HsName]) + _patternIeh :: (EH.PatExpr) + _patternIerrSq :: ErrSq + _patternIgUniq :: UID + _patternIidDefOccGam :: IdDefOccGam + _patternIidOccDefs :: ([IdOcc]) + _patternIidUseOccGam :: IdUseOccGam + _patternIisVar :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternIpp :: PP_Doc + _patternIppWrap :: (PP_Doc -> PP_Doc) + _patternItopInstanceNmL :: ([HsName]) + _patternIundefOccGam :: IdUseOccGam + _expressionIconNm :: Name + _expressionIeh :: (EH.Expr) + _expressionIerrSq :: ErrSq + _expressionIgUniq :: UID + _expressionIidUseOccGam :: IdUseOccGam + _expressionIopChain :: (OpChain EH.Expr) + _expressionIoperatorName :: MaybeName + _expressionIpp :: PP_Doc + _expressionIppWrap :: (PP_Doc -> PP_Doc) + _expressionItopInstanceNmL :: ([HsName]) + _expressionIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 404, column 9) + _lhsOidGam = + gamUnion _patternIidDefOccGam _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 644, column 29) + (_,_refnames,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [hsnMonadBind,hsnMonadFail] IdOcc_Val IdAsp_Val_Var range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 646, column 9) + _lhsOidUseOccGam = + gamUnions [_idUseOccGam,_patternIidUseOccGam,_expressionIidUseOccGam] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 81, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 135, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _patternIidDefOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 121, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, Seq.fromList _errIdUse, _patternIerrSq, _expressionIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 265, column 9) + _pp = + _patternIpp >#< "<-" >#< _expressionIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 593, column 9) + _lhsOeh = + (_expressionIeh + ,ehGenerator + range_ _patternIeh + (\e -> ehExpVarApp range_ (_refnames !! 0) [_expressionIeh,e]) + (EH.mkError' (_refnames !! 1) range_ "monadic bind") + ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternIppWrap . _expressionIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternIundefOccGam `gamUnion` _expressionIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOidGam = + _lhsIidGam + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOopts = + _lhsIopts + -- copy rule (down) + _patternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _expressionOcaseId = + _lhsIcaseId + -- copy rule (down) + _expressionOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _expressionOgUniq = + _patternIgUniq + -- copy rule (down) + _expressionOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _expressionOidGam = + _lhsIidGam + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _expressionOpragmas = + _lhsIpragmas + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIeh,_patternIerrSq,_patternIgUniq,_patternIidDefOccGam,_patternIidOccDefs,_patternIidUseOccGam,_patternIisVar,_patternImbTopRefname,_patternIpp,_patternIppWrap,_patternItopInstanceNmL,_patternIundefOccGam) = + pattern_ _patternOfixityGam _patternOgUniq _patternOidGam _patternOmoduleNm _patternOnmLev _patternOopts _patternOpatchEhNmInInstance _patternOtopInstanceNmL + ( _expressionIconNm,_expressionIeh,_expressionIerrSq,_expressionIgUniq,_expressionIidUseOccGam,_expressionIopChain,_expressionIoperatorName,_expressionIpp,_expressionIppWrap,_expressionItopInstanceNmL,_expressionIundefOccGam) = + expression_ _expressionOcaseId _expressionOfixityGam _expressionOgUniq _expressionOgenerDerivMp _expressionOidGam _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOpatchEhNmInInstance _expressionOpragmas _expressionOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Statement_Empty :: Range -> + T_Statement +sem_Statement_Empty range_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOeh :: ((EH.Expr,EH.Expr -> EH.Expr)) + _lhsOerrSq :: ErrSq + _lhsOgathFixityGam :: FixityGam + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOidGam :: IdDefOccGam + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 600, column 9) + _lhsOeh = + (undefined,id) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 6, column 25) + _lhsOgathFixityGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOidGam = + _lhsIidGam + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOgathFixityGam,_lhsOidGam,_lhsOidUseOccGam,_lhsOnmLev,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Statements -------------------------------------------------- +{- + visit 0: + inherited attributes: + caseId : UID + fixityGam : FixityGam + generDerivMp : Map.Map HsName [(HsName,HsName)] + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + pragmas : Set.Set Pragma.Pragma + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [(EH.Expr,EH.Expr -> EH.Expr)] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Statement + child tl : Statements + visit 0: + local fixityGam : _ + alternative Nil: +-} +-- cata +sem_Statements :: Statements -> + T_Statements +sem_Statements list = + (Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list)) +-- semantic domain +type T_Statements = UID -> + FixityGam -> + UID -> + (Map.Map HsName [(HsName,HsName)]) -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + (Set.Set Pragma.Pragma) -> + ([HsName]) -> + ( ([(EH.Expr,EH.Expr -> EH.Expr)]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Statements_Cons :: T_Statement -> + T_Statements -> + T_Statements +sem_Statements_Cons hd_ tl_ = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.Expr,EH.Expr -> EH.Expr)]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOcaseId :: UID + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOpragmas :: (Set.Set Pragma.Pragma) + _hdOtopInstanceNmL :: ([HsName]) + _tlOcaseId :: UID + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOgenerDerivMp :: (Map.Map HsName [(HsName,HsName)]) + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOpragmas :: (Set.Set Pragma.Pragma) + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: ((EH.Expr,EH.Expr -> EH.Expr)) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIgathFixityGam :: FixityGam + _hdIidGam :: IdDefOccGam + _hdIidUseOccGam :: IdUseOccGam + _hdInmLev :: NmLev + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([(EH.Expr,EH.Expr -> EH.Expr)]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 500, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 39, column 9) + _fixityGam = + _hdIgathFixityGam `gamUnion` _lhsIfixityGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 583, column 26) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOcaseId = + _lhsIcaseId + -- copy rule (from local) + _hdOfixityGam = + _fixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOpragmas = + _lhsIpragmas + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOcaseId = + _lhsIcaseId + -- copy rule (from local) + _tlOfixityGam = + _fixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOgenerDerivMp = + _lhsIgenerDerivMp + -- copy rule (chain) + _tlOidGam = + _hdIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (chain) + _tlOnmLev = + _hdInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOpragmas = + _lhsIpragmas + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIgathFixityGam,_hdIidGam,_hdIidUseOccGam,_hdInmLev,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdIundefOccGam) = + hd_ _hdOcaseId _hdOfixityGam _hdOgUniq _hdOgenerDerivMp _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOpragmas _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOcaseId _tlOfixityGam _tlOgUniq _tlOgenerDerivMp _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOpragmas _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = + (\ _lhsIcaseId + _lhsIfixityGam + _lhsIgUniq + _lhsIgenerDerivMp + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsIpragmas + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([(EH.Expr,EH.Expr -> EH.Expr)]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 502, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 583, column 26) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Strings ----------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [String] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : {String} + child tl : Strings + alternative Nil: +-} +-- cata +sem_Strings :: Strings -> + T_Strings +sem_Strings list = + (Prelude.foldr sem_Strings_Cons sem_Strings_Nil list) +-- semantic domain +type T_Strings = UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([String]),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Strings_Cons :: String -> + T_Strings -> + T_Strings +sem_Strings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([String]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _tlIeh :: ([String]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 918, column 23) + _lhsOeh = + _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _tlOgUniq = + _lhsIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _tlOtopInstanceNmL = + _lhsItopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOgUniq _tlOidGam _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = + (\ _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([String]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 918, column 23) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- Type -------------------------------------------------------- +{- + visit 0: + inherited attributes: + doGenVarWild : Bool + fixityGam : FixityGam + idGam : IdDefOccGam + isAsPred : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conNm : Name + eh : EH.TyExpr + ehMbAsPr : Maybe EH.PrExpr + ehMbAsPrL : [Maybe EH.PrExpr] + ehMbAsTyPr : Maybe EH.TyExpr + ehMbAsTyPrL : [Maybe EH.TyExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + mbRefConNm : Maybe Name + opChain : OpChain EH.TyExpr + operatorName : MaybeName + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + tyConIs : TypeConFixedMeaning + undefOccGam : IdUseOccGam + alternatives: + alternative NormalApplication: + child range : {Range} + child function : Type + child arguments : Types + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + alternative InfixApplication: + child range : {Range} + child leftType : Type + child operator : Type + child rightType : Type + visit 0: + local errSq : _ + local pp : _ + local fgi : _ + local eh : _ + local ctxtFormErrs : _ + local isPredOp : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + alternative InfixApplicationChainTop: + child range : {Range} + child type : Type + visit 0: + local errSq : _ + local ehRearrOpChain : _ + local errRearr : _ + local ehFromOpChain : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + alternative Constructor: + child range : {Range} + child name : {Name} + visit 0: + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local idOccKind : _ + local idAsp : _ + local errSq : _ + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local tyConIs : _ + local isAsPred : _ + alternative Parenthesized: + child range : {Range} + child type : Type + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + alternative SectionApplication: + child range : {Range} + child leftType : MaybeType + child operator : Type + child rightType : MaybeType + visit 0: + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + local lUniq_1_nm : {UID} + alternative Annotate: + child range : {Range} + child annotation : TypeAnnotation + child type : Type + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + alternative Wildcard: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative MonoWildcard: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local idOccKind : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative NamedWildcard: + child range : {Range} + child name : {Name} + visit 0: + local idAsp : _ + local idOccKind : _ + local refname : _ + local idUseOccGam : _ + local errIdUse : _ + local errSq : _ + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative Forall: + child range : {Range} + child typevariables : {Names} + child type : Type + visit 0: + local idDefOccGamInside : _ + local idGam : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative Exists: + child range : {Range} + child typevariables : {Names} + child type : Type + visit 0: + local idDefOccGamInside : _ + local idGam : _ + local nmLev : _ + local errDupIntro : _ + local errSq : _ + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative RowUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative RowEmpty: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative RowRecUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + alternative RowRecEmpty: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative RowSumUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative RowSumEmpty: + child range : {Range} + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative Qualified: + child range : {Range} + child context : ContextItems + child type : Type + visit 0: + local pp : _ + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ + local isAsPred : _ + alternative TupleConstructor: + child range : {Range} + child arity : {Int} + visit 0: + local eh : _ + local ehMbAsPr : _ + local ehMbAsPrL : _ + local ehMbAsTyPr : _ + local ehMbAsTyPrL : _ +-} +-- cata +sem_Type :: Type -> + T_Type +sem_Type (Type_NormalApplication _range _function _arguments) = + (sem_Type_NormalApplication _range (sem_Type _function) (sem_Types _arguments)) +sem_Type (Type_InfixApplication _range _leftType _operator _rightType) = + (sem_Type_InfixApplication _range (sem_Type _leftType) (sem_Type _operator) (sem_Type _rightType)) +sem_Type (Type_InfixApplicationChainTop _range _type) = + (sem_Type_InfixApplicationChainTop _range (sem_Type _type)) +sem_Type (Type_Constructor _range _name) = + (sem_Type_Constructor _range _name) +sem_Type (Type_Parenthesized _range _type) = + (sem_Type_Parenthesized _range (sem_Type _type)) +sem_Type (Type_SectionApplication _range _leftType _operator _rightType) = + (sem_Type_SectionApplication _range (sem_MaybeType _leftType) (sem_Type _operator) (sem_MaybeType _rightType)) +sem_Type (Type_Annotate _range _annotation _type) = + (sem_Type_Annotate _range (sem_TypeAnnotation _annotation) (sem_Type _type)) +sem_Type (Type_Wildcard _range) = + (sem_Type_Wildcard _range) +sem_Type (Type_MonoWildcard _range) = + (sem_Type_MonoWildcard _range) +sem_Type (Type_Variable _range _name) = + (sem_Type_Variable _range _name) +sem_Type (Type_NamedWildcard _range _name) = + (sem_Type_NamedWildcard _range _name) +sem_Type (Type_Forall _range _typevariables _type) = + (sem_Type_Forall _range _typevariables (sem_Type _type)) +sem_Type (Type_Exists _range _typevariables _type) = + (sem_Type_Exists _range _typevariables (sem_Type _type)) +sem_Type (Type_RowUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowEmpty _range) = + (sem_Type_RowEmpty _range) +sem_Type (Type_RowRecUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowRecUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowRecEmpty _range) = + (sem_Type_RowRecEmpty _range) +sem_Type (Type_RowSumUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowSumUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowSumEmpty _range) = + (sem_Type_RowSumEmpty _range) +sem_Type (Type_Qualified _range _context _type) = + (sem_Type_Qualified _range (sem_ContextItems _context) (sem_Type _type)) +sem_Type (Type_TupleConstructor _range _arity) = + (sem_Type_TupleConstructor _range _arity) +-- semantic domain +type T_Type = Bool -> + FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( Name,(EH.TyExpr),(Maybe EH.PrExpr),([Maybe EH.PrExpr]),(Maybe EH.TyExpr),([Maybe EH.TyExpr]),ErrSq,HsNameS,UID,IdUseOccGam,(Maybe Name),(OpChain EH.TyExpr),MaybeName,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),TypeConFixedMeaning,IdUseOccGam) +sem_Type_NormalApplication :: Range -> + T_Type -> + T_Types -> + T_Type +sem_Type_NormalApplication range_ function_ arguments_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _argumentsOisAsPred :: Bool + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOdoGenVarWild :: Bool + _functionOfixityGam :: FixityGam + _functionOgUniq :: UID + _functionOidGam :: IdDefOccGam + _functionOisAsPred :: Bool + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOpatchEhNmInInstance :: PatchEhNmInInstance + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOfixityGam :: FixityGam + _argumentsOgUniq :: UID + _argumentsOidGam :: IdDefOccGam + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOpatchEhNmInInstance :: PatchEhNmInInstance + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIeh :: (EH.TyExpr) + _functionIehMbAsPr :: (Maybe EH.PrExpr) + _functionIehMbAsPrL :: ([Maybe EH.PrExpr]) + _functionIehMbAsTyPr :: (Maybe EH.TyExpr) + _functionIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _functionIerrSq :: ErrSq + _functionIfreeTvarS :: HsNameS + _functionIgUniq :: UID + _functionIidUseOccGam :: IdUseOccGam + _functionImbRefConNm :: (Maybe Name) + _functionIopChain :: (OpChain EH.TyExpr) + _functionIoperatorName :: MaybeName + _functionIpp :: PP_Doc + _functionIppWrap :: (PP_Doc -> PP_Doc) + _functionItopInstanceNmL :: ([HsName]) + _functionItyConIs :: TypeConFixedMeaning + _functionIundefOccGam :: IdUseOccGam + _argumentsIeh :: ([EH.TyExpr]) + _argumentsIerrSq :: ErrSq + _argumentsIfreeTvarS :: HsNameS + _argumentsIgUniq :: UID + _argumentsIidUseOccGam :: IdUseOccGam + _argumentsIpp :: PP_Doc + _argumentsIppL :: ([PP_Doc]) + _argumentsIppWrap :: (PP_Doc -> PP_Doc) + _argumentsItopInstanceNmL :: ([HsName]) + _argumentsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 116, column 9) + _pp = + let f = _functionIpp + in ppAppTop (_functionIconNm, f) + _argumentsIppL (f >#< ppSpaces _argumentsIppL) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 209, column 9) + _eh = + appTopApp (_functionIeh : _argumentsIeh) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 346, column 9) + _ehMbAsPr = + case _functionImbRefConNm of + Just conNm | _lhsIisAsPred + -> Just $ rngLift range_ EH.PrExpr_Class conNm _argumentsIeh + _ -> Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 156, column 9) + _lhsOtyConIs = + _functionItyConIs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 166, column 9) + _argumentsOisAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _functionIerrSq `Seq.union` _argumentsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _functionIfreeTvarS `Set.union` _argumentsIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _functionIidUseOccGam `gamAddGam` _argumentsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _functionIppWrap . _argumentsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _functionIundefOccGam `gamUnion` _argumentsIundefOccGam + -- copy rule (up) + _lhsOconNm = + _functionIconNm + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _functionOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOidGam = + _lhsIidGam + -- copy rule (down) + _functionOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _argumentsOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOidGam = + _lhsIidGam + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (down) + _argumentsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIeh,_functionIehMbAsPr,_functionIehMbAsPrL,_functionIehMbAsTyPr,_functionIehMbAsTyPrL,_functionIerrSq,_functionIfreeTvarS,_functionIgUniq,_functionIidUseOccGam,_functionImbRefConNm,_functionIopChain,_functionIoperatorName,_functionIpp,_functionIppWrap,_functionItopInstanceNmL,_functionItyConIs,_functionIundefOccGam) = + function_ _functionOdoGenVarWild _functionOfixityGam _functionOgUniq _functionOidGam _functionOisAsPred _functionOnmLev _functionOopts _functionOpatchEhNmInInstance _functionOtopInstanceNmL + ( _argumentsIeh,_argumentsIerrSq,_argumentsIfreeTvarS,_argumentsIgUniq,_argumentsIidUseOccGam,_argumentsIpp,_argumentsIppL,_argumentsIppWrap,_argumentsItopInstanceNmL,_argumentsIundefOccGam) = + arguments_ _argumentsOfixityGam _argumentsOgUniq _argumentsOidGam _argumentsOisAsPred _argumentsOnmLev _argumentsOopts _argumentsOpatchEhNmInInstance _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_InfixApplication :: Range -> + T_Type -> + T_Type -> + T_Type -> + T_Type +sem_Type_InfixApplication range_ leftType_ operator_ rightType_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _leftTypeOisAsPred :: Bool + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOdoGenVarWild :: Bool + _leftTypeOfixityGam :: FixityGam + _leftTypeOgUniq :: UID + _leftTypeOidGam :: IdDefOccGam + _leftTypeOnmLev :: NmLev + _leftTypeOopts :: EHCOpts + _leftTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _leftTypeOtopInstanceNmL :: ([HsName]) + _operatorOdoGenVarWild :: Bool + _operatorOfixityGam :: FixityGam + _operatorOgUniq :: UID + _operatorOidGam :: IdDefOccGam + _operatorOisAsPred :: Bool + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOpatchEhNmInInstance :: PatchEhNmInInstance + _operatorOtopInstanceNmL :: ([HsName]) + _rightTypeOdoGenVarWild :: Bool + _rightTypeOfixityGam :: FixityGam + _rightTypeOgUniq :: UID + _rightTypeOidGam :: IdDefOccGam + _rightTypeOisAsPred :: Bool + _rightTypeOnmLev :: NmLev + _rightTypeOopts :: EHCOpts + _rightTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIconNm :: Name + _leftTypeIeh :: (EH.TyExpr) + _leftTypeIehMbAsPr :: (Maybe EH.PrExpr) + _leftTypeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _leftTypeIehMbAsTyPr :: (Maybe EH.TyExpr) + _leftTypeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _leftTypeIerrSq :: ErrSq + _leftTypeIfreeTvarS :: HsNameS + _leftTypeIgUniq :: UID + _leftTypeIidUseOccGam :: IdUseOccGam + _leftTypeImbRefConNm :: (Maybe Name) + _leftTypeIopChain :: (OpChain EH.TyExpr) + _leftTypeIoperatorName :: MaybeName + _leftTypeIpp :: PP_Doc + _leftTypeIppWrap :: (PP_Doc -> PP_Doc) + _leftTypeItopInstanceNmL :: ([HsName]) + _leftTypeItyConIs :: TypeConFixedMeaning + _leftTypeIundefOccGam :: IdUseOccGam + _operatorIconNm :: Name + _operatorIeh :: (EH.TyExpr) + _operatorIehMbAsPr :: (Maybe EH.PrExpr) + _operatorIehMbAsPrL :: ([Maybe EH.PrExpr]) + _operatorIehMbAsTyPr :: (Maybe EH.TyExpr) + _operatorIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _operatorIerrSq :: ErrSq + _operatorIfreeTvarS :: HsNameS + _operatorIgUniq :: UID + _operatorIidUseOccGam :: IdUseOccGam + _operatorImbRefConNm :: (Maybe Name) + _operatorIopChain :: (OpChain EH.TyExpr) + _operatorIoperatorName :: MaybeName + _operatorIpp :: PP_Doc + _operatorIppWrap :: (PP_Doc -> PP_Doc) + _operatorItopInstanceNmL :: ([HsName]) + _operatorItyConIs :: TypeConFixedMeaning + _operatorIundefOccGam :: IdUseOccGam + _rightTypeIconNm :: Name + _rightTypeIeh :: (EH.TyExpr) + _rightTypeIehMbAsPr :: (Maybe EH.PrExpr) + _rightTypeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _rightTypeIehMbAsTyPr :: (Maybe EH.TyExpr) + _rightTypeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _rightTypeIerrSq :: ErrSq + _rightTypeIfreeTvarS :: HsNameS + _rightTypeIgUniq :: UID + _rightTypeIidUseOccGam :: IdUseOccGam + _rightTypeImbRefConNm :: (Maybe Name) + _rightTypeIopChain :: (OpChain EH.TyExpr) + _rightTypeIoperatorName :: MaybeName + _rightTypeIpp :: PP_Doc + _rightTypeIppWrap :: (PP_Doc -> PP_Doc) + _rightTypeItopInstanceNmL :: ([HsName]) + _rightTypeItyConIs :: TypeConFixedMeaning + _rightTypeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 256, column 9) + _lhsOconNm = + _operatorIconNm + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 65, column 9) + _errSq = + Seq.unions [Seq.fromList _ctxtFormErrs, _leftTypeIerrSq, _operatorIerrSq, _rightTypeIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 120, column 9) + _pp = + let args = [_leftTypeIpp,_rightTypeIpp] + o = _operatorIpp + in ppAppTop (_operatorIconNm, o) + args (o >#< ppSpaces args) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 58, column 9) + _fgi = + case _operatorIoperatorName of + Just n + -> fixityGamLookup n _lhsIfixityGam + _ -> defaultFixityGamInfo + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 112, column 9) + _lhsOopChain = + if _isPredOp + then OpChain_Leaf _eh + else + OpChain_Op _operatorIeh _operatorIpp (fgiFixity _fgi) (fgiPrio _fgi) range_ _leftTypeIopChain _rightTypeIopChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 211, column 25) + (_eh,_ctxtFormErrs,_isPredOp) = + if not _lhsIisAsPred && _operatorItyConIs == TyConIsPrArrow + then let t = foldr app1Arr _rightTypeIeh [ pr | (Just pr) <- _leftTypeIehMbAsTyPrL ] + in if all isJust _leftTypeIehMbAsTyPrL + then (t, [] , True ) + else (t, [rngLift range_ Err_MalformedPred _leftTypeIpp] , False) + else (appRngParApp range_ [_operatorIeh,_leftTypeIeh,_rightTypeIeh], [], False) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 353, column 9) + _ehMbAsPr = + case (_leftTypeIehMbAsPr,_rightTypeIehMbAsPr) of + (Just l,Just r) | _operatorItyConIs == TyConIsPrArrow && _lhsIisAsPred + -> Just $ rngLift range_ EH.PrExpr_Arrow l r + (Nothing,Nothing) | _lhsIisAsPred + -> case _operatorItyConIs of + TyConIsPrArrow -> Just $ rngLift range_ EH.PrExpr_Class (fromJust _operatorImbRefConNm) [_leftTypeIeh,_rightTypeIeh] + TyConIsEqTilde -> Just $ rngLift range_ EH.PrExpr_Eq _leftTypeIeh _rightTypeIeh + TyConIsOther -> Just $ rngLift range_ EH.PrExpr_Class (fromJust _operatorImbRefConNm) [_leftTypeIeh,_rightTypeIeh] + _ -> Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 164, column 9) + _leftTypeOisAsPred = + _lhsIisAsPred || _operatorItyConIs == TyConIsPrArrow + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _leftTypeIfreeTvarS `Set.union` _operatorIfreeTvarS `Set.union` _rightTypeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftTypeIidUseOccGam `gamAddGam` _operatorIidUseOccGam `gamAddGam` _rightTypeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftTypeIppWrap . _operatorIppWrap . _rightTypeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftTypeIundefOccGam `gamUnion` _operatorIundefOccGam `gamUnion` _rightTypeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (down) + _leftTypeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _leftTypeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftTypeOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftTypeOidGam = + _lhsIidGam + -- copy rule (down) + _leftTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _leftTypeOopts = + _lhsIopts + -- copy rule (down) + _leftTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _operatorOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _operatorOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _operatorOgUniq = + _leftTypeIgUniq + -- copy rule (down) + _operatorOidGam = + _lhsIidGam + -- copy rule (down) + _operatorOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (down) + _operatorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftTypeItopInstanceNmL + -- copy rule (down) + _rightTypeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _rightTypeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightTypeOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightTypeOidGam = + _lhsIidGam + -- copy rule (down) + _rightTypeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _rightTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _rightTypeOopts = + _lhsIopts + -- copy rule (down) + _rightTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftTypeIconNm,_leftTypeIeh,_leftTypeIehMbAsPr,_leftTypeIehMbAsPrL,_leftTypeIehMbAsTyPr,_leftTypeIehMbAsTyPrL,_leftTypeIerrSq,_leftTypeIfreeTvarS,_leftTypeIgUniq,_leftTypeIidUseOccGam,_leftTypeImbRefConNm,_leftTypeIopChain,_leftTypeIoperatorName,_leftTypeIpp,_leftTypeIppWrap,_leftTypeItopInstanceNmL,_leftTypeItyConIs,_leftTypeIundefOccGam) = + leftType_ _leftTypeOdoGenVarWild _leftTypeOfixityGam _leftTypeOgUniq _leftTypeOidGam _leftTypeOisAsPred _leftTypeOnmLev _leftTypeOopts _leftTypeOpatchEhNmInInstance _leftTypeOtopInstanceNmL + ( _operatorIconNm,_operatorIeh,_operatorIehMbAsPr,_operatorIehMbAsPrL,_operatorIehMbAsTyPr,_operatorIehMbAsTyPrL,_operatorIerrSq,_operatorIfreeTvarS,_operatorIgUniq,_operatorIidUseOccGam,_operatorImbRefConNm,_operatorIopChain,_operatorIoperatorName,_operatorIpp,_operatorIppWrap,_operatorItopInstanceNmL,_operatorItyConIs,_operatorIundefOccGam) = + operator_ _operatorOdoGenVarWild _operatorOfixityGam _operatorOgUniq _operatorOidGam _operatorOisAsPred _operatorOnmLev _operatorOopts _operatorOpatchEhNmInInstance _operatorOtopInstanceNmL + ( _rightTypeIconNm,_rightTypeIeh,_rightTypeIehMbAsPr,_rightTypeIehMbAsPrL,_rightTypeIehMbAsTyPr,_rightTypeIehMbAsTyPrL,_rightTypeIerrSq,_rightTypeIfreeTvarS,_rightTypeIgUniq,_rightTypeIidUseOccGam,_rightTypeImbRefConNm,_rightTypeIopChain,_rightTypeIoperatorName,_rightTypeIpp,_rightTypeIppWrap,_rightTypeItopInstanceNmL,_rightTypeItyConIs,_rightTypeIundefOccGam) = + rightType_ _rightTypeOdoGenVarWild _rightTypeOfixityGam _rightTypeOgUniq _rightTypeOidGam _rightTypeOisAsPred _rightTypeOnmLev _rightTypeOopts _rightTypeOpatchEhNmInInstance _rightTypeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_InfixApplicationChainTop :: Range -> + T_Type -> + T_Type +sem_Type_InfixApplicationChainTop range_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOconNm :: Name + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 67, column 9) + _errSq = + Seq.unions [Seq.fromList _errRearr, _typeIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 122, column 25) + (_ehRearrOpChain,_errRearr) = + opChainReArrange _typeIopChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 122, column 9) + _ehFromOpChain = + unOpChain _ehRearrOpChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 219, column 9) + _eh = + _ehFromOpChain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 363, column 9) + _ehMbAsPr = + _typeIehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _typeIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (up) + _lhsOconNm = + _typeIconNm + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (down) + _typeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Constructor :: Range -> + Name -> + T_Type +sem_Type_Constructor range_ name_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _lhsOtyConIs :: TypeConFixedMeaning + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 581, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] _idOccKind _idAsp range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 597, column 29) + (_idOccKind,_idAsp) = + if _lhsIisAsPred && _tyConIs == TyConIsOther + then (IdOcc_Class,IdAsp_Class_Class) + else (IdOcc_Type,IdAsp_Type_Con) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 254, column 9) + _lhsOconNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 61, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 125, column 9) + _pp = + ppCon name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 50, column 9) + _lhsOoperatorName = + Just _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 229, column 9) + _eh = + rngLift range_ EH.TyExpr_Con _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 136, column 9) + _lhsOmbRefConNm = + Just _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 152, column 9) + _tyConIs = + if hsnIsPrArrow name_ then TyConIsPrArrow + else if hsnIsEqTilde name_ then TyConIsEqTilde + else TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (from local) + _lhsOtyConIs = + _tyConIs + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Parenthesized :: Range -> + T_Type -> + T_Type +sem_Type_Parenthesized range_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 127, column 9) + _pp = + ppParens _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 231, column 9) + _eh = + rngLift range_ EH.TyExpr_Parens _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 363, column 9) + _ehMbAsPr = + _typeIehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 373, column 9) + _ehMbAsPrL = + _typeIehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _typeIehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (down) + _typeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_SectionApplication :: Range -> + T_MaybeType -> + T_Type -> + T_MaybeType -> + T_Type +sem_Type_SectionApplication range_ leftType_ operator_ rightType_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _leftTypeOgUniq :: UID + _lUniq_1_nm :: UID + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOdoGenVarWild :: Bool + _leftTypeOfixityGam :: FixityGam + _leftTypeOidGam :: IdDefOccGam + _leftTypeOnmLev :: NmLev + _leftTypeOopts :: EHCOpts + _leftTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _leftTypeOtopInstanceNmL :: ([HsName]) + _operatorOdoGenVarWild :: Bool + _operatorOfixityGam :: FixityGam + _operatorOgUniq :: UID + _operatorOidGam :: IdDefOccGam + _operatorOisAsPred :: Bool + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOpatchEhNmInInstance :: PatchEhNmInInstance + _operatorOtopInstanceNmL :: ([HsName]) + _rightTypeOdoGenVarWild :: Bool + _rightTypeOfixityGam :: FixityGam + _rightTypeOgUniq :: UID + _rightTypeOidGam :: IdDefOccGam + _rightTypeOnmLev :: NmLev + _rightTypeOopts :: EHCOpts + _rightTypeOpatchEhNmInInstance :: PatchEhNmInInstance + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIeh :: (Maybe EH.TyExpr) + _leftTypeIerrSq :: ErrSq + _leftTypeIfreeTvarS :: HsNameS + _leftTypeIgUniq :: UID + _leftTypeIidUseOccGam :: IdUseOccGam + _leftTypeIpp :: PP_Doc + _leftTypeIppMb :: (Maybe PP_Doc) + _leftTypeIppWrap :: (PP_Doc -> PP_Doc) + _leftTypeItopInstanceNmL :: ([HsName]) + _leftTypeIundefOccGam :: IdUseOccGam + _operatorIconNm :: Name + _operatorIeh :: (EH.TyExpr) + _operatorIehMbAsPr :: (Maybe EH.PrExpr) + _operatorIehMbAsPrL :: ([Maybe EH.PrExpr]) + _operatorIehMbAsTyPr :: (Maybe EH.TyExpr) + _operatorIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _operatorIerrSq :: ErrSq + _operatorIfreeTvarS :: HsNameS + _operatorIgUniq :: UID + _operatorIidUseOccGam :: IdUseOccGam + _operatorImbRefConNm :: (Maybe Name) + _operatorIopChain :: (OpChain EH.TyExpr) + _operatorIoperatorName :: MaybeName + _operatorIpp :: PP_Doc + _operatorIppWrap :: (PP_Doc -> PP_Doc) + _operatorItopInstanceNmL :: ([HsName]) + _operatorItyConIs :: TypeConFixedMeaning + _operatorIundefOccGam :: IdUseOccGam + _rightTypeIeh :: (Maybe EH.TyExpr) + _rightTypeIerrSq :: ErrSq + _rightTypeIfreeTvarS :: HsNameS + _rightTypeIgUniq :: UID + _rightTypeIidUseOccGam :: IdUseOccGam + _rightTypeIpp :: PP_Doc + _rightTypeIppMb :: (Maybe PP_Doc) + _rightTypeIppWrap :: (PP_Doc -> PP_Doc) + _rightTypeItopInstanceNmL :: ([HsName]) + _rightTypeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 221, column 9) + _eh = + ehSection + _lUniq_1_nm range_ + EH.TyExpr_Var + (rngAntilift id) + EH.TyExpr_Lam + _leftTypeIeh _operatorIeh _rightTypeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- -- generated by the unique rule mechanism. + (_leftTypeOgUniq,_lUniq_1_nm) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq_1_nm) -> (__cont,lUniq_1_nm)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftTypeIerrSq `Seq.union` _operatorIerrSq `Seq.union` _rightTypeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _leftTypeIfreeTvarS `Set.union` _operatorIfreeTvarS `Set.union` _rightTypeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftTypeIidUseOccGam `gamAddGam` _operatorIidUseOccGam `gamAddGam` _rightTypeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _leftTypeIpp >-< _operatorIpp >-< _rightTypeIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftTypeIppWrap . _operatorIppWrap . _rightTypeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftTypeIundefOccGam `gamUnion` _operatorIundefOccGam `gamUnion` _rightTypeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (down) + _leftTypeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _leftTypeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _leftTypeOidGam = + _lhsIidGam + -- copy rule (down) + _leftTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _leftTypeOopts = + _lhsIopts + -- copy rule (down) + _leftTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _operatorOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _operatorOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _operatorOgUniq = + _leftTypeIgUniq + -- copy rule (down) + _operatorOidGam = + _lhsIidGam + -- copy rule (from local) + _operatorOisAsPred = + _isAsPred + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (down) + _operatorOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftTypeItopInstanceNmL + -- copy rule (down) + _rightTypeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _rightTypeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rightTypeOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightTypeOidGam = + _lhsIidGam + -- copy rule (down) + _rightTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _rightTypeOopts = + _lhsIopts + -- copy rule (down) + _rightTypeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftTypeIeh,_leftTypeIerrSq,_leftTypeIfreeTvarS,_leftTypeIgUniq,_leftTypeIidUseOccGam,_leftTypeIpp,_leftTypeIppMb,_leftTypeIppWrap,_leftTypeItopInstanceNmL,_leftTypeIundefOccGam) = + leftType_ _leftTypeOdoGenVarWild _leftTypeOfixityGam _leftTypeOgUniq _leftTypeOidGam _leftTypeOnmLev _leftTypeOopts _leftTypeOpatchEhNmInInstance _leftTypeOtopInstanceNmL + ( _operatorIconNm,_operatorIeh,_operatorIehMbAsPr,_operatorIehMbAsPrL,_operatorIehMbAsTyPr,_operatorIehMbAsTyPrL,_operatorIerrSq,_operatorIfreeTvarS,_operatorIgUniq,_operatorIidUseOccGam,_operatorImbRefConNm,_operatorIopChain,_operatorIoperatorName,_operatorIpp,_operatorIppWrap,_operatorItopInstanceNmL,_operatorItyConIs,_operatorIundefOccGam) = + operator_ _operatorOdoGenVarWild _operatorOfixityGam _operatorOgUniq _operatorOidGam _operatorOisAsPred _operatorOnmLev _operatorOopts _operatorOpatchEhNmInInstance _operatorOtopInstanceNmL + ( _rightTypeIeh,_rightTypeIerrSq,_rightTypeIfreeTvarS,_rightTypeIgUniq,_rightTypeIidUseOccGam,_rightTypeIpp,_rightTypeIppMb,_rightTypeIppWrap,_rightTypeItopInstanceNmL,_rightTypeIundefOccGam) = + rightType_ _rightTypeOdoGenVarWild _rightTypeOfixityGam _rightTypeOgUniq _rightTypeOidGam _rightTypeOnmLev _rightTypeOopts _rightTypeOpatchEhNmInInstance _rightTypeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Annotate :: Range -> + T_TypeAnnotation -> + T_Type -> + T_Type +sem_Type_Annotate range_ annotation_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _lhsOtyConIs :: TypeConFixedMeaning + _annotationOfixityGam :: FixityGam + _annotationOgUniq :: UID + _annotationOidGam :: IdDefOccGam + _annotationOnmLev :: NmLev + _annotationOopts :: EHCOpts + _annotationOpatchEhNmInInstance :: PatchEhNmInInstance + _annotationOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _annotationIeh :: (EH.TyExprAnn) + _annotationIerrSq :: ErrSq + _annotationIfreeTvarS :: HsNameS + _annotationIgUniq :: UID + _annotationIidUseOccGam :: IdUseOccGam + _annotationIpp :: PP_Doc + _annotationIppWrap :: (PP_Doc -> PP_Doc) + _annotationItopInstanceNmL :: ([HsName]) + _annotationIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 129, column 9) + _pp = + _annotationIppWrap _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 233, column 17) + _eh = + rngLift range_ EH.TyExpr_Ann _annotationIeh _typeIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 363, column 9) + _ehMbAsPr = + _typeIehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 373, column 9) + _ehMbAsPrL = + _typeIehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _annotationIerrSq `Seq.union` _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _annotationIfreeTvarS `Set.union` _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _annotationIidUseOccGam `gamAddGam` _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _annotationIppWrap . _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _annotationIundefOccGam `gamUnion` _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (up) + _lhsOtyConIs = + _typeItyConIs + -- copy rule (down) + _annotationOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOidGam = + _lhsIidGam + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOopts = + _lhsIopts + -- copy rule (down) + _annotationOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _annotationIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (down) + _typeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIeh,_annotationIerrSq,_annotationIfreeTvarS,_annotationIgUniq,_annotationIidUseOccGam,_annotationIpp,_annotationIppWrap,_annotationItopInstanceNmL,_annotationIundefOccGam) = + annotation_ _annotationOfixityGam _annotationOgUniq _annotationOidGam _annotationOnmLev _annotationOopts _annotationOpatchEhNmInInstance _annotationOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Wildcard :: Range -> + T_Type +sem_Type_Wildcard range_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 131, column 9) + _pp = + pp "..." + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 235, column 9) + _eh = + rngLift range_ EH.TyExpr_Wild + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 385, column 17) + _ehMbAsTyPr = + Just $ rngLift range_ EH.TyExpr_Impls + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 395, column 17) + _ehMbAsTyPrL = + [_ehMbAsTyPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_MonoWildcard :: Range -> + T_Type +sem_Type_MonoWildcard range_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 133, column 9) + _pp = + pp "...." + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 237, column 9) + _eh = + rngLift range_ EH.TyExpr_Mono + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 385, column 17) + _ehMbAsTyPr = + Just $ rngLift range_ EH.TyExpr_Impls + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 395, column 17) + _ehMbAsTyPrL = + [_ehMbAsTyPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Variable :: Range -> + Name -> + T_Type +sem_Type_Variable range_ name_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOfreeTvarS :: HsNameS + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 577, column 9) + _idAsp = + IdAsp_Type_Var + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 577, column 9) + _idOccKind = + IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 581, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] _idOccKind _idAsp range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 61, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 135, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 50, column 9) + _lhsOoperatorName = + Just _refname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 239, column 9) + _eh = + rngLift range_ (if _lhsIdoGenVarWild then EH.TyExpr_VarWild else EH.TyExpr_Var) name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 122, column 9) + _lhsOfreeTvarS = + Set.singleton name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_NamedWildcard :: Range -> + Name -> + T_Type +sem_Type_NamedWildcard range_ name_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOfreeTvarS :: HsNameS + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 577, column 9) + _idAsp = + IdAsp_Type_Var + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 577, column 9) + _idOccKind = + IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 581, column 29) + (_refname,_,_idUseOccGam,_errIdUse) = + mkUseOccGam _lhsIopts _lhsIidGam [name_] _idOccKind _idAsp range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 61, column 9) + _errSq = + Seq.fromList _errIdUse + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 137, column 9) + _pp = + "%" >|< name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 241, column 9) + _eh = + rngLift range_ EH.TyExpr_VarWild name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 122, column 9) + _lhsOfreeTvarS = + Set.singleton name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _idUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Forall :: Range -> + Names -> + T_Type -> + T_Type +sem_Type_Forall range_ typevariables_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOfreeTvarS :: HsNameS + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 242, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _lhsInmLev range_ typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 408, column 9) + _idGam = + gamUnion _idDefOccGamInside _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 33, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 112, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamInside + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 63, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _typeIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 139, column 9) + _pp = + "forall" >#< ppSpaces typevariables_ >#< "." >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 243, column 9) + _eh = + foldr (rngLift range_ EH.TyExpr_Quant tyQu_Forall) _typeIeh typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 351, column 9) + _ehMbAsPr = + foldr (\tv pr -> fmap (rngLift range_ EH.PrExpr_Forall tv) pr) _typeIehMbAsPr typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 124, column 9) + _lhsOfreeTvarS = + _typeIfreeTvarS `Set.difference` Set.fromList typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOidGam = + _idGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Exists :: Range -> + Names -> + T_Type -> + T_Type +sem_Type_Exists range_ typevariables_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOfreeTvarS :: HsNameS + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 242, column 9) + _idDefOccGamInside = + tvarL2IdDefOccGam _lhsInmLev range_ typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 408, column 9) + _idGam = + gamUnion _idDefOccGamInside _lhsIidGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 33, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ExtraChecks.ag"(line 112, column 9) + _errDupIntro = + idDefOccGamCheckDupNames _idDefOccGamInside + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 63, column 9) + _errSq = + Seq.unions [Seq.fromList _errDupIntro, _typeIerrSq] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 141, column 9) + _pp = + "exists" >#< ppSpaces typevariables_ >#< "." >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 245, column 9) + _eh = + foldr (rngLift range_ EH.TyExpr_Quant tyQu_Exists) _typeIeh typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 124, column 9) + _lhsOfreeTvarS = + _typeIfreeTvarS `Set.difference` Set.fromList typevariables_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _errSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOidGam = + _idGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOdoGenVarWild :: Bool + _rowTypeUpdatesOfixityGam :: FixityGam + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOidGam :: IdDefOccGam + _rowTypeUpdatesOisAsPred :: Bool + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOopts :: EHCOpts + _rowTypeUpdatesOpatchEhNmInInstance :: PatchEhNmInInstance + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + _rowTypeUpdatesIeh :: ([EH.TyExpr -> EH.TyExpr]) + _rowTypeUpdatesIehMbAsPrL :: ([Maybe EH.PrExpr]) + _rowTypeUpdatesIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _rowTypeUpdatesIerrSq :: ErrSq + _rowTypeUpdatesIfreeTvarS :: HsNameS + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesIidUseOccGam :: IdUseOccGam + _rowTypeUpdatesIpp :: PP_Doc + _rowTypeUpdatesIppL :: ([PP_Doc]) + _rowTypeUpdatesIppWrap :: (PP_Doc -> PP_Doc) + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 143, column 9) + _pp = + ppAppTop (hsnRow,mkPPAppFun hsnRowEmpty _typeIpp) + _rowTypeUpdatesIppL _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 247, column 9) + _eh = + foldl (flip ($)) _typeIeh _rowTypeUpdatesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq `Seq.union` _rowTypeUpdatesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS `Set.union` _rowTypeUpdatesIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam `gamAddGam` _rowTypeUpdatesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap . _rowTypeUpdatesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam `gamUnion` _rowTypeUpdatesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rowTypeUpdatesOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _rowTypeUpdatesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOidGam = + _lhsIidGam + -- copy rule (from local) + _rowTypeUpdatesOisAsPred = + _isAsPred + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (down) + _rowTypeUpdatesOopts = + _lhsIopts + -- copy rule (down) + _rowTypeUpdatesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + ( _rowTypeUpdatesIeh,_rowTypeUpdatesIehMbAsPrL,_rowTypeUpdatesIehMbAsTyPrL,_rowTypeUpdatesIerrSq,_rowTypeUpdatesIfreeTvarS,_rowTypeUpdatesIgUniq,_rowTypeUpdatesIidUseOccGam,_rowTypeUpdatesIpp,_rowTypeUpdatesIppL,_rowTypeUpdatesIppWrap,_rowTypeUpdatesItopInstanceNmL,_rowTypeUpdatesIundefOccGam) = + rowTypeUpdates_ _rowTypeUpdatesOdoGenVarWild _rowTypeUpdatesOfixityGam _rowTypeUpdatesOgUniq _rowTypeUpdatesOidGam _rowTypeUpdatesOisAsPred _rowTypeUpdatesOnmLev _rowTypeUpdatesOopts _rowTypeUpdatesOpatchEhNmInInstance _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowEmpty :: Range -> + T_Type +sem_Type_RowEmpty range_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 146, column 9) + _pp = + hsnORow >|< hsnCRow + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 249, column 9) + _eh = + rngLift range_ EH.TyExpr_Row (rngLift range_ EH.RowTyExpr_Empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowRecUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowRecUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOdoGenVarWild :: Bool + _rowTypeUpdatesOfixityGam :: FixityGam + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOidGam :: IdDefOccGam + _rowTypeUpdatesOisAsPred :: Bool + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOopts :: EHCOpts + _rowTypeUpdatesOpatchEhNmInInstance :: PatchEhNmInInstance + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + _rowTypeUpdatesIeh :: ([EH.TyExpr -> EH.TyExpr]) + _rowTypeUpdatesIehMbAsPrL :: ([Maybe EH.PrExpr]) + _rowTypeUpdatesIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _rowTypeUpdatesIerrSq :: ErrSq + _rowTypeUpdatesIfreeTvarS :: HsNameS + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesIidUseOccGam :: IdUseOccGam + _rowTypeUpdatesIpp :: PP_Doc + _rowTypeUpdatesIppL :: ([PP_Doc]) + _rowTypeUpdatesIppWrap :: (PP_Doc -> PP_Doc) + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 148, column 9) + _pp = + ppAppTop (hsnRec,mkPPAppFun hsnRowEmpty _typeIpp) + _rowTypeUpdatesIppL _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 251, column 9) + _eh = + foldl (\e u -> appCon1App hsnRec $ u $ ehTyExprArg $ e) _typeIeh _rowTypeUpdatesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 371, column 9) + _ehMbAsPrL = + _rowTypeUpdatesIehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 393, column 9) + _ehMbAsTyPrL = + _rowTypeUpdatesIehMbAsTyPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq `Seq.union` _rowTypeUpdatesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS `Set.union` _rowTypeUpdatesIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam `gamAddGam` _rowTypeUpdatesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap . _rowTypeUpdatesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam `gamUnion` _rowTypeUpdatesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (down) + _typeOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rowTypeUpdatesOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _rowTypeUpdatesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOidGam = + _lhsIidGam + -- copy rule (down) + _rowTypeUpdatesOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (down) + _rowTypeUpdatesOopts = + _lhsIopts + -- copy rule (down) + _rowTypeUpdatesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + ( _rowTypeUpdatesIeh,_rowTypeUpdatesIehMbAsPrL,_rowTypeUpdatesIehMbAsTyPrL,_rowTypeUpdatesIerrSq,_rowTypeUpdatesIfreeTvarS,_rowTypeUpdatesIgUniq,_rowTypeUpdatesIidUseOccGam,_rowTypeUpdatesIpp,_rowTypeUpdatesIppL,_rowTypeUpdatesIppWrap,_rowTypeUpdatesItopInstanceNmL,_rowTypeUpdatesIundefOccGam) = + rowTypeUpdates_ _rowTypeUpdatesOdoGenVarWild _rowTypeUpdatesOfixityGam _rowTypeUpdatesOgUniq _rowTypeUpdatesOidGam _rowTypeUpdatesOisAsPred _rowTypeUpdatesOnmLev _rowTypeUpdatesOopts _rowTypeUpdatesOpatchEhNmInInstance _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowRecEmpty :: Range -> + T_Type +sem_Type_RowRecEmpty range_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 151, column 9) + _pp = + pp hsnRec + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 253, column 9) + _eh = + appCon1App hsnRec $ rngLift range_ EH.TyExpr_Row (rngLift range_ EH.RowTyExpr_Empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowSumUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowSumUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOdoGenVarWild :: Bool + _rowTypeUpdatesOfixityGam :: FixityGam + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOidGam :: IdDefOccGam + _rowTypeUpdatesOisAsPred :: Bool + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOopts :: EHCOpts + _rowTypeUpdatesOpatchEhNmInInstance :: PatchEhNmInInstance + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + _rowTypeUpdatesIeh :: ([EH.TyExpr -> EH.TyExpr]) + _rowTypeUpdatesIehMbAsPrL :: ([Maybe EH.PrExpr]) + _rowTypeUpdatesIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _rowTypeUpdatesIerrSq :: ErrSq + _rowTypeUpdatesIfreeTvarS :: HsNameS + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesIidUseOccGam :: IdUseOccGam + _rowTypeUpdatesIpp :: PP_Doc + _rowTypeUpdatesIppL :: ([PP_Doc]) + _rowTypeUpdatesIppWrap :: (PP_Doc -> PP_Doc) + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 153, column 9) + _pp = + ppAppTop (hsnSum,mkPPAppFun hsnRowEmpty _typeIpp) + _rowTypeUpdatesIppL _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 255, column 9) + _eh = + foldl (\e u -> appCon1App hsnSum $ u $ ehTyExprArg $ e) _typeIeh _rowTypeUpdatesIeh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _typeIerrSq `Seq.union` _rowTypeUpdatesIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _typeIfreeTvarS `Set.union` _rowTypeUpdatesIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _typeIidUseOccGam `gamAddGam` _rowTypeUpdatesIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _typeIppWrap . _rowTypeUpdatesIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _typeIundefOccGam `gamUnion` _rowTypeUpdatesIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _rowTypeUpdatesOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _rowTypeUpdatesOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOidGam = + _lhsIidGam + -- copy rule (from local) + _rowTypeUpdatesOisAsPred = + _isAsPred + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (down) + _rowTypeUpdatesOopts = + _lhsIopts + -- copy rule (down) + _rowTypeUpdatesOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + ( _rowTypeUpdatesIeh,_rowTypeUpdatesIehMbAsPrL,_rowTypeUpdatesIehMbAsTyPrL,_rowTypeUpdatesIerrSq,_rowTypeUpdatesIfreeTvarS,_rowTypeUpdatesIgUniq,_rowTypeUpdatesIidUseOccGam,_rowTypeUpdatesIpp,_rowTypeUpdatesIppL,_rowTypeUpdatesIppWrap,_rowTypeUpdatesItopInstanceNmL,_rowTypeUpdatesIundefOccGam) = + rowTypeUpdates_ _rowTypeUpdatesOdoGenVarWild _rowTypeUpdatesOfixityGam _rowTypeUpdatesOgUniq _rowTypeUpdatesOidGam _rowTypeUpdatesOisAsPred _rowTypeUpdatesOnmLev _rowTypeUpdatesOopts _rowTypeUpdatesOpatchEhNmInInstance _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_RowSumEmpty :: Range -> + T_Type +sem_Type_RowSumEmpty range_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 156, column 9) + _pp = + pp hsnSum + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 257, column 9) + _eh = + appCon1App hsnSum $ rngLift range_ EH.TyExpr_Row (rngLift range_ EH.RowTyExpr_Empty) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_Qualified :: Range -> + T_ContextItems -> + T_Type -> + T_Type +sem_Type_Qualified range_ context_ type_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOfixityGam :: FixityGam + _contextOgUniq :: UID + _contextOidGam :: IdDefOccGam + _contextOnmLev :: NmLev + _contextOopts :: EHCOpts + _contextOpatchEhNmInInstance :: PatchEhNmInInstance + _contextOtopInstanceNmL :: ([HsName]) + _typeOdoGenVarWild :: Bool + _typeOfixityGam :: FixityGam + _typeOgUniq :: UID + _typeOidGam :: IdDefOccGam + _typeOisAsPred :: Bool + _typeOnmLev :: NmLev + _typeOopts :: EHCOpts + _typeOpatchEhNmInInstance :: PatchEhNmInInstance + _typeOtopInstanceNmL :: ([HsName]) + _contextIeh :: ([EH.PrExpr]) + _contextIehTy :: ([EH.TyExpr]) + _contextIerrSq :: ErrSq + _contextIfreeTvarS :: HsNameS + _contextIgUniq :: UID + _contextIidUseOccGam :: IdUseOccGam + _contextIpp :: PP_Doc + _contextIppWrap :: (PP_Doc -> PP_Doc) + _contextItopInstanceNmL :: ([HsName]) + _contextIundefOccGam :: IdUseOccGam + _typeIconNm :: Name + _typeIeh :: (EH.TyExpr) + _typeIehMbAsPr :: (Maybe EH.PrExpr) + _typeIehMbAsPrL :: ([Maybe EH.PrExpr]) + _typeIehMbAsTyPr :: (Maybe EH.TyExpr) + _typeIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _typeIerrSq :: ErrSq + _typeIfreeTvarS :: HsNameS + _typeIgUniq :: UID + _typeIidUseOccGam :: IdUseOccGam + _typeImbRefConNm :: (Maybe Name) + _typeIopChain :: (OpChain EH.TyExpr) + _typeIoperatorName :: MaybeName + _typeIpp :: PP_Doc + _typeIppWrap :: (PP_Doc -> PP_Doc) + _typeItopInstanceNmL :: ([HsName]) + _typeItyConIs :: TypeConFixedMeaning + _typeIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 158, column 9) + _pp = + _contextIpp >#< "=>" >#< _typeIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 259, column 9) + _eh = + foldr app1Arr _typeIeh _contextIehTy + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 169, column 17) + _isAsPred = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _contextIerrSq `Seq.union` _typeIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _contextIfreeTvarS `Set.union` _typeIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _contextIidUseOccGam `gamAddGam` _typeIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _contextIppWrap . _typeIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _contextIundefOccGam `gamUnion` _typeIundefOccGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _contextOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (down) + _contextOidGam = + _lhsIidGam + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOopts = + _lhsIopts + -- copy rule (down) + _contextOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _typeOdoGenVarWild = + _lhsIdoGenVarWild + -- copy rule (down) + _typeOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _typeOgUniq = + _contextIgUniq + -- copy rule (down) + _typeOidGam = + _lhsIidGam + -- copy rule (from local) + _typeOisAsPred = + _isAsPred + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOopts = + _lhsIopts + -- copy rule (down) + _typeOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _typeOtopInstanceNmL = + _contextItopInstanceNmL + ( _contextIeh,_contextIehTy,_contextIerrSq,_contextIfreeTvarS,_contextIgUniq,_contextIidUseOccGam,_contextIpp,_contextIppWrap,_contextItopInstanceNmL,_contextIundefOccGam) = + context_ _contextOfixityGam _contextOgUniq _contextOidGam _contextOnmLev _contextOopts _contextOpatchEhNmInInstance _contextOtopInstanceNmL + ( _typeIconNm,_typeIeh,_typeIehMbAsPr,_typeIehMbAsPrL,_typeIehMbAsTyPr,_typeIehMbAsTyPrL,_typeIerrSq,_typeIfreeTvarS,_typeIgUniq,_typeIidUseOccGam,_typeImbRefConNm,_typeIopChain,_typeIoperatorName,_typeIpp,_typeIppWrap,_typeItopInstanceNmL,_typeItyConIs,_typeIundefOccGam) = + type_ _typeOdoGenVarWild _typeOfixityGam _typeOgUniq _typeOidGam _typeOisAsPred _typeOnmLev _typeOopts _typeOpatchEhNmInInstance _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +sem_Type_TupleConstructor :: Range -> + Int -> + T_Type +sem_Type_TupleConstructor range_ arity_ = + (\ _lhsIdoGenVarWild + _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOoperatorName :: MaybeName + _lhsOopChain :: (OpChain EH.TyExpr) + _lhsOmbRefConNm :: (Maybe Name) + _lhsOtyConIs :: TypeConFixedMeaning + _lhsOehMbAsPrL :: ([Maybe EH.PrExpr]) + _lhsOehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExpr) + _lhsOehMbAsPr :: (Maybe EH.PrExpr) + _lhsOehMbAsTyPr :: (Maybe EH.TyExpr) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 52, column 9) + _lhsOoperatorName = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Fixity.ag"(line 118, column 9) + _lhsOopChain = + OpChain_Leaf _eh + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 261, column 9) + _eh = + ehTupleConstructor range_ arity_ EH.TyExpr_Var (rngAntilift id) + EH.TyExpr_Lam + (\ps r -> r) + (rngAntilift $ \row -> appCon1App hsnRec (rngLift range_ EH.TyExpr_Row row)) + EH.RowTyExpr_Ext EH.RowTyExpr_Empty + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 365, column 9) + _ehMbAsPr = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 375, column 9) + _ehMbAsPrL = + [_ehMbAsPr] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 387, column 17) + _ehMbAsTyPr = + fmap (rngLift range_ EH.TyExpr_Pred) _ehMbAsPr + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 397, column 17) + _ehMbAsTyPrL = + map (fmap (rngLift range_ EH.TyExpr_Pred)) _ehMbAsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 138, column 9) + _lhsOmbRefConNm = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 158, column 9) + _lhsOtyConIs = + TyConIsOther + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 367, column 44) + _lhsOehMbAsPrL = + _ehMbAsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 389, column 46) + _lhsOehMbAsTyPrL = + _ehMbAsTyPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (from local) + _lhsOehMbAsPr = + _ehMbAsPr + -- copy rule (from local) + _lhsOehMbAsTyPr = + _ehMbAsTyPr + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOeh,_lhsOehMbAsPr,_lhsOehMbAsPrL,_lhsOehMbAsTyPr,_lhsOehMbAsTyPrL,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOmbRefConNm,_lhsOopChain,_lhsOoperatorName,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtyConIs,_lhsOundefOccGam))) +-- TypeAnnotation ---------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.TyExprAnn + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Strict: + visit 0: + local ppWrap : _ + local eh : _ + alternative AnnotationName: + child name : {Name} + visit 0: + local eh : _ + alternative AnnotationVar: + child name : {Name} + child var : {Name} + visit 0: + local eh : _ +-} +-- cata +sem_TypeAnnotation :: TypeAnnotation -> + T_TypeAnnotation +sem_TypeAnnotation (TypeAnnotation_Strict) = + (sem_TypeAnnotation_Strict) +sem_TypeAnnotation (TypeAnnotation_AnnotationName _name) = + (sem_TypeAnnotation_AnnotationName _name) +sem_TypeAnnotation (TypeAnnotation_AnnotationVar _name _var) = + (sem_TypeAnnotation_AnnotationVar _name _var) +-- semantic domain +type T_TypeAnnotation = FixityGam -> + UID -> + IdDefOccGam -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.TyExprAnn),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_TypeAnnotation_Strict :: T_TypeAnnotation +sem_TypeAnnotation_Strict = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 376, column 9) + _ppWrap = + \t -> "!" >|< t + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 887, column 9) + _eh = + EH.TyExprAnn_Strictness (Strictness_Strict) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _ppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_TypeAnnotation_AnnotationName :: Name -> + T_TypeAnnotation +sem_TypeAnnotation_AnnotationName name_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 889, column 9) + _eh = + case show name_ of + "strict" -> EH.TyExprAnn_Strictness (Strictness_Strict) + "nonStrict" -> EH.TyExprAnn_Strictness (Strictness_NonStrict) + _ -> EH.TyExprAnn_Empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_TypeAnnotation_AnnotationVar :: Name -> + Name -> + T_TypeAnnotation +sem_TypeAnnotation_AnnotationVar name_ var_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOeh :: (EH.TyExprAnn) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 894, column 9) + _eh = + case show name_ of + "strictness" -> EH.TyExprAnn_Strictness (Strictness_Var var_) + _ -> EH.TyExprAnn_Empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (from local) + _lhsOeh = + _eh + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +-- TypeLeftHandSide -------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.TyVar] + errSq : ErrSq + freeTvarS : HsNameS + idDefOccGam : IdDefOccGam + idOccDefs : [IdOcc] + idUseOccGam : IdUseOccGam + name : Name + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + range : Range + typevariables : Names + undefOccGam : IdUseOccGam + alternatives: + alternative Function: + child range : {Range} + child name : {Name} + child patterns : TypePatterns + visit 0: + local pp : _ + alternative Infix: + child range : {Range} + child leftPattern : TypePattern + child operator : {Name} + child rightPattern : TypePattern + visit 0: + local pp : _ + alternative Parenthesized: + child range : {Range} + child lefthandside : TypeLeftHandSide + child patterns : TypePatterns + visit 0: + local pp : _ +-} +-- cata +sem_TypeLeftHandSide :: TypeLeftHandSide -> + T_TypeLeftHandSide +sem_TypeLeftHandSide (TypeLeftHandSide_Function _range _name _patterns) = + (sem_TypeLeftHandSide_Function _range _name (sem_TypePatterns _patterns)) +sem_TypeLeftHandSide (TypeLeftHandSide_Infix _range _leftPattern _operator _rightPattern) = + (sem_TypeLeftHandSide_Infix _range (sem_TypePattern _leftPattern) _operator (sem_TypePattern _rightPattern)) +sem_TypeLeftHandSide (TypeLeftHandSide_Parenthesized _range _lefthandside _patterns) = + (sem_TypeLeftHandSide_Parenthesized _range (sem_TypeLeftHandSide _lefthandside) (sem_TypePatterns _patterns)) +-- semantic domain +type T_TypeLeftHandSide = FixityGam -> + UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.TyVar]),ErrSq,HsNameS,UID,IdDefOccGam,([IdOcc]),IdUseOccGam,Name,PP_Doc,(PP_Doc -> PP_Doc),Range,([HsName]),Names,IdUseOccGam) +sem_TypeLeftHandSide_Function :: Range -> + Name -> + T_TypePatterns -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Function range_ name_ patterns_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOrange :: Range + _lhsOname :: Name + _lhsOeh :: ([EH.TyVar]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtypevariables :: Names + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIeh :: ([EH.TyVar]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsItypevariables :: Names + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 205, column 9) + _lhsOrange = + range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 205, column 9) + _lhsOname = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 333, column 9) + _pp = + name_ >#< ppSpaces _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 773, column 9) + _lhsOeh = + rngLift range_ EH.TyVar_Var name_ : _patternsIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _patternsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _patternsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _patternsItypevariables + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsItypevariables,_patternsIundefOccGam) = + patterns_ _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOname,_lhsOpp,_lhsOppWrap,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +sem_TypeLeftHandSide_Infix :: Range -> + T_TypePattern -> + Name -> + T_TypePattern -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOrange :: Range + _lhsOname :: Name + _lhsOeh :: ([EH.TyVar]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtypevariables :: Names + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOgUniq :: UID + _leftPatternOidGam :: IdDefOccGam + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOopts :: EHCOpts + _leftPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOgUniq :: UID + _rightPatternOidGam :: IdDefOccGam + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOopts :: EHCOpts + _rightPatternOpatchEhNmInInstance :: PatchEhNmInInstance + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIeh :: (EH.TyVar) + _leftPatternIerrSq :: ErrSq + _leftPatternIgUniq :: UID + _leftPatternIidUseOccGam :: IdUseOccGam + _leftPatternIpp :: PP_Doc + _leftPatternIppWrap :: (PP_Doc -> PP_Doc) + _leftPatternItopInstanceNmL :: ([HsName]) + _leftPatternItypevariables :: Names + _leftPatternIundefOccGam :: IdUseOccGam + _rightPatternIeh :: (EH.TyVar) + _rightPatternIerrSq :: ErrSq + _rightPatternIgUniq :: UID + _rightPatternIidUseOccGam :: IdUseOccGam + _rightPatternIpp :: PP_Doc + _rightPatternIppWrap :: (PP_Doc -> PP_Doc) + _rightPatternItopInstanceNmL :: ([HsName]) + _rightPatternItypevariables :: Names + _rightPatternIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 208, column 9) + _lhsOrange = + range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 208, column 9) + _lhsOname = + operator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 335, column 9) + _pp = + _leftPatternIpp >#< operator_ >#< _rightPatternIpp + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 775, column 9) + _lhsOeh = + [ rngLift range_ EH.TyVar_Var operator_ + , _leftPatternIeh + , _rightPatternIeh + ] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _leftPatternIerrSq `Seq.union` _rightPatternIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _leftPatternIidUseOccGam `gamAddGam` _rightPatternIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _leftPatternIppWrap . _rightPatternIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _leftPatternItypevariables ++ _rightPatternItypevariables + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _leftPatternIundefOccGam `gamUnion` _rightPatternIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOidGam = + _lhsIidGam + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOopts = + _lhsIopts + -- copy rule (down) + _leftPatternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOidGam = + _lhsIidGam + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _rightPatternOopts = + _lhsIopts + -- copy rule (down) + _rightPatternOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIeh,_leftPatternIerrSq,_leftPatternIgUniq,_leftPatternIidUseOccGam,_leftPatternIpp,_leftPatternIppWrap,_leftPatternItopInstanceNmL,_leftPatternItypevariables,_leftPatternIundefOccGam) = + leftPattern_ _leftPatternOgUniq _leftPatternOidGam _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOopts _leftPatternOpatchEhNmInInstance _leftPatternOtopInstanceNmL + ( _rightPatternIeh,_rightPatternIerrSq,_rightPatternIgUniq,_rightPatternIidUseOccGam,_rightPatternIpp,_rightPatternIppWrap,_rightPatternItopInstanceNmL,_rightPatternItypevariables,_rightPatternIundefOccGam) = + rightPattern_ _rightPatternOgUniq _rightPatternOidGam _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOopts _rightPatternOpatchEhNmInInstance _rightPatternOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOname,_lhsOpp,_lhsOppWrap,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +sem_TypeLeftHandSide_Parenthesized :: Range -> + T_TypeLeftHandSide -> + T_TypePatterns -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Parenthesized range_ lefthandside_ patterns_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOeh :: ([EH.TyVar]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidDefOccGam :: IdDefOccGam + _lhsOidOccDefs :: ([IdOcc]) + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtypevariables :: Names + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOname :: Name + _lhsOrange :: Range + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOfixityGam :: FixityGam + _lefthandsideOgUniq :: UID + _lefthandsideOidGam :: IdDefOccGam + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOpatchEhNmInInstance :: PatchEhNmInInstance + _lefthandsideOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOidGam :: IdDefOccGam + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOopts :: EHCOpts + _patternsOpatchEhNmInInstance :: PatchEhNmInInstance + _patternsOtopInstanceNmL :: ([HsName]) + _lefthandsideIeh :: ([EH.TyVar]) + _lefthandsideIerrSq :: ErrSq + _lefthandsideIfreeTvarS :: HsNameS + _lefthandsideIgUniq :: UID + _lefthandsideIidDefOccGam :: IdDefOccGam + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideIidUseOccGam :: IdUseOccGam + _lefthandsideIname :: Name + _lefthandsideIpp :: PP_Doc + _lefthandsideIppWrap :: (PP_Doc -> PP_Doc) + _lefthandsideIrange :: Range + _lefthandsideItopInstanceNmL :: ([HsName]) + _lefthandsideItypevariables :: Names + _lefthandsideIundefOccGam :: IdUseOccGam + _patternsIeh :: ([EH.TyVar]) + _patternsIerrSq :: ErrSq + _patternsIgUniq :: UID + _patternsIidUseOccGam :: IdUseOccGam + _patternsIpp :: PP_Doc + _patternsIppL :: ([PP_Doc]) + _patternsIppWrap :: (PP_Doc -> PP_Doc) + _patternsItopInstanceNmL :: ([HsName]) + _patternsItypevariables :: Names + _patternsIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 337, column 9) + _pp = + ppParens _lefthandsideIpp >#< ppSpaces _patternsIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 780, column 9) + _lhsOeh = + _lefthandsideIeh ++ _patternsIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _lefthandsideIerrSq `Seq.union` _patternsIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _lefthandsideIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 129, column 23) + _lhsOidDefOccGam = + _lefthandsideIidDefOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _lefthandsideIidUseOccGam `gamAddGam` _patternsIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _lefthandsideIppWrap . _patternsIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _lefthandsideItypevariables ++ _patternsItypevariables + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _lefthandsideIundefOccGam `gamUnion` _patternsIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOname = + _lefthandsideIname + -- copy rule (up) + _lhsOrange = + _lefthandsideIrange + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _lefthandsideOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOidGam = + _lhsIidGam + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _patternsOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _patternsOidGam = + _lhsIidGam + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOopts = + _lhsIopts + -- copy rule (down) + _patternsOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _patternsOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIeh,_lefthandsideIerrSq,_lefthandsideIfreeTvarS,_lefthandsideIgUniq,_lefthandsideIidDefOccGam,_lefthandsideIidOccDefs,_lefthandsideIidUseOccGam,_lefthandsideIname,_lefthandsideIpp,_lefthandsideIppWrap,_lefthandsideIrange,_lefthandsideItopInstanceNmL,_lefthandsideItypevariables,_lefthandsideIundefOccGam) = + lefthandside_ _lefthandsideOfixityGam _lefthandsideOgUniq _lefthandsideOidGam _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOopts _lefthandsideOpatchEhNmInInstance _lefthandsideOtopInstanceNmL + ( _patternsIeh,_patternsIerrSq,_patternsIgUniq,_patternsIidUseOccGam,_patternsIpp,_patternsIppL,_patternsIppWrap,_patternsItopInstanceNmL,_patternsItypevariables,_patternsIundefOccGam) = + patterns_ _patternsOgUniq _patternsOidGam _patternsOmoduleNm _patternsOnmLev _patternsOopts _patternsOpatchEhNmInInstance _patternsOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidDefOccGam,_lhsOidOccDefs,_lhsOidUseOccGam,_lhsOname,_lhsOpp,_lhsOppWrap,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +-- TypePattern ------------------------------------------------- +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : EH.TyVar + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppWrap : PP_Doc -> PP_Doc + typevariables : Names + undefOccGam : IdUseOccGam + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local refname : _ + local pp : _ +-} +-- cata +sem_TypePattern :: TypePattern -> + T_TypePattern +sem_TypePattern (TypePattern_Variable _range _name) = + (sem_TypePattern_Variable _range _name) +-- semantic domain +type T_TypePattern = UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( (EH.TyVar),ErrSq,UID,IdUseOccGam,PP_Doc,(PP_Doc -> PP_Doc),([HsName]),Names,IdUseOccGam) +sem_TypePattern_Variable :: Range -> + Name -> + T_TypePattern +sem_TypePattern_Variable range_ name_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOtypevariables :: Names + _lhsOeh :: (EH.TyVar) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 58, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 213, column 9) + _lhsOtypevariables = + [name_] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 380, column 9) + _pp = + pp name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 860, column 9) + _lhsOeh = + rngLift range_ EH.TyVar_Var _refname + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _pp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +-- TypePatterns ------------------------------------------------ +{- + visit 0: + inherited attributes: + idGam : IdDefOccGam + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.TyVar] + errSq : ErrSq + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + typevariables : Names + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : TypePattern + child tl : TypePatterns + alternative Nil: +-} +-- cata +sem_TypePatterns :: TypePatterns -> + T_TypePatterns +sem_TypePatterns list = + (Prelude.foldr sem_TypePatterns_Cons sem_TypePatterns_Nil (Prelude.map sem_TypePattern list)) +-- semantic domain +type T_TypePatterns = UID -> + IdDefOccGam -> + HsName -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.TyVar]),ErrSq,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),Names,IdUseOccGam) +sem_TypePatterns_Cons :: T_TypePattern -> + T_TypePatterns -> + T_TypePatterns +sem_TypePatterns_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyVar]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtypevariables :: Names + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIeh :: (EH.TyVar) + _hdIerrSq :: ErrSq + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdItypevariables :: Names + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.TyVar]) + _tlIerrSq :: ErrSq + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlItypevariables :: Names + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 440, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 854, column 28) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _hdItypevariables ++ _tlItypevariables + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIeh,_hdIerrSq,_hdIgUniq,_hdIidUseOccGam,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdItypevariables,_hdIundefOccGam) = + hd_ _hdOgUniq _hdOidGam _hdOmoduleNm _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlItypevariables,_tlIundefOccGam) = + tl_ _tlOgUniq _tlOidGam _tlOmoduleNm _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +sem_TypePatterns_Nil :: T_TypePatterns +sem_TypePatterns_Nil = + (\ _lhsIgUniq + _lhsIidGam + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyVar]) + _lhsOerrSq :: ErrSq + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOtypevariables :: Names + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 442, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 854, column 28) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOtypevariables,_lhsOundefOccGam))) +-- Types ------------------------------------------------------- +{- + visit 0: + inherited attributes: + fixityGam : FixityGam + idGam : IdDefOccGam + isAsPred : Bool + nmLev : NmLev + opts : EHCOpts + patchEhNmInInstance : PatchEhNmInInstance + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + eh : [EH.TyExpr] + errSq : ErrSq + freeTvarS : HsNameS + idUseOccGam : IdUseOccGam + pp : PP_Doc + ppL : [PP_Doc] + ppWrap : PP_Doc -> PP_Doc + undefOccGam : IdUseOccGam + alternatives: + alternative Cons: + child hd : Type + child tl : Types + visit 0: + local doGenVarWild : _ + alternative Nil: +-} +-- cata +sem_Types :: Types -> + T_Types +sem_Types list = + (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) +-- semantic domain +type T_Types = FixityGam -> + UID -> + IdDefOccGam -> + Bool -> + NmLev -> + EHCOpts -> + PatchEhNmInInstance -> + ([HsName]) -> + ( ([EH.TyExpr]),ErrSq,HsNameS,UID,IdUseOccGam,PP_Doc,([PP_Doc]),(PP_Doc -> PP_Doc),([HsName]),IdUseOccGam) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons hd_ tl_ = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOdoGenVarWild :: Bool + _hdOfixityGam :: FixityGam + _hdOgUniq :: UID + _hdOidGam :: IdDefOccGam + _hdOisAsPred :: Bool + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOpatchEhNmInInstance :: PatchEhNmInInstance + _hdOtopInstanceNmL :: ([HsName]) + _tlOfixityGam :: FixityGam + _tlOgUniq :: UID + _tlOidGam :: IdDefOccGam + _tlOisAsPred :: Bool + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOpatchEhNmInInstance :: PatchEhNmInInstance + _tlOtopInstanceNmL :: ([HsName]) + _hdIconNm :: Name + _hdIeh :: (EH.TyExpr) + _hdIehMbAsPr :: (Maybe EH.PrExpr) + _hdIehMbAsPrL :: ([Maybe EH.PrExpr]) + _hdIehMbAsTyPr :: (Maybe EH.TyExpr) + _hdIehMbAsTyPrL :: ([Maybe EH.TyExpr]) + _hdIerrSq :: ErrSq + _hdIfreeTvarS :: HsNameS + _hdIgUniq :: UID + _hdIidUseOccGam :: IdUseOccGam + _hdImbRefConNm :: (Maybe Name) + _hdIopChain :: (OpChain EH.TyExpr) + _hdIoperatorName :: MaybeName + _hdIpp :: PP_Doc + _hdIppWrap :: (PP_Doc -> PP_Doc) + _hdItopInstanceNmL :: ([HsName]) + _hdItyConIs :: TypeConFixedMeaning + _hdIundefOccGam :: IdUseOccGam + _tlIeh :: ([EH.TyExpr]) + _tlIerrSq :: ErrSq + _tlIfreeTvarS :: HsNameS + _tlIgUniq :: UID + _tlIidUseOccGam :: IdUseOccGam + _tlIpp :: PP_Doc + _tlIppL :: ([PP_Doc]) + _tlIppWrap :: (PP_Doc -> PP_Doc) + _tlItopInstanceNmL :: ([HsName]) + _tlIundefOccGam :: IdUseOccGam + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 414, column 9) + _lhsOppL = + _hdIpp : _tlIppL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 210, column 9) + _doGenVarWild = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 197, column 21) + _lhsOeh = + _hdIeh : _tlIeh + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + _hdIerrSq `Seq.union` _tlIerrSq + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + _hdIfreeTvarS `Set.union` _tlIfreeTvarS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + _hdIidUseOccGam `gamAddGam` _tlIidUseOccGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + _hdIpp >-< _tlIpp + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + _hdIppWrap . _tlIppWrap + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + _hdIundefOccGam `gamUnion` _tlIundefOccGam + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (from local) + _hdOdoGenVarWild = + _doGenVarWild + -- copy rule (down) + _hdOfixityGam = + _lhsIfixityGam + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOidGam = + _lhsIidGam + -- copy rule (down) + _hdOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (down) + _tlOfixityGam = + _lhsIfixityGam + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOidGam = + _lhsIidGam + -- copy rule (down) + _tlOisAsPred = + _lhsIisAsPred + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (down) + _tlOpatchEhNmInInstance = + _lhsIpatchEhNmInInstance + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconNm,_hdIeh,_hdIehMbAsPr,_hdIehMbAsPrL,_hdIehMbAsTyPr,_hdIehMbAsTyPrL,_hdIerrSq,_hdIfreeTvarS,_hdIgUniq,_hdIidUseOccGam,_hdImbRefConNm,_hdIopChain,_hdIoperatorName,_hdIpp,_hdIppWrap,_hdItopInstanceNmL,_hdItyConIs,_hdIundefOccGam) = + hd_ _hdOdoGenVarWild _hdOfixityGam _hdOgUniq _hdOidGam _hdOisAsPred _hdOnmLev _hdOopts _hdOpatchEhNmInInstance _hdOtopInstanceNmL + ( _tlIeh,_tlIerrSq,_tlIfreeTvarS,_tlIgUniq,_tlIidUseOccGam,_tlIpp,_tlIppL,_tlIppWrap,_tlItopInstanceNmL,_tlIundefOccGam) = + tl_ _tlOfixityGam _tlOgUniq _tlOidGam _tlOisAsPred _tlOnmLev _tlOopts _tlOpatchEhNmInInstance _tlOtopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (\ _lhsIfixityGam + _lhsIgUniq + _lhsIidGam + _lhsIisAsPred + _lhsInmLev + _lhsIopts + _lhsIpatchEhNmInInstance + _lhsItopInstanceNmL -> + (let _lhsOppL :: ([PP_Doc]) + _lhsOeh :: ([EH.TyExpr]) + _lhsOerrSq :: ErrSq + _lhsOfreeTvarS :: HsNameS + _lhsOidUseOccGam :: IdUseOccGam + _lhsOpp :: PP_Doc + _lhsOppWrap :: (PP_Doc -> PP_Doc) + _lhsOundefOccGam :: IdUseOccGam + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 416, column 9) + _lhsOppL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ToEH.ag"(line 197, column 21) + _lhsOeh = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/GatherError.ag"(line 1, column 30) + _lhsOerrSq = + Seq.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/MainAG.ag"(line 118, column 21) + _lhsOfreeTvarS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 471, column 30) + _lhsOidUseOccGam = + emptyGam + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 1, column 27) + _lhsOpp = + empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pretty.ag"(line 3, column 31) + _lhsOppWrap = + const empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameAnalysis.ag"(line 729, column 30) + _lhsOundefOccGam = + emptyGam + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOeh,_lhsOerrSq,_lhsOfreeTvarS,_lhsOgUniq,_lhsOidUseOccGam,_lhsOpp,_lhsOppL,_lhsOppWrap,_lhsOtopInstanceNmL,_lhsOundefOccGam))) diff --git a/src/UHC/Light/Compiler/HS/ModImpExp.hs b/src/UHC/Light/Compiler/HS/ModImpExp.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/HS/ModImpExp.hs @@ -0,0 +1,14415 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.a) +module UHC.Light.Compiler.HS.ModImpExp(Inh_AGItf (..), Syn_AGItf (..), sem_AGItf, wrap_AGItf) where + +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.HS +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.NameAspect +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import qualified UHC.Util.Rel as Rel +import UHC.Light.Compiler.Module.ImportExport +import UHC.Light.Compiler.Base.Debug as Debug +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Target +import qualified UHC.Light.Compiler.Base.Pragma as Pragma + + +mkInstDefsRel :: Bool -> HsName -> Maybe HsName -> IdOcc -> IdOcc -> (ModEntRel,ModEntRel) +mkInstDefsRel useimplicitly instancename maybeinstancename idOccDef idOccDefVal + = ( (if useimplicitly then i else Rel.empty) + `Rel.union` + maybe (Rel.empty) (const v) maybeinstancename + , v + ) + where v = Rel.singleton instancename (ModEnt IdOcc_Val idOccDefVal Set.empty emptyRange) + i = Rel.singleton instancename (ModEnt IdOcc_Inst idOccDef Set.empty emptyRange) + + + + + + + + + + + + + + + +-- AGItf ------------------------------------------------------- +{- + visit 0: + inherited attributes: + gUniq : UID + moduleNm : HsName + opts : EHCOpts + synthesized attributes: + fileHeaderPragmas : Set.Set Pragma.Pragma + mainValExists : Bool + mod : Mod + modImpNmS : Set.Set HsName + realModuleNm : HsName + alternatives: + alternative AGItf: + child module : Module + visit 0: + local nmLev : _ + local topInstanceNmL : _ +-} +-- cata +sem_AGItf :: AGItf -> + T_AGItf +sem_AGItf (AGItf_AGItf _module) = + (sem_AGItf_AGItf (sem_Module _module)) +-- semantic domain +type T_AGItf = UID -> + HsName -> + EHCOpts -> + ( (Set.Set Pragma.Pragma),Bool,Mod,(Set.Set HsName),HsName) +data Inh_AGItf = Inh_AGItf {gUniq_Inh_AGItf :: !(UID),moduleNm_Inh_AGItf :: !(HsName),opts_Inh_AGItf :: !(EHCOpts)} +data Syn_AGItf = Syn_AGItf {fileHeaderPragmas_Syn_AGItf :: !((Set.Set Pragma.Pragma)),mainValExists_Syn_AGItf :: !(Bool),mod_Syn_AGItf :: !(Mod),modImpNmS_Syn_AGItf :: !((Set.Set HsName)),realModuleNm_Syn_AGItf :: !(HsName)} +wrap_AGItf :: T_AGItf -> + Inh_AGItf -> + Syn_AGItf +wrap_AGItf sem (Inh_AGItf _lhsIgUniq _lhsImoduleNm _lhsIopts) = + (let ( _lhsOfileHeaderPragmas,_lhsOmainValExists,_lhsOmod,_lhsOmodImpNmS,_lhsOrealModuleNm) | True = sem _lhsIgUniq _lhsImoduleNm _lhsIopts + in (Syn_AGItf _lhsOfileHeaderPragmas _lhsOmainValExists _lhsOmod _lhsOmodImpNmS _lhsOrealModuleNm)) +sem_AGItf_AGItf :: T_Module -> + T_AGItf +sem_AGItf_AGItf module_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsIopts -> + (let _lhsOfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _lhsOmainValExists :: Bool + _lhsOmod :: Mod + _lhsOmodImpNmS :: (Set.Set HsName) + _lhsOrealModuleNm :: HsName + _moduleOgUniq :: UID + _moduleOmoduleNm :: HsName + _moduleOnmLev :: NmLev + _moduleOopts :: EHCOpts + _moduleOtopInstanceNmL :: ([HsName]) + _moduleIfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _moduleIgUniq :: UID + _moduleImainValExists :: Bool + _moduleImod :: Mod + _moduleImodImpNmS :: (Set.Set HsName) + _moduleIrealModuleNm :: HsName + _moduleItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 13, column 9) + _nmLev = + nmLevModule + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 55, column 9) + _topInstanceNmL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 2, column 43) + _lhsOfileHeaderPragmas = + _moduleIfileHeaderPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _moduleImainValExists + -- copy rule (up) + _lhsOmod = + _moduleImod + -- copy rule (up) + _lhsOmodImpNmS = + _moduleImodImpNmS + -- copy rule (up) + _lhsOrealModuleNm = + _moduleIrealModuleNm + -- copy rule (down) + _moduleOgUniq = + _lhsIgUniq + -- copy rule (down) + _moduleOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _moduleOnmLev = + _nmLev + -- copy rule (down) + _moduleOopts = + _lhsIopts + -- copy rule (from local) + _moduleOtopInstanceNmL = + _topInstanceNmL + ( _moduleIfileHeaderPragmas,_moduleIgUniq,_moduleImainValExists,_moduleImod,_moduleImodImpNmS,_moduleIrealModuleNm,_moduleItopInstanceNmL) | True = + module_ _moduleOgUniq _moduleOmoduleNm _moduleOnmLev _moduleOopts _moduleOtopInstanceNmL + in ( _lhsOfileHeaderPragmas,_lhsOmainValExists,_lhsOmod,_lhsOmodImpNmS,_lhsOrealModuleNm))) +-- Alternative ------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Alternative: + child range : {Range} + child pattern : Pattern + child righthandside : RightHandSide + visit 0: + local nmLev : _ + alternative Empty: + child range : {Range} +-} +-- cata +sem_Alternative :: Alternative -> + T_Alternative +sem_Alternative (Alternative_Alternative _range _pattern _righthandside) = + (sem_Alternative_Alternative _range (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Alternative (Alternative_Empty _range) = + (sem_Alternative_Empty _range) +-- semantic domain +type T_Alternative = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_Alternative_Alternative :: Range -> + T_Pattern -> + T_RightHandSide -> + T_Alternative +sem_Alternative_Alternative range_ pattern_ righthandside_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _righthandsideOgUniq :: UID + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _righthandsideIgUniq :: UID + _righthandsideItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 73, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _righthandsideOgUniq = + _patternIgUniq + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _righthandsideOnmLev = + _nmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _righthandsideIgUniq,_righthandsideItopInstanceNmL) | True = + righthandside_ _righthandsideOgUniq _righthandsideOmoduleNm _righthandsideOnmLev _righthandsideOopts _righthandsideOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Alternative_Empty :: Range -> + T_Alternative +sem_Alternative_Empty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Alternatives ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Alternative + child tl : Alternatives + alternative Nil: +-} +-- cata +sem_Alternatives :: Alternatives -> + T_Alternatives +sem_Alternatives list = + (Prelude.foldr sem_Alternatives_Cons sem_Alternatives_Nil (Prelude.map sem_Alternative list)) +-- semantic domain +type T_Alternatives = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_Alternatives_Cons :: T_Alternative -> + T_Alternatives -> + T_Alternatives +sem_Alternatives_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Alternatives_Nil :: T_Alternatives +sem_Alternatives_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Body -------------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + extraModImpL : [ModImp] + mainValExists : Bool + modDefsRel : ModEntRel + modHideDefsRel : ModEntRel + modImpL : [ModImp] + alternatives: + alternative Body: + child range : {Range} + child importdeclarations : ImportDeclarations + child declarations : Declarations + visit 0: + local refmainname : _ + local idOccDefMain : _ + local extraModImpL : _ +-} +-- cata +sem_Body :: Body -> + T_Body +sem_Body (Body_Body _range _importdeclarations _declarations) = + (sem_Body_Body _range (sem_ImportDeclarations _importdeclarations) (sem_Declarations _declarations)) +-- semantic domain +type T_Body = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( ([ModImp]),UID,Bool,ModEntRel,ModEntRel,([ModImp]),([HsName])) +sem_Body_Body :: Range -> + T_ImportDeclarations -> + T_Declarations -> + T_Body +sem_Body_Body range_ importdeclarations_ declarations_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOmodImpL :: ([ModImp]) + _lhsOextraModImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _importdeclarationsOgUniq :: UID + _importdeclarationsOmoduleNm :: HsName + _importdeclarationsOnmLev :: NmLev + _importdeclarationsOopts :: EHCOpts + _importdeclarationsOtopInstanceNmL :: ([HsName]) + _declarationsOgUniq :: UID + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOtopInstanceNmL :: ([HsName]) + _importdeclarationsIgUniq :: UID + _importdeclarationsImodImpL :: ([ModImp]) + _importdeclarationsItopInstanceNmL :: ([HsName]) + _declarationsIgUniq :: UID + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsImainValExists :: Bool + _declarationsImodDefsRel :: ModEntRel + _declarationsImodHideDefsRel :: ModEntRel + _declarationsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 8, column 9) + _refmainname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm hsnMain + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 188, column 9) + _idOccDefMain = + IdOcc hsnMain IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 271, column 9) + _extraModImpL = + if ehcOptOverloadedStrings _lhsIopts + then [ModImp True hsnModDataString hsnModDataString False [ModEntSpec (hsnQualified hsnDataStringFromString) range_ Nothing] range_] + else [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _declarationsImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + _declarationsImodDefsRel + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _declarationsImodHideDefsRel + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 35, column 46) + _lhsOmodImpL = + _importdeclarationsImodImpL + -- copy rule (from local) + _lhsOextraModImpL = + _extraModImpL + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _importdeclarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _importdeclarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importdeclarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _importdeclarationsOopts = + _lhsIopts + -- copy rule (down) + _importdeclarationsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _declarationsOgUniq = + _importdeclarationsIgUniq + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _declarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (chain) + _declarationsOtopInstanceNmL = + _importdeclarationsItopInstanceNmL + ( _importdeclarationsIgUniq,_importdeclarationsImodImpL,_importdeclarationsItopInstanceNmL) | True = + importdeclarations_ _importdeclarationsOgUniq _importdeclarationsOmoduleNm _importdeclarationsOnmLev _importdeclarationsOopts _importdeclarationsOtopInstanceNmL + ( _declarationsIgUniq,_declarationsIgathPragmas,_declarationsIidOccDefs,_declarationsImainValExists,_declarationsImodDefsRel,_declarationsImodHideDefsRel,_declarationsItopInstanceNmL) | True = + declarations_ _declarationsOgUniq _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOtopInstanceNmL + in ( _lhsOextraModImpL,_lhsOgUniq,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOmodImpL,_lhsOtopInstanceNmL))) +-- Constructor ------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conAndFldrefnames : AssocL Name Names + conrefnames : Names + alternatives: + alternative Constructor: + child range : {Range} + child constructor : {Name} + child types : Types + visit 0: + local conrefname : _ + local nmLev : _ + alternative Infix: + child range : {Range} + child leftType : Type + child constructorOperator : {Name} + child rightType : Type + visit 0: + local conrefname : _ + local nmLev : _ + alternative Record: + child range : {Range} + child constructor : {Name} + child fieldDeclarations : FieldDeclarations + visit 0: + local conrefname : _ + local conAndFldrefnames : _ + alternative Contexted: + child range : {Range} + child context : ContextItems + child constructor : Constructor + alternative GADTFunction: + child range : {Range} + child constructor : {Name} + child type : Type + visit 0: + local conrefname : _ + local nmLev : _ +-} +-- cata +sem_Constructor :: Constructor -> + T_Constructor +sem_Constructor (Constructor_Constructor _range _constructor _types) = + (sem_Constructor_Constructor _range _constructor (sem_Types _types)) +sem_Constructor (Constructor_Infix _range _leftType _constructorOperator _rightType) = + (sem_Constructor_Infix _range (sem_Type _leftType) _constructorOperator (sem_Type _rightType)) +sem_Constructor (Constructor_Record _range _constructor _fieldDeclarations) = + (sem_Constructor_Record _range _constructor (sem_FieldDeclarations _fieldDeclarations)) +sem_Constructor (Constructor_Contexted _range _context _constructor) = + (sem_Constructor_Contexted _range (sem_ContextItems _context) (sem_Constructor _constructor)) +sem_Constructor (Constructor_GADTFunction _range _constructor _type) = + (sem_Constructor_GADTFunction _range _constructor (sem_Type _type)) +-- semantic domain +type T_Constructor = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( (AssocL Name Names),Names,UID,([HsName])) +sem_Constructor_Constructor :: Range -> + Name -> + T_Types -> + T_Constructor +sem_Constructor_Constructor range_ constructor_ types_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOgUniq :: UID + _typesOnmLev :: NmLev + _typesOtopInstanceNmL :: ([HsName]) + _typesIgUniq :: UID + _typesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 71, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (down) + _typesOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIgUniq,_typesItopInstanceNmL) | True = + types_ _typesOgUniq _typesOnmLev _typesOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Constructor_Infix :: Range -> + T_Type -> + Name -> + T_Type -> + T_Constructor +sem_Constructor_Infix range_ leftType_ constructorOperator_ rightType_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOgUniq :: UID + _leftTypeOnmLev :: NmLev + _leftTypeOtopInstanceNmL :: ([HsName]) + _rightTypeOgUniq :: UID + _rightTypeOnmLev :: NmLev + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIconNm :: Name + _leftTypeIgUniq :: UID + _leftTypeItopInstanceNmL :: ([HsName]) + _rightTypeIconNm :: Name + _rightTypeIgUniq :: UID + _rightTypeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 66, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructorOperator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 73, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (down) + _leftTypeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _leftTypeOnmLev = + _nmLev + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rightTypeOgUniq = + _leftTypeIgUniq + -- copy rule (from local) + _rightTypeOnmLev = + _nmLev + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _leftTypeItopInstanceNmL + ( _leftTypeIconNm,_leftTypeIgUniq,_leftTypeItopInstanceNmL) | True = + leftType_ _leftTypeOgUniq _leftTypeOnmLev _leftTypeOtopInstanceNmL + ( _rightTypeIconNm,_rightTypeIgUniq,_rightTypeItopInstanceNmL) | True = + rightType_ _rightTypeOgUniq _rightTypeOnmLev _rightTypeOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Constructor_Record :: Range -> + Name -> + T_FieldDeclarations -> + T_Constructor +sem_Constructor_Record range_ constructor_ fieldDeclarations_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _fieldDeclarationsOgUniq :: UID + _fieldDeclarationsOmoduleNm :: HsName + _fieldDeclarationsOnmLev :: NmLev + _fieldDeclarationsOtopInstanceNmL :: ([HsName]) + _fieldDeclarationsIfldrefnames :: Names + _fieldDeclarationsIgUniq :: UID + _fieldDeclarationsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 76, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 87, column 9) + _conAndFldrefnames = + [(_conrefname,_fieldDeclarationsIfldrefnames)] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _conAndFldrefnames + -- copy rule (up) + _lhsOgUniq = + _fieldDeclarationsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _fieldDeclarationsItopInstanceNmL + -- copy rule (down) + _fieldDeclarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _fieldDeclarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _fieldDeclarationsOnmLev = + _lhsInmLev + -- copy rule (down) + _fieldDeclarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _fieldDeclarationsIfldrefnames,_fieldDeclarationsIgUniq,_fieldDeclarationsItopInstanceNmL) | True = + fieldDeclarations_ _fieldDeclarationsOgUniq _fieldDeclarationsOmoduleNm _fieldDeclarationsOnmLev _fieldDeclarationsOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Constructor_Contexted :: Range -> + T_ContextItems -> + T_Constructor -> + T_Constructor +sem_Constructor_Contexted range_ context_ constructor_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _constructorOgUniq :: UID + _constructorOmoduleNm :: HsName + _constructorOnmLev :: NmLev + _constructorOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _constructorIconAndFldrefnames :: (AssocL Name Names) + _constructorIconrefnames :: Names + _constructorIgUniq :: UID + _constructorItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _constructorIconAndFldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + _constructorIconrefnames + -- copy rule (up) + _lhsOgUniq = + _constructorIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _constructorItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _constructorOgUniq = + _contextIgUniq + -- copy rule (down) + _constructorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _constructorOnmLev = + _lhsInmLev + -- copy rule (chain) + _constructorOtopInstanceNmL = + _contextItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _constructorIconAndFldrefnames,_constructorIconrefnames,_constructorIgUniq,_constructorItopInstanceNmL) | True = + constructor_ _constructorOgUniq _constructorOmoduleNm _constructorOnmLev _constructorOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Constructor_GADTFunction :: Range -> + Name -> + T_Type -> + T_Constructor +sem_Constructor_GADTFunction range_ constructor_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconrefnames :: Names + _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 64, column 9) + _conrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm constructor_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 71, column 9) + _lhsOconrefnames = + [_conrefname] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 38, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- Constructors ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + conAndFldrefnames : AssocL Name Names + conrefnames : Names + alternatives: + alternative Cons: + child hd : Constructor + child tl : Constructors + alternative Nil: +-} +-- cata +sem_Constructors :: Constructors -> + T_Constructors +sem_Constructors list = + (Prelude.foldr sem_Constructors_Cons sem_Constructors_Nil (Prelude.map sem_Constructor list)) +-- semantic domain +type T_Constructors = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( (AssocL Name Names),Names,UID,([HsName])) +sem_Constructors_Cons :: T_Constructor -> + T_Constructors -> + T_Constructors +sem_Constructors_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIconAndFldrefnames :: (AssocL Name Names) + _hdIconrefnames :: Names + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIconAndFldrefnames :: (AssocL Name Names) + _tlIconrefnames :: Names + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + _hdIconAndFldrefnames ++ _tlIconAndFldrefnames + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + _hdIconrefnames ++ _tlIconrefnames + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconAndFldrefnames,_hdIconrefnames,_hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIconAndFldrefnames,_tlIconrefnames,_tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Constructors_Nil :: T_Constructors +sem_Constructors_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconAndFldrefnames :: (AssocL Name Names) + _lhsOconrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 79, column 45) + _lhsOconAndFldrefnames = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 60, column 39) + _lhsOconrefnames = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconAndFldrefnames,_lhsOconrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- ContextItem ------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Class: + child range : {Range} + child name : {Name} + child types : Types + alternative Forall: + child range : {Range} + child typevariables : {Names} + child context : ContextItem + visit 0: + local nmLev : _ + alternative Arrow: + child range : {Range} + child argument : ContextItem + child result : ContextItem + alternative Implicits: + child range : {Range} + alternative NoImplicits: + child range : {Range} + alternative RowLacksLabel: + child range : {Range} + child rowvariable : {Name} + child name : {Name} + alternative Equal: + child range : {Range} + child type1 : Type + child type2 : Type +-} +-- cata +sem_ContextItem :: ContextItem -> + T_ContextItem +sem_ContextItem (ContextItem_Class _range _name _types) = + (sem_ContextItem_Class _range _name (sem_Types _types)) +sem_ContextItem (ContextItem_Forall _range _typevariables _context) = + (sem_ContextItem_Forall _range _typevariables (sem_ContextItem _context)) +sem_ContextItem (ContextItem_Arrow _range _argument _result) = + (sem_ContextItem_Arrow _range (sem_ContextItem _argument) (sem_ContextItem _result)) +sem_ContextItem (ContextItem_Implicits _range) = + (sem_ContextItem_Implicits _range) +sem_ContextItem (ContextItem_NoImplicits _range) = + (sem_ContextItem_NoImplicits _range) +sem_ContextItem (ContextItem_RowLacksLabel _range _rowvariable _name) = + (sem_ContextItem_RowLacksLabel _range _rowvariable _name) +sem_ContextItem (ContextItem_Equal _range _type1 _type2) = + (sem_ContextItem_Equal _range (sem_Type _type1) (sem_Type _type2)) +-- semantic domain +type T_ContextItem = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_ContextItem_Class :: Range -> + Name -> + T_Types -> + T_ContextItem +sem_ContextItem_Class range_ name_ types_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOgUniq :: UID + _typesOnmLev :: NmLev + _typesOtopInstanceNmL :: ([HsName]) + _typesIgUniq :: UID + _typesItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (down) + _typesOgUniq = + _lhsIgUniq + -- copy rule (down) + _typesOnmLev = + _lhsInmLev + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIgUniq,_typesItopInstanceNmL) | True = + types_ _typesOgUniq _typesOnmLev _typesOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_Forall :: Range -> + Names -> + T_ContextItem -> + T_ContextItem +sem_ContextItem_Forall range_ typevariables_ context_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 46, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_Arrow :: Range -> + T_ContextItem -> + T_ContextItem -> + T_ContextItem +sem_ContextItem_Arrow range_ argument_ result_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _argumentOgUniq :: UID + _argumentOnmLev :: NmLev + _argumentOtopInstanceNmL :: ([HsName]) + _resultOgUniq :: UID + _resultOnmLev :: NmLev + _resultOtopInstanceNmL :: ([HsName]) + _argumentIgUniq :: UID + _argumentItopInstanceNmL :: ([HsName]) + _resultIgUniq :: UID + _resultItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _resultIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _resultItopInstanceNmL + -- copy rule (down) + _argumentOgUniq = + _lhsIgUniq + -- copy rule (down) + _argumentOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _resultOgUniq = + _argumentIgUniq + -- copy rule (down) + _resultOnmLev = + _lhsInmLev + -- copy rule (chain) + _resultOtopInstanceNmL = + _argumentItopInstanceNmL + ( _argumentIgUniq,_argumentItopInstanceNmL) | True = + argument_ _argumentOgUniq _argumentOnmLev _argumentOtopInstanceNmL + ( _resultIgUniq,_resultItopInstanceNmL) | True = + result_ _resultOgUniq _resultOnmLev _resultOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_Implicits :: Range -> + T_ContextItem +sem_ContextItem_Implicits range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_NoImplicits :: Range -> + T_ContextItem +sem_ContextItem_NoImplicits range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_RowLacksLabel :: Range -> + Name -> + Name -> + T_ContextItem +sem_ContextItem_RowLacksLabel range_ rowvariable_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItem_Equal :: Range -> + T_Type -> + T_Type -> + T_ContextItem +sem_ContextItem_Equal range_ type1_ type2_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _type1OgUniq :: UID + _type1OnmLev :: NmLev + _type1OtopInstanceNmL :: ([HsName]) + _type2OgUniq :: UID + _type2OnmLev :: NmLev + _type2OtopInstanceNmL :: ([HsName]) + _type1IconNm :: Name + _type1IgUniq :: UID + _type1ItopInstanceNmL :: ([HsName]) + _type2IconNm :: Name + _type2IgUniq :: UID + _type2ItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _type2IgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _type2ItopInstanceNmL + -- copy rule (down) + _type1OgUniq = + _lhsIgUniq + -- copy rule (down) + _type1OnmLev = + _lhsInmLev + -- copy rule (down) + _type1OtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _type2OgUniq = + _type1IgUniq + -- copy rule (down) + _type2OnmLev = + _lhsInmLev + -- copy rule (chain) + _type2OtopInstanceNmL = + _type1ItopInstanceNmL + ( _type1IconNm,_type1IgUniq,_type1ItopInstanceNmL) | True = + type1_ _type1OgUniq _type1OnmLev _type1OtopInstanceNmL + ( _type2IconNm,_type2IgUniq,_type2ItopInstanceNmL) | True = + type2_ _type2OgUniq _type2OnmLev _type2OtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- ContextItems ------------------------------------------------ +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : ContextItem + child tl : ContextItems + alternative Nil: +-} +-- cata +sem_ContextItems :: ContextItems -> + T_ContextItems +sem_ContextItems list = + (Prelude.foldr sem_ContextItems_Cons sem_ContextItems_Nil (Prelude.map sem_ContextItem list)) +-- semantic domain +type T_ContextItems = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_ContextItems_Cons :: T_ContextItem -> + T_ContextItems -> + T_ContextItems +sem_ContextItems_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextItems_Nil :: T_ContextItems +sem_ContextItems_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- ContextedExpression ----------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Contexted: + child range : {Range} + child expression : Expression + child context : ContextItem +-} +-- cata +sem_ContextedExpression :: ContextedExpression -> + T_ContextedExpression +sem_ContextedExpression (ContextedExpression_Contexted _range _expression _context) = + (sem_ContextedExpression_Contexted _range (sem_Expression _expression) (sem_ContextItem _context)) +-- semantic domain +type T_ContextedExpression = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_ContextedExpression_Contexted :: Range -> + T_Expression -> + T_ContextItem -> + T_ContextedExpression +sem_ContextedExpression_Contexted range_ expression_ context_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _contextOgUniq = + _expressionIgUniq + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (chain) + _contextOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- ContextedExpressions ---------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : ContextedExpression + child tl : ContextedExpressions + alternative Nil: +-} +-- cata +sem_ContextedExpressions :: ContextedExpressions -> + T_ContextedExpressions +sem_ContextedExpressions list = + (Prelude.foldr sem_ContextedExpressions_Cons sem_ContextedExpressions_Nil (Prelude.map sem_ContextedExpression list)) +-- semantic domain +type T_ContextedExpressions = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_ContextedExpressions_Cons :: T_ContextedExpression -> + T_ContextedExpressions -> + T_ContextedExpressions +sem_ContextedExpressions_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_ContextedExpressions_Nil :: T_ContextedExpressions +sem_ContextedExpressions_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- ContextedPattern -------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Contexted: + child range : {Range} + child pattern : Pattern + child context : ContextItem +-} +-- cata +sem_ContextedPattern :: ContextedPattern -> + T_ContextedPattern +sem_ContextedPattern (ContextedPattern_Contexted _range _pattern _context) = + (sem_ContextedPattern_Contexted _range (sem_Pattern _pattern) (sem_ContextItem _context)) +-- semantic domain +type T_ContextedPattern = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_ContextedPattern_Contexted :: Range -> + T_Pattern -> + T_ContextItem -> + T_ContextedPattern +sem_ContextedPattern_Contexted range_ pattern_ context_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _contextIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _contextOgUniq = + _patternIgUniq + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (chain) + _contextOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- ContextedPatterns ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Cons: + child hd : ContextedPattern + child tl : ContextedPatterns + alternative Nil: +-} +-- cata +sem_ContextedPatterns :: ContextedPatterns -> + T_ContextedPatterns +sem_ContextedPatterns list = + (Prelude.foldr sem_ContextedPatterns_Cons sem_ContextedPatterns_Nil (Prelude.map sem_ContextedPattern list)) +-- semantic domain +type T_ContextedPatterns = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_ContextedPatterns_Cons :: T_ContextedPattern -> + T_ContextedPatterns -> + T_ContextedPatterns +sem_ContextedPatterns_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIidOccDefs :: ([IdOcc]) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIidOccDefs :: ([IdOcc]) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIidOccDefs,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlIidOccDefs,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +sem_ContextedPatterns_Nil :: T_ContextedPatterns +sem_ContextedPatterns_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- Declaration ------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + mainValExists : Bool + modDefsRel : ModEntRel + modHideDefsRel : ModEntRel + alternatives: + alternative FunctionBindings: + child range : {Range} + child bindings : FunctionBindings + visit 0: + local idOccDefs : _ + alternative PatternBinding: + child range : {Range} + child pattern : Pattern + child righthandside : RightHandSide + visit 0: + local idOccDef : _ + local idOccDefsPat : _ + local idOccDefs : _ + local lUniq : {UID} + alternative TypeSignature: + child range : {Range} + child names : {Names} + child type : Type + visit 0: + local refnames : _ + local idOccDefs : _ + local nmLev : _ + alternative Fixity: + child range : {Range} + child fixity : {Fixity} + child priority : {Maybe Int} + child operators : {Names} + visit 0: + local oprefnames : _ + alternative FusionDeclaration: + child range : {Range} + child fusename : {Name} + visit 0: + local idOccDef : _ + local idOccDefs : _ + local lUniq : {UID} + alternative FusionConversion: + child range : {Range} + child absname : {Name} + child conname : {Name} + visit 0: + local idOccDef : _ + local idOccDefs : _ + local lUniq : {UID} + alternative Empty: + child range : {Range} + alternative Data: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructors + child derivings : Derivings + visit 0: + local modDefsRel : _ + local modEntsSub : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + alternative Newtype: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructor + child derivings : Derivings + visit 0: + local modDefsRel : _ + local modEntsSub : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + alternative GADT: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child constructors : Constructors + child derivings : Derivings + visit 0: + local modDefsRel : _ + local modEntsSub : _ + local typerefname : _ + local idOccDef : _ + local idOccDefsCon : _ + local idOccDefsFld : _ + local generMaxRemArity : _ + local idOccDefsGener : _ + local idOccDefs : _ + local nmLev : _ + alternative KindSignature: + child range : {Range} + child names : {Names} + child kind : Kind + visit 0: + local refnames : _ + local idOccDefs : _ + local nmLev : _ + alternative ForeignImport: + child range : {Range} + child callconvention : {FFIWay} + child safety : {Maybe String} + child importname : {Maybe String} + child name : {Name} + child type : Type + visit 0: + local refname : _ + local idOccDef : _ + local idOccDefs : _ + alternative ForeignExport: + child range : {Range} + child callconvention : {FFIWay} + child exportname : {Maybe String} + child name : {Name} + child type : Type + visit 0: + local exportrefname : _ + local idOccDef : _ + local idOccDefs : _ + alternative Class: + child range : {Range} + child context : ContextItems + child typelefthandside : TypeLeftHandSide + child dependencies : FunctionalDependencies + child where : MaybeDeclarations + visit 0: + local modDefsRel : _ + local modHideDefsRel : _ + local modEntsSub : _ + local instancerefname : _ + local classrefname : _ + local extranames : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefsSig : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local mbPrevInstancename : _ + local generDerivInfoL : _ + local lUniq : {UID} + alternative Instance: + child range : {Range} + child instVariant : {InstVariant} + child maybeinstancename : {MaybeName} + child useimplicitly : {Bool} + child context : ContextItems + child type : Type + child where : MaybeDeclarations + visit 0: + local instancerefname : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local mbPrevInstancename : _ + local lUniq : {UID} + alternative InstanceUseImplicitly: + child range : {Range} + child expression : Expression + child name : {Name} + child types : Types + visit 0: + local instancerefname : _ + local idOccDef : _ + local idOccDefs : _ + local instancename : _ + local nmLev : _ + local mbPrevInstancename : _ + local lUniq : {UID} + alternative Default: + child range : {Range} + child name : {MaybeName} + child types : Types + visit 0: + local idOccDef : _ + local idOccDefs : _ + local defaultname : _ + local nmLev : _ + local lUniq : {UID} + alternative Type: + child range : {Range} + child typelefthandside : TypeLeftHandSide + child type : Type + visit 0: + local typerefname : _ + local idOccDef : _ + local idOccDefs : _ + local nmLev : _ + alternative Pragma: + child range : {Range} + child pragma : Pragma + alternative Module: + child range : {Range} + child name : {MaybeName} + child exports : MaybeExports +-} +-- cata +sem_Declaration :: Declaration -> + T_Declaration +sem_Declaration (Declaration_FunctionBindings _range _bindings) = + (sem_Declaration_FunctionBindings _range (sem_FunctionBindings _bindings)) +sem_Declaration (Declaration_PatternBinding _range _pattern _righthandside) = + (sem_Declaration_PatternBinding _range (sem_Pattern _pattern) (sem_RightHandSide _righthandside)) +sem_Declaration (Declaration_TypeSignature _range _names _type) = + (sem_Declaration_TypeSignature _range _names (sem_Type _type)) +sem_Declaration (Declaration_Fixity _range _fixity _priority _operators) = + (sem_Declaration_Fixity _range _fixity _priority _operators) +sem_Declaration (Declaration_FusionDeclaration _range _fusename) = + (sem_Declaration_FusionDeclaration _range _fusename) +sem_Declaration (Declaration_FusionConversion _range _absname _conname) = + (sem_Declaration_FusionConversion _range _absname _conname) +sem_Declaration (Declaration_Empty _range) = + (sem_Declaration_Empty _range) +sem_Declaration (Declaration_Data _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_Data _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructors _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_Newtype _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_Newtype _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructor _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_GADT _range _context _typelefthandside _constructors _derivings) = + (sem_Declaration_GADT _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_Constructors _constructors) (sem_Derivings _derivings)) +sem_Declaration (Declaration_KindSignature _range _names _kind) = + (sem_Declaration_KindSignature _range _names (sem_Kind _kind)) +sem_Declaration (Declaration_ForeignImport _range _callconvention _safety _importname _name _type) = + (sem_Declaration_ForeignImport _range _callconvention _safety _importname _name (sem_Type _type)) +sem_Declaration (Declaration_ForeignExport _range _callconvention _exportname _name _type) = + (sem_Declaration_ForeignExport _range _callconvention _exportname _name (sem_Type _type)) +sem_Declaration (Declaration_Class _range _context _typelefthandside _dependencies _where) = + (sem_Declaration_Class _range (sem_ContextItems _context) (sem_TypeLeftHandSide _typelefthandside) (sem_FunctionalDependencies _dependencies) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_Instance _range _instVariant _maybeinstancename _useimplicitly _context _type _where) = + (sem_Declaration_Instance _range _instVariant _maybeinstancename _useimplicitly (sem_ContextItems _context) (sem_Type _type) (sem_MaybeDeclarations _where)) +sem_Declaration (Declaration_InstanceUseImplicitly _range _expression _name _types) = + (sem_Declaration_InstanceUseImplicitly _range (sem_Expression _expression) _name (sem_Types _types)) +sem_Declaration (Declaration_Default _range _name _types) = + (sem_Declaration_Default _range _name (sem_Types _types)) +sem_Declaration (Declaration_Type _range _typelefthandside _type) = + (sem_Declaration_Type _range (sem_TypeLeftHandSide _typelefthandside) (sem_Type _type)) +sem_Declaration (Declaration_Pragma _range _pragma) = + (sem_Declaration_Pragma _range (sem_Pragma _pragma)) +sem_Declaration (Declaration_Module _range _name _exports) = + (sem_Declaration_Module _range _name (sem_MaybeExports _exports)) +-- semantic domain +type T_Declaration = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),Bool,ModEntRel,ModEntRel,([HsName])) +sem_Declaration_FunctionBindings :: Range -> + T_FunctionBindings -> + T_Declaration +sem_Declaration_FunctionBindings range_ bindings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _bindingsOgUniq :: UID + _bindingsOmoduleNm :: HsName + _bindingsOnmLev :: NmLev + _bindingsOopts :: EHCOpts + _bindingsOtopInstanceNmL :: ([HsName]) + _bindingsIgUniq :: UID + _bindingsIidOccDefs :: ([IdOcc]) + _bindingsImainValExists :: Bool + _bindingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 121, column 9) + _lhsOmodDefsRel = + Rel.fromList [ (hsnQualified (ioccNm o),ModEnt IdOcc_Val o Set.empty range_) | o <- _idOccDefs ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 115, column 9) + _idOccDefs = + _bindingsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _bindingsImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _bindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _bindingsItopInstanceNmL + -- copy rule (down) + _bindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _bindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _bindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _bindingsOopts = + _lhsIopts + -- copy rule (down) + _bindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _bindingsIgUniq,_bindingsIidOccDefs,_bindingsImainValExists,_bindingsItopInstanceNmL) | True = + bindings_ _bindingsOgUniq _bindingsOmoduleNm _bindingsOnmLev _bindingsOopts _bindingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_PatternBinding :: Range -> + T_Pattern -> + T_RightHandSide -> + T_Declaration +sem_Declaration_PatternBinding range_ pattern_ righthandside_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _patternOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _righthandsideOgUniq :: UID + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _righthandsideIgUniq :: UID + _righthandsideItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 121, column 9) + _lhsOmodDefsRel = + Rel.fromList [ (hsnQualified (ioccNm o),ModEnt IdOcc_Val o Set.empty range_) | o <- _idOccDefs ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDef = + IdOcc (maybe (mkHNm _lUniq) id _patternImbTopRefname) IdOcc_Pat + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDefsPat = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 117, column 9) + _idOccDefs = + _patternIidOccDefs + -- -- generated by the unique rule mechanism. + (_patternOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _righthandsideOgUniq = + _patternIgUniq + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _righthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _righthandsideIgUniq,_righthandsideItopInstanceNmL) | True = + righthandside_ _righthandsideOgUniq _righthandsideOmoduleNm _righthandsideOnmLev _righthandsideOopts _righthandsideOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_TypeSignature :: Range -> + Names -> + T_Type -> + T_Declaration +sem_Declaration_TypeSignature range_ names_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 121, column 9) + _lhsOmodDefsRel = + Rel.fromList [ (hsnQualified (ioccNm o),ModEnt IdOcc_Val o Set.empty range_) | o <- _idOccDefs ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 14, column 9) + _refnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 113, column 9) + _idOccDefs = + [ IdOcc n IdOcc_Val | n <- _refnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 17, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Fixity :: Range -> + Fixity -> + (Maybe Int) -> + Names -> + T_Declaration +sem_Declaration_Fixity range_ fixity_ priority_ operators_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 12, column 9) + _oprefnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) operators_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_FusionDeclaration :: Range -> + Name -> + T_Declaration +sem_Declaration_FusionDeclaration range_ fusename_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDef = + IdOcc (mkHNm _lUniq) IdOcc_Fusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDefs = + [_idOccDef] + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_FusionConversion :: Range -> + Name -> + Name -> + T_Declaration +sem_Declaration_FusionConversion range_ absname_ conname_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDef = + IdOcc (mkHNm _lUniq) IdOcc_Fusion + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 163, column 9) + _idOccDefs = + [_idOccDef] + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Empty :: Range -> + T_Declaration +sem_Declaration_Empty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Data :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructors -> + T_Derivings -> + T_Declaration +sem_Declaration_Data range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOgUniq :: UID + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOgUniq :: UID + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOgUniq :: UID + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typelefthandsideIgUniq :: UID + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIname :: Name + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIgUniq :: UID + _constructorsItopInstanceNmL :: ([HsName]) + _derivingsIgUniq :: UID + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsImodDefsRel :: ModEntRel + _derivingsImodHideDefsRel :: ModEntRel + _derivingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modDefsRel = + Rel.singleton + _typelefthandsideIname + (ModEnt IdOcc_Data _idOccDef (Set.fromList _modEntsSub) range_) + `Rel.union` + _derivingsImodDefsRel + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modEntsSub = + [ ModEnt (ioccKind o) o Set.empty range_ + | o <- _idOccDefsCon ++ _idOccDefsFld + ++ _idOccDefsGener + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 142, column 9) + _lhsOmodDefsRel = + _modDefsRel + `Rel.union` + Rel.fromList [ (hsnQualified $ ioccNm $ mentIdOcc e,e) | e <- _modEntsSub ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _derivingsImodHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typelefthandsideIgUniq,_typelefthandsideIidOccDefs,_typelefthandsideIname,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables) | True = + typelefthandside_ _typelefthandsideOgUniq _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIgUniq,_constructorsItopInstanceNmL) | True = + constructors_ _constructorsOgUniq _constructorsOmoduleNm _constructorsOnmLev _constructorsOtopInstanceNmL + ( _derivingsIgUniq,_derivingsIgathPragmas,_derivingsIidOccDefs,_derivingsImodDefsRel,_derivingsImodHideDefsRel,_derivingsItopInstanceNmL) | True = + derivings_ _derivingsOgUniq _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Newtype :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructor -> + T_Derivings -> + T_Declaration +sem_Declaration_Newtype range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOgUniq :: UID + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOgUniq :: UID + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOgUniq :: UID + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typelefthandsideIgUniq :: UID + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIname :: Name + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIgUniq :: UID + _constructorsItopInstanceNmL :: ([HsName]) + _derivingsIgUniq :: UID + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsImodDefsRel :: ModEntRel + _derivingsImodHideDefsRel :: ModEntRel + _derivingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modDefsRel = + Rel.singleton + _typelefthandsideIname + (ModEnt IdOcc_Data _idOccDef (Set.fromList _modEntsSub) range_) + `Rel.union` + _derivingsImodDefsRel + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modEntsSub = + [ ModEnt (ioccKind o) o Set.empty range_ + | o <- _idOccDefsCon ++ _idOccDefsFld + ++ _idOccDefsGener + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 142, column 9) + _lhsOmodDefsRel = + _modDefsRel + `Rel.union` + Rel.fromList [ (hsnQualified $ ioccNm $ mentIdOcc e,e) | e <- _modEntsSub ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _derivingsImodHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typelefthandsideIgUniq,_typelefthandsideIidOccDefs,_typelefthandsideIname,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables) | True = + typelefthandside_ _typelefthandsideOgUniq _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIgUniq,_constructorsItopInstanceNmL) | True = + constructors_ _constructorsOgUniq _constructorsOmoduleNm _constructorsOnmLev _constructorsOtopInstanceNmL + ( _derivingsIgUniq,_derivingsIgathPragmas,_derivingsIidOccDefs,_derivingsImodDefsRel,_derivingsImodHideDefsRel,_derivingsItopInstanceNmL) | True = + derivings_ _derivingsOgUniq _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_GADT :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_Constructors -> + T_Derivings -> + T_Declaration +sem_Declaration_GADT range_ context_ typelefthandside_ constructors_ derivings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOgUniq :: UID + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _constructorsOgUniq :: UID + _constructorsOmoduleNm :: HsName + _constructorsOnmLev :: NmLev + _constructorsOtopInstanceNmL :: ([HsName]) + _derivingsOgUniq :: UID + _derivingsOmoduleNm :: HsName + _derivingsOnmLev :: NmLev + _derivingsOopts :: EHCOpts + _derivingsOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typelefthandsideIgUniq :: UID + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIname :: Name + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _constructorsIconAndFldrefnames :: (AssocL Name Names) + _constructorsIconrefnames :: Names + _constructorsIgUniq :: UID + _constructorsItopInstanceNmL :: ([HsName]) + _derivingsIgUniq :: UID + _derivingsIgathPragmas :: (Set.Set Pragma.Pragma) + _derivingsIidOccDefs :: ([IdOcc]) + _derivingsImodDefsRel :: ModEntRel + _derivingsImodHideDefsRel :: ModEntRel + _derivingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modDefsRel = + Rel.singleton + _typelefthandsideIname + (ModEnt IdOcc_Data _idOccDef (Set.fromList _modEntsSub) range_) + `Rel.union` + _derivingsImodDefsRel + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 125, column 9) + _modEntsSub = + [ ModEnt (ioccKind o) o Set.empty range_ + | o <- _idOccDefsCon ++ _idOccDefsFld + ++ _idOccDefsGener + ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 142, column 9) + _lhsOmodDefsRel = + _modDefsRel + `Rel.union` + Rel.fromList [ (hsnQualified $ ioccNm $ mentIdOcc e,e) | e <- _modEntsSub ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 18, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsCon = + [ IdOcc n IdOcc_Val | n <- _constructorsIconrefnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsFld = + concat [ [IdOcc n IdOcc_Val, IdOcc n IdOcc_Fld] | (_,ns) <- _constructorsIconAndFldrefnames, n <- ns ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _generMaxRemArity = + length _typelefthandsideItypevariables `min` 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefsGener = + if ehcOptGenGenerics _lhsIopts + then [ IdOcc (hsnNm2GenerReprSyn arity _typerefname) IdOcc_Type | arity <- [0 .. _generMaxRemArity] ] + else [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 123, column 9) + _idOccDefs = + [_idOccDef] + ++ _idOccDefsCon + ++ _idOccDefsFld + ++ _idOccDefsGener + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 20, column 9) + _nmLev = + _lhsInmLev + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _derivingsIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _derivingsImodHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _derivingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _derivingsItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (chain) + _constructorsOgUniq = + _typelefthandsideIgUniq + -- copy rule (down) + _constructorsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _constructorsOnmLev = + _nmLev + -- copy rule (chain) + _constructorsOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (chain) + _derivingsOgUniq = + _constructorsIgUniq + -- copy rule (down) + _derivingsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _derivingsOnmLev = + _nmLev + -- copy rule (down) + _derivingsOopts = + _lhsIopts + -- copy rule (chain) + _derivingsOtopInstanceNmL = + _constructorsItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typelefthandsideIgUniq,_typelefthandsideIidOccDefs,_typelefthandsideIname,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables) | True = + typelefthandside_ _typelefthandsideOgUniq _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOtopInstanceNmL + ( _constructorsIconAndFldrefnames,_constructorsIconrefnames,_constructorsIgUniq,_constructorsItopInstanceNmL) | True = + constructors_ _constructorsOgUniq _constructorsOmoduleNm _constructorsOnmLev _constructorsOtopInstanceNmL + ( _derivingsIgUniq,_derivingsIgathPragmas,_derivingsIidOccDefs,_derivingsImodDefsRel,_derivingsImodHideDefsRel,_derivingsItopInstanceNmL) | True = + derivings_ _derivingsOgUniq _derivingsOmoduleNm _derivingsOnmLev _derivingsOopts _derivingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_KindSignature :: Range -> + Names -> + T_Kind -> + T_Declaration +sem_Declaration_KindSignature range_ names_ kind_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOnmLev :: NmLev + _kindOtopInstanceNmL :: ([HsName]) + _kindIgUniq :: UID + _kindItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 16, column 9) + _refnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 137, column 9) + _idOccDefs = + [ IdOcc n IdOcc_Type | n <- _refnames ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 22, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (from local) + _kindOnmLev = + _nmLev + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIgUniq,_kindItopInstanceNmL) | True = + kind_ _kindOgUniq _kindOnmLev _kindOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_ForeignImport :: Range -> + FFIWay -> + (Maybe String) -> + (Maybe String) -> + Name -> + T_Type -> + T_Declaration +sem_Declaration_ForeignImport range_ callconvention_ safety_ importname_ name_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 121, column 9) + _lhsOmodDefsRel = + Rel.fromList [ (hsnQualified (ioccNm o),ModEnt IdOcc_Val o Set.empty range_) | o <- _idOccDefs ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 20, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 157, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 157, column 9) + _idOccDefs = + [_idOccDef] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_ForeignExport :: Range -> + FFIWay -> + (Maybe String) -> + Name -> + T_Type -> + T_Declaration +sem_Declaration_ForeignExport range_ callconvention_ exportname_ name_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 32, column 9) + _exportrefname = + hsnUniqify HsNameUniqifier_FFE name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 160, column 9) + _idOccDef = + IdOcc _exportrefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 160, column 9) + _idOccDefs = + [_idOccDef] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Class :: Range -> + T_ContextItems -> + T_TypeLeftHandSide -> + T_FunctionalDependencies -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Class range_ context_ typelefthandside_ dependencies_ where_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typelefthandsideOgUniq :: UID + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _dependenciesOgUniq :: UID + _dependenciesOmoduleNm :: HsName + _dependenciesOnmLev :: NmLev + _dependenciesOopts :: EHCOpts + _dependenciesOtopInstanceNmL :: ([HsName]) + _whereOgUniq :: UID + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typelefthandsideIgUniq :: UID + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIname :: Name + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _dependenciesIgUniq :: UID + _dependenciesIgathPragmas :: (Set.Set Pragma.Pragma) + _dependenciesIidOccDefs :: ([IdOcc]) + _dependenciesItopInstanceNmL :: ([HsName]) + _whereIgUniq :: UID + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidOccDefs :: ([IdOcc]) + _whereImainValExists :: Bool + _whereItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 135, column 9) + _modDefsRel = + Rel.singleton + _typelefthandsideIname + (ModEnt IdOcc_Class _idOccDef (Set.fromList _modEntsSub) range_) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 138, column 29) + (_,_modHideDefsRel) = + mkInstDefsRel False _instancename Nothing _idOccDef _idOccDefVal + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 135, column 9) + _modEntsSub = + [ ModEnt IdOcc_Val o Set.empty range_ | o <- _idOccDefsSig ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 142, column 9) + _lhsOmodDefsRel = + _modDefsRel + `Rel.union` + Rel.fromList [ (hsnQualified $ ioccNm $ mentIdOcc e,e) | e <- _modEntsSub ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 26, column 9) + _classrefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 96, column 17) + _extranames = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDef = + IdOcc _classrefname IdOcc_Class + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefsSig = + _whereIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 139, column 9) + _idOccDefs = + [_idOccDef] ++ _idOccDefsSig + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 235, column 9) + _instancename = + hsnUniqifyUID HsNameUniqifier_Class _lUniq (mkHNm _typelefthandsideIname) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 50, column 9) + _lhsOtopInstanceNmL = + _instancename : _lhsItopInstanceNmL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 65, column 9) + _mbPrevInstancename = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 90, column 9) + _generDerivInfoL = + [] + -- -- generated by the unique rule mechanism. + (_contextOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _dependenciesIgathPragmas `Set.union` _whereIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _whereImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _modHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typelefthandsideOgUniq = + _contextIgUniq + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (chain) + _typelefthandsideOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (chain) + _dependenciesOgUniq = + _typelefthandsideIgUniq + -- copy rule (down) + _dependenciesOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _dependenciesOnmLev = + _nmLev + -- copy rule (down) + _dependenciesOopts = + _lhsIopts + -- copy rule (chain) + _dependenciesOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + -- copy rule (chain) + _whereOgUniq = + _dependenciesIgUniq + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (chain) + _whereOtopInstanceNmL = + _dependenciesItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typelefthandsideIgUniq,_typelefthandsideIidOccDefs,_typelefthandsideIname,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables) | True = + typelefthandside_ _typelefthandsideOgUniq _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOtopInstanceNmL + ( _dependenciesIgUniq,_dependenciesIgathPragmas,_dependenciesIidOccDefs,_dependenciesItopInstanceNmL) | True = + dependencies_ _dependenciesOgUniq _dependenciesOmoduleNm _dependenciesOnmLev _dependenciesOopts _dependenciesOtopInstanceNmL + ( _whereIgUniq,_whereIgathPragmas,_whereIidOccDefs,_whereImainValExists,_whereItopInstanceNmL) | True = + where_ _whereOgUniq _whereOmoduleNm _whereOnmLev _whereOopts _whereOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Instance :: Range -> + InstVariant -> + MaybeName -> + Bool -> + T_ContextItems -> + T_Type -> + T_MaybeDeclarations -> + T_Declaration +sem_Declaration_Instance range_ instVariant_ maybeinstancename_ useimplicitly_ context_ type_ where_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _whereOgUniq :: UID + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + _whereIgUniq :: UID + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidOccDefs :: ([IdOcc]) + _whereImainValExists :: Bool + _whereItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 146, column 29) + (_lhsOmodDefsRel,_lhsOmodHideDefsRel) = + mkInstDefsRel useimplicitly_ _instancename maybeinstancename_ _idOccDef _idOccDefVal + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 144, column 9) + _idOccDefs = + [_idOccDef,_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 233, column 9) + _instancename = + maybe (hsnUniqifyUID HsNameUniqifier_ClassDict _lUniq (_typeIconNm)) id maybeinstancename_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 26, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 50, column 9) + _lhsOtopInstanceNmL = + _instancename : _lhsItopInstanceNmL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 65, column 9) + _mbPrevInstancename = + Nothing + -- -- generated by the unique rule mechanism. + (_contextOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _whereIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _whereImainValExists + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (from local) + _contextOnmLev = + _nmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _contextIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (chain) + _typeOtopInstanceNmL = + _contextItopInstanceNmL + -- copy rule (chain) + _whereOgUniq = + _typeIgUniq + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (chain) + _whereOtopInstanceNmL = + _typeItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + ( _whereIgUniq,_whereIgathPragmas,_whereIidOccDefs,_whereImainValExists,_whereItopInstanceNmL) | True = + where_ _whereOgUniq _whereOmoduleNm _whereOnmLev _whereOopts _whereOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_InstanceUseImplicitly :: Range -> + T_Expression -> + Name -> + T_Types -> + T_Declaration +sem_Declaration_InstanceUseImplicitly range_ expression_ name_ types_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _typesOgUniq :: UID + _typesOnmLev :: NmLev + _typesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _typesIgUniq :: UID + _typesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 149, column 9) + _lhsOmodDefsRel = + Rel.singleton _instancename (ModEnt IdOcc_Inst _idOccDef Set.empty range_) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 22, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 148, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 148, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 237, column 9) + _instancename = + mkHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 50, column 9) + _lhsOtopInstanceNmL = + _instancename : _lhsItopInstanceNmL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 65, column 9) + _mbPrevInstancename = + Nothing + -- -- generated by the unique rule mechanism. + (_expressionOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typesOgUniq = + _expressionIgUniq + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (chain) + _typesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _typesIgUniq,_typesItopInstanceNmL) | True = + types_ _typesOgUniq _typesOnmLev _typesOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Default :: Range -> + MaybeName -> + T_Types -> + T_Declaration +sem_Declaration_Default range_ name_ types_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _typesOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typesOnmLev :: NmLev + _typesOtopInstanceNmL :: ([HsName]) + _typesIgUniq :: UID + _typesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 151, column 9) + _idOccDef = + IdOcc _defaultname IdOcc_Dflt + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 151, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 239, column 9) + _defaultname = + mkHNm _lUniq + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 24, column 9) + _nmLev = + _lhsInmLev + -- -- generated by the unique rule mechanism. + (_typesOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typesItopInstanceNmL + -- copy rule (from local) + _typesOnmLev = + _nmLev + -- copy rule (down) + _typesOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typesIgUniq,_typesItopInstanceNmL) | True = + types_ _typesOgUniq _typesOnmLev _typesOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Type :: Range -> + T_TypeLeftHandSide -> + T_Type -> + T_Declaration +sem_Declaration_Type range_ typelefthandside_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typelefthandsideOgUniq :: UID + _typelefthandsideOmoduleNm :: HsName + _typelefthandsideOnmLev :: NmLev + _typelefthandsideOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typelefthandsideIgUniq :: UID + _typelefthandsideIidOccDefs :: ([IdOcc]) + _typelefthandsideIname :: Name + _typelefthandsideIrange :: Range + _typelefthandsideItopInstanceNmL :: ([HsName]) + _typelefthandsideItypevariables :: Names + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 123, column 9) + _lhsOmodDefsRel = + Rel.fromList [ (hsnQualified (ioccNm o),ModEnt IdOcc_Type o Set.empty range_) | o <- _idOccDefs ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 28, column 9) + _typerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm _typelefthandsideIname + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 154, column 9) + _idOccDef = + IdOcc _typerefname IdOcc_Type + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 154, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 29, column 9) + _nmLev = + _lhsInmLev + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typelefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _typelefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _typelefthandsideOnmLev = + _nmLev + -- copy rule (down) + _typelefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _typelefthandsideIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (chain) + _typeOtopInstanceNmL = + _typelefthandsideItopInstanceNmL + ( _typelefthandsideIgUniq,_typelefthandsideIidOccDefs,_typelefthandsideIname,_typelefthandsideIrange,_typelefthandsideItopInstanceNmL,_typelefthandsideItypevariables) | True = + typelefthandside_ _typelefthandsideOgUniq _typelefthandsideOmoduleNm _typelefthandsideOnmLev _typelefthandsideOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Pragma :: Range -> + T_Pragma -> + T_Declaration +sem_Declaration_Pragma range_ pragma_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _pragmaOgUniq :: UID + _pragmaOnmLev :: NmLev + _pragmaOtopInstanceNmL :: ([HsName]) + _pragmaIgUniq :: UID + _pragmaIgathPragmas :: (Set.Set Pragma.Pragma) + _pragmaItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _pragmaIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _pragmaIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _pragmaItopInstanceNmL + -- copy rule (down) + _pragmaOgUniq = + _lhsIgUniq + -- copy rule (down) + _pragmaOnmLev = + _lhsInmLev + -- copy rule (down) + _pragmaOtopInstanceNmL = + _lhsItopInstanceNmL + ( _pragmaIgUniq,_pragmaIgathPragmas,_pragmaItopInstanceNmL) | True = + pragma_ _pragmaOgUniq _pragmaOnmLev _pragmaOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declaration_Module :: Range -> + MaybeName -> + T_MaybeExports -> + T_Declaration +sem_Declaration_Module range_ name_ exports_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _exportsOgUniq :: UID + _exportsOmoduleNm :: HsName + _exportsOnmLev :: NmLev + _exportsOopts :: EHCOpts + _exportsOtopInstanceNmL :: ([HsName]) + _exportsIgUniq :: UID + _exportsImodExpsMb :: (Maybe [ModExp]) + _exportsItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (up) + _lhsOgUniq = + _exportsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _exportsItopInstanceNmL + -- copy rule (down) + _exportsOgUniq = + _lhsIgUniq + -- copy rule (down) + _exportsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _exportsOnmLev = + _lhsInmLev + -- copy rule (down) + _exportsOopts = + _lhsIopts + -- copy rule (down) + _exportsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _exportsIgUniq,_exportsImodExpsMb,_exportsItopInstanceNmL) | True = + exports_ _exportsOgUniq _exportsOmoduleNm _exportsOnmLev _exportsOopts _exportsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +-- Declarations ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + mainValExists : Bool + modDefsRel : ModEntRel + modHideDefsRel : ModEntRel + alternatives: + alternative Cons: + child hd : Declaration + child tl : Declarations + alternative Nil: +-} +-- cata +sem_Declarations :: Declarations -> + T_Declarations +sem_Declarations list = + (Prelude.foldr sem_Declarations_Cons sem_Declarations_Nil (Prelude.map sem_Declaration list)) +-- semantic domain +type T_Declarations = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),Bool,ModEntRel,ModEntRel,([HsName])) +sem_Declarations_Cons :: T_Declaration -> + T_Declarations -> + T_Declarations +sem_Declarations_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidOccDefs :: ([IdOcc]) + _hdImainValExists :: Bool + _hdImodDefsRel :: ModEntRel + _hdImodHideDefsRel :: ModEntRel + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidOccDefs :: ([IdOcc]) + _tlImainValExists :: Bool + _tlImodDefsRel :: ModEntRel + _tlImodHideDefsRel :: ModEntRel + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _hdImainValExists || _tlImainValExists + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + _hdImodDefsRel `Rel.union` _tlImodDefsRel + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _hdImodHideDefsRel `Rel.union` _tlImodHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIgathPragmas,_hdIidOccDefs,_hdImainValExists,_hdImodDefsRel,_hdImodHideDefsRel,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlIgathPragmas,_tlIidOccDefs,_tlImainValExists,_tlImodDefsRel,_tlImodHideDefsRel,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Declarations_Nil :: T_Declarations +sem_Declarations_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +-- Deriving ---------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + modDefsRel : ModEntRel + modHideDefsRel : ModEntRel + alternatives: + alternative Deriving: + child range : {Range} + child maybeinstancename : {MaybeName} + child useimplicitly : {Bool} + child name : {Name} + visit 0: + local instancerefname : _ + local idOccDef : _ + local idOccDefVal : _ + local idOccDefs : _ + local instancename : _ + local mbPrevInstancename : _ + local lUniq : {UID} +-} +-- cata +sem_Deriving :: Deriving -> + T_Deriving +sem_Deriving (Deriving_Deriving _range _maybeinstancename _useimplicitly _name) = + (sem_Deriving_Deriving _range _maybeinstancename _useimplicitly _name) +-- semantic domain +type T_Deriving = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),ModEntRel,ModEntRel,([HsName])) +sem_Deriving_Deriving :: Range -> + MaybeName -> + Bool -> + Name -> + T_Deriving +sem_Deriving_Deriving range_ maybeinstancename_ useimplicitly_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOtopInstanceNmL :: ([HsName]) + _lhsOgUniq :: UID + _lUniq :: UID + _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 153, column 29) + (_lhsOmodDefsRel,_lhsOmodHideDefsRel) = + mkInstDefsRel useimplicitly_ _instancename maybeinstancename_ _idOccDef _idOccDefVal + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 37, column 9) + _instancerefname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm + $ maybe _instancename id _mbPrevInstancename + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDef = + IdOcc _instancerefname IdOcc_Inst + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDefVal = + IdOcc _instancerefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 192, column 9) + _idOccDefs = + [_idOccDef,_idOccDefVal] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 247, column 9) + _instancename = + maybe (mkHNm _lUniq) id maybeinstancename_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 60, column 9) + _lhsOtopInstanceNmL = + _instancename : _lhsItopInstanceNmL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 70, column 9) + _mbPrevInstancename = + Nothing + -- -- generated by the unique rule mechanism. + (_lhsOgUniq,_lUniq) = + let __cont = _lhsIgUniq in seq __cont ( case nextUnique __cont of { (__cont, lUniq) -> (__cont,lUniq)} ) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +-- Derivings --------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + modDefsRel : ModEntRel + modHideDefsRel : ModEntRel + alternatives: + alternative Cons: + child hd : Deriving + child tl : Derivings + alternative Nil: +-} +-- cata +sem_Derivings :: Derivings -> + T_Derivings +sem_Derivings list = + (Prelude.foldr sem_Derivings_Cons sem_Derivings_Nil (Prelude.map sem_Deriving list)) +-- semantic domain +type T_Derivings = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),ModEntRel,ModEntRel,([HsName])) +sem_Derivings_Cons :: T_Deriving -> + T_Derivings -> + T_Derivings +sem_Derivings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidOccDefs :: ([IdOcc]) + _hdImodDefsRel :: ModEntRel + _hdImodHideDefsRel :: ModEntRel + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidOccDefs :: ([IdOcc]) + _tlImodDefsRel :: ModEntRel + _tlImodHideDefsRel :: ModEntRel + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + _hdImodDefsRel `Rel.union` _tlImodDefsRel + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + _hdImodHideDefsRel `Rel.union` _tlImodHideDefsRel + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIgathPragmas,_hdIidOccDefs,_hdImodDefsRel,_hdImodHideDefsRel,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlIgathPragmas,_tlIidOccDefs,_tlImodDefsRel,_tlImodHideDefsRel,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +sem_Derivings_Nil :: T_Derivings +sem_Derivings_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmodDefsRel :: ModEntRel + _lhsOmodHideDefsRel :: ModEntRel + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 115, column 26) + _lhsOmodDefsRel = + Rel.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 116, column 26) + _lhsOmodHideDefsRel = + Rel.empty + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmodDefsRel,_lhsOmodHideDefsRel,_lhsOtopInstanceNmL))) +-- Export ------------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modExp : ModExp + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + alternative TypeOrClass: + child range : {Range} + child name : {Name} + child names : {MaybeNames} + alternative TypeOrClassComplete: + child range : {Range} + child name : {Name} + alternative Module: + child range : {Range} + child name : {Name} +-} +-- cata +sem_Export :: Export -> + T_Export +sem_Export (Export_Variable _range _name) = + (sem_Export_Variable _range _name) +sem_Export (Export_TypeOrClass _range _name _names) = + (sem_Export_TypeOrClass _range _name _names) +sem_Export (Export_TypeOrClassComplete _range _name) = + (sem_Export_TypeOrClassComplete _range _name) +sem_Export (Export_Module _range _name) = + (sem_Export_Module _range _name) +-- semantic domain +type T_Export = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,ModExp,([HsName])) +sem_Export_Variable :: Range -> + Name -> + T_Export +sem_Export_Variable range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExp :: ModExp + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 74, column 9) + _lhsOmodExp = + ModExpEnt (ModEntSpec name_ range_ Nothing) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExp,_lhsOtopInstanceNmL))) +sem_Export_TypeOrClass :: Range -> + Name -> + MaybeNames -> + T_Export +sem_Export_TypeOrClass range_ name_ names_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExp :: ModExp + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 76, column 9) + _lhsOmodExp = + case names_ of + Just ns -> ModExpEnt (ModEntSpec name_ range_ (Just (ModEntSubs ns))) + Nothing -> ModExpEnt (ModEntSpec name_ range_ Nothing) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExp,_lhsOtopInstanceNmL))) +sem_Export_TypeOrClassComplete :: Range -> + Name -> + T_Export +sem_Export_TypeOrClassComplete range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExp :: ModExp + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 80, column 9) + _lhsOmodExp = + ModExpEnt (ModEntSpec name_ range_ (Just ModEntSubAll)) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExp,_lhsOtopInstanceNmL))) +sem_Export_Module :: Range -> + Name -> + T_Export +sem_Export_Module range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExp :: ModExp + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 82, column 9) + _lhsOmodExp = + ModExpMod name_ + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExp,_lhsOtopInstanceNmL))) +-- Exports ----------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modExpL : [ModExp] + alternatives: + alternative Cons: + child hd : Export + child tl : Exports + alternative Nil: +-} +-- cata +sem_Exports :: Exports -> + T_Exports +sem_Exports list = + (Prelude.foldr sem_Exports_Cons sem_Exports_Nil (Prelude.map sem_Export list)) +-- semantic domain +type T_Exports = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([ModExp]),([HsName])) +sem_Exports_Cons :: T_Export -> + T_Exports -> + T_Exports +sem_Exports_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExpL :: ([ModExp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdImodExp :: ModExp + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlImodExpL :: ([ModExp]) + _tlItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 88, column 9) + _lhsOmodExpL = + _hdImodExp : _tlImodExpL + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdImodExp,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlImodExpL,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExpL,_lhsOtopInstanceNmL))) +sem_Exports_Nil :: T_Exports +sem_Exports_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExpL :: ([ModExp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 90, column 9) + _lhsOmodExpL = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExpL,_lhsOtopInstanceNmL))) +-- Expression -------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + conNm : Name + alternatives: + alternative Literal: + child range : {Range} + child literal : Literal + alternative Variable: + child range : {Range} + child name : {Name} + alternative Constructor: + child range : {Range} + child name : {Name} + alternative TupleConstructor: + child range : {Range} + child arity : {Int} + alternative Parenthesized: + child range : {Range} + child expression : Expression + alternative NormalApplication: + child range : {Range} + child function : Expression + child arguments : Expressions + alternative SectionApplication: + child range : {Range} + child leftExpression : MaybeExpression + child operator : Expression + child rightExpression : MaybeExpression + alternative InfixApplication: + child range : {Range} + child leftExpression : Expression + child operator : Expression + child rightExpression : Expression + alternative InfixApplicationChainTop: + child range : {Range} + child expression : Expression + alternative Lambda: + child range : {Range} + child patterns : Patterns + child expression : Expression + visit 0: + local nmLev : _ + alternative Let: + child range : {Range} + child isStrict : {Bool} + child declarations : Declarations + child expression : Expression + visit 0: + local nmLev : _ + alternative Tuple: + child range : {Range} + child expressions : Expressions + alternative Typed: + child range : {Range} + child expression : Expression + child type : Type + alternative Negate: + child range : {Range} + child expression : Expression + alternative Annotate: + child range : {Range} + child annotation : ExpressionAnnotation + child expression : Expression + alternative ImpredicativeApplication: + child range : {Range} + child function : Expression + child arguments : Expressions + alternative If: + child range : {Range} + child guardExpression : Expression + child thenExpression : Expression + child elseExpression : Expression + alternative Case: + child range : {Range} + child expression : Expression + child alternatives : Alternatives + alternative List: + child range : {Range} + child expressions : Expressions + alternative Enum: + child range : {Range} + child from : Expression + child then : MaybeExpression + child to : MaybeExpression + alternative Comprehension: + child range : {Range} + child expression : Expression + child qualifiers : Qualifiers + alternative RecordConstruction: + child range : {Range} + child name : {Name} + child recordExpressionBindings : RecordExpressionBindings + alternative RecordUpdate: + child range : {Range} + child expression : Expression + child recordExpressionBindings : RecordExpressionBindings + alternative RowRecordUpdate: + child range : {Range} + child expression : Expression + child rowRecordExpressionUpdates : RowRecordExpressionUpdates + alternative RowRecordEmpty: + child range : {Range} + alternative RowRecordSelect: + child range : {Range} + child expression : Expression + child name : {Name} + alternative Do: + child range : {Range} + child statements : Statements + alternative ImplicitApplication: + child range : {Range} + child function : Expression + child arguments : ContextedExpressions + alternative ImplicitLambda: + child range : {Range} + child patterns : ContextedPatterns + child expression : Expression +-} +-- cata +sem_Expression :: Expression -> + T_Expression +sem_Expression (Expression_Literal _range _literal) = + (sem_Expression_Literal _range (sem_Literal _literal)) +sem_Expression (Expression_Variable _range _name) = + (sem_Expression_Variable _range _name) +sem_Expression (Expression_Constructor _range _name) = + (sem_Expression_Constructor _range _name) +sem_Expression (Expression_TupleConstructor _range _arity) = + (sem_Expression_TupleConstructor _range _arity) +sem_Expression (Expression_Parenthesized _range _expression) = + (sem_Expression_Parenthesized _range (sem_Expression _expression)) +sem_Expression (Expression_NormalApplication _range _function _arguments) = + (sem_Expression_NormalApplication _range (sem_Expression _function) (sem_Expressions _arguments)) +sem_Expression (Expression_SectionApplication _range _leftExpression _operator _rightExpression) = + (sem_Expression_SectionApplication _range (sem_MaybeExpression _leftExpression) (sem_Expression _operator) (sem_MaybeExpression _rightExpression)) +sem_Expression (Expression_InfixApplication _range _leftExpression _operator _rightExpression) = + (sem_Expression_InfixApplication _range (sem_Expression _leftExpression) (sem_Expression _operator) (sem_Expression _rightExpression)) +sem_Expression (Expression_InfixApplicationChainTop _range _expression) = + (sem_Expression_InfixApplicationChainTop _range (sem_Expression _expression)) +sem_Expression (Expression_Lambda _range _patterns _expression) = + (sem_Expression_Lambda _range (sem_Patterns _patterns) (sem_Expression _expression)) +sem_Expression (Expression_Let _range _isStrict _declarations _expression) = + (sem_Expression_Let _range _isStrict (sem_Declarations _declarations) (sem_Expression _expression)) +sem_Expression (Expression_Tuple _range _expressions) = + (sem_Expression_Tuple _range (sem_Expressions _expressions)) +sem_Expression (Expression_Typed _range _expression _type) = + (sem_Expression_Typed _range (sem_Expression _expression) (sem_Type _type)) +sem_Expression (Expression_Negate _range _expression) = + (sem_Expression_Negate _range (sem_Expression _expression)) +sem_Expression (Expression_Annotate _range _annotation _expression) = + (sem_Expression_Annotate _range (sem_ExpressionAnnotation _annotation) (sem_Expression _expression)) +sem_Expression (Expression_ImpredicativeApplication _range _function _arguments) = + (sem_Expression_ImpredicativeApplication _range (sem_Expression _function) (sem_Expressions _arguments)) +sem_Expression (Expression_If _range _guardExpression _thenExpression _elseExpression) = + (sem_Expression_If _range (sem_Expression _guardExpression) (sem_Expression _thenExpression) (sem_Expression _elseExpression)) +sem_Expression (Expression_Case _range _expression _alternatives) = + (sem_Expression_Case _range (sem_Expression _expression) (sem_Alternatives _alternatives)) +sem_Expression (Expression_List _range _expressions) = + (sem_Expression_List _range (sem_Expressions _expressions)) +sem_Expression (Expression_Enum _range _from _then _to) = + (sem_Expression_Enum _range (sem_Expression _from) (sem_MaybeExpression _then) (sem_MaybeExpression _to)) +sem_Expression (Expression_Comprehension _range _expression _qualifiers) = + (sem_Expression_Comprehension _range (sem_Expression _expression) (sem_Qualifiers _qualifiers)) +sem_Expression (Expression_RecordConstruction _range _name _recordExpressionBindings) = + (sem_Expression_RecordConstruction _range _name (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_RecordUpdate _range _expression _recordExpressionBindings) = + (sem_Expression_RecordUpdate _range (sem_Expression _expression) (sem_RecordExpressionBindings _recordExpressionBindings)) +sem_Expression (Expression_RowRecordUpdate _range _expression _rowRecordExpressionUpdates) = + (sem_Expression_RowRecordUpdate _range (sem_Expression _expression) (sem_RowRecordExpressionUpdates _rowRecordExpressionUpdates)) +sem_Expression (Expression_RowRecordEmpty _range) = + (sem_Expression_RowRecordEmpty _range) +sem_Expression (Expression_RowRecordSelect _range _expression _name) = + (sem_Expression_RowRecordSelect _range (sem_Expression _expression) _name) +sem_Expression (Expression_Do _range _statements) = + (sem_Expression_Do _range (sem_Statements _statements)) +sem_Expression (Expression_ImplicitApplication _range _function _arguments) = + (sem_Expression_ImplicitApplication _range (sem_Expression _function) (sem_ContextedExpressions _arguments)) +sem_Expression (Expression_ImplicitLambda _range _patterns _expression) = + (sem_Expression_ImplicitLambda _range (sem_ContextedPatterns _patterns) (sem_Expression _expression)) +-- semantic domain +type T_Expression = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( Name,UID,([HsName])) +sem_Expression_Literal :: Range -> + T_Literal -> + T_Expression +sem_Expression_Literal range_ literal_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _literalOgUniq :: UID + _literalOnmLev :: NmLev + _literalOtopInstanceNmL :: ([HsName]) + _literalIgUniq :: UID + _literalItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _literalIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _literalItopInstanceNmL + -- copy rule (down) + _literalOgUniq = + _lhsIgUniq + -- copy rule (down) + _literalOnmLev = + _lhsInmLev + -- copy rule (down) + _literalOtopInstanceNmL = + _lhsItopInstanceNmL + ( _literalIgUniq,_literalItopInstanceNmL) | True = + literal_ _literalOgUniq _literalOnmLev _literalOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Variable :: Range -> + Name -> + T_Expression +sem_Expression_Variable range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Constructor :: Range -> + Name -> + T_Expression +sem_Expression_Constructor range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 263, column 9) + _lhsOconNm = + name_ + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_TupleConstructor :: Range -> + Int -> + T_Expression +sem_Expression_TupleConstructor range_ arity_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Parenthesized :: Range -> + T_Expression -> + T_Expression +sem_Expression_Parenthesized range_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_NormalApplication :: Range -> + T_Expression -> + T_Expressions -> + T_Expression +sem_Expression_NormalApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIgUniq :: UID + _functionItopInstanceNmL :: ([HsName]) + _argumentsIgUniq :: UID + _argumentsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIgUniq,_functionItopInstanceNmL) | True = + function_ _functionOgUniq _functionOmoduleNm _functionOnmLev _functionOopts _functionOtopInstanceNmL + ( _argumentsIgUniq,_argumentsItopInstanceNmL) | True = + arguments_ _argumentsOgUniq _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_SectionApplication :: Range -> + T_MaybeExpression -> + T_Expression -> + T_MaybeExpression -> + T_Expression +sem_Expression_SectionApplication range_ leftExpression_ operator_ rightExpression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftExpressionOgUniq :: UID + _leftExpressionOmoduleNm :: HsName + _leftExpressionOnmLev :: NmLev + _leftExpressionOopts :: EHCOpts + _leftExpressionOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOmoduleNm :: HsName + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOtopInstanceNmL :: ([HsName]) + _rightExpressionOgUniq :: UID + _rightExpressionOmoduleNm :: HsName + _rightExpressionOnmLev :: NmLev + _rightExpressionOopts :: EHCOpts + _rightExpressionOtopInstanceNmL :: ([HsName]) + _leftExpressionIgUniq :: UID + _leftExpressionItopInstanceNmL :: ([HsName]) + _operatorIconNm :: Name + _operatorIgUniq :: UID + _operatorItopInstanceNmL :: ([HsName]) + _rightExpressionIgUniq :: UID + _rightExpressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rightExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightExpressionItopInstanceNmL + -- copy rule (down) + _leftExpressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _leftExpressionOopts = + _lhsIopts + -- copy rule (down) + _leftExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftExpressionIgUniq + -- copy rule (down) + _operatorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftExpressionItopInstanceNmL + -- copy rule (chain) + _rightExpressionOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _rightExpressionOopts = + _lhsIopts + -- copy rule (chain) + _rightExpressionOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftExpressionIgUniq,_leftExpressionItopInstanceNmL) | True = + leftExpression_ _leftExpressionOgUniq _leftExpressionOmoduleNm _leftExpressionOnmLev _leftExpressionOopts _leftExpressionOtopInstanceNmL + ( _operatorIconNm,_operatorIgUniq,_operatorItopInstanceNmL) | True = + operator_ _operatorOgUniq _operatorOmoduleNm _operatorOnmLev _operatorOopts _operatorOtopInstanceNmL + ( _rightExpressionIgUniq,_rightExpressionItopInstanceNmL) | True = + rightExpression_ _rightExpressionOgUniq _rightExpressionOmoduleNm _rightExpressionOnmLev _rightExpressionOopts _rightExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_InfixApplication :: Range -> + T_Expression -> + T_Expression -> + T_Expression -> + T_Expression +sem_Expression_InfixApplication range_ leftExpression_ operator_ rightExpression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftExpressionOgUniq :: UID + _leftExpressionOmoduleNm :: HsName + _leftExpressionOnmLev :: NmLev + _leftExpressionOopts :: EHCOpts + _leftExpressionOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOmoduleNm :: HsName + _operatorOnmLev :: NmLev + _operatorOopts :: EHCOpts + _operatorOtopInstanceNmL :: ([HsName]) + _rightExpressionOgUniq :: UID + _rightExpressionOmoduleNm :: HsName + _rightExpressionOnmLev :: NmLev + _rightExpressionOopts :: EHCOpts + _rightExpressionOtopInstanceNmL :: ([HsName]) + _leftExpressionIconNm :: Name + _leftExpressionIgUniq :: UID + _leftExpressionItopInstanceNmL :: ([HsName]) + _operatorIconNm :: Name + _operatorIgUniq :: UID + _operatorItopInstanceNmL :: ([HsName]) + _rightExpressionIconNm :: Name + _rightExpressionIgUniq :: UID + _rightExpressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rightExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightExpressionItopInstanceNmL + -- copy rule (down) + _leftExpressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _leftExpressionOopts = + _lhsIopts + -- copy rule (down) + _leftExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftExpressionIgUniq + -- copy rule (down) + _operatorOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (down) + _operatorOopts = + _lhsIopts + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftExpressionItopInstanceNmL + -- copy rule (chain) + _rightExpressionOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _rightExpressionOopts = + _lhsIopts + -- copy rule (chain) + _rightExpressionOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftExpressionIconNm,_leftExpressionIgUniq,_leftExpressionItopInstanceNmL) | True = + leftExpression_ _leftExpressionOgUniq _leftExpressionOmoduleNm _leftExpressionOnmLev _leftExpressionOopts _leftExpressionOtopInstanceNmL + ( _operatorIconNm,_operatorIgUniq,_operatorItopInstanceNmL) | True = + operator_ _operatorOgUniq _operatorOmoduleNm _operatorOnmLev _operatorOopts _operatorOtopInstanceNmL + ( _rightExpressionIconNm,_rightExpressionIgUniq,_rightExpressionItopInstanceNmL) | True = + rightExpression_ _rightExpressionOgUniq _rightExpressionOmoduleNm _rightExpressionOnmLev _rightExpressionOopts _rightExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_InfixApplicationChainTop :: Range -> + T_Expression -> + T_Expression +sem_Expression_InfixApplicationChainTop range_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Lambda :: Range -> + T_Patterns -> + T_Expression -> + T_Expression +sem_Expression_Lambda range_ patterns_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 50, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternsOnmLev = + _nmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _patternsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Let :: Range -> + Bool -> + T_Declarations -> + T_Expression -> + T_Expression +sem_Expression_Let range_ isStrict_ declarations_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOgUniq :: UID + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _declarationsIgUniq :: UID + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsImainValExists :: Bool + _declarationsImodDefsRel :: ModEntRel + _declarationsImodHideDefsRel :: ModEntRel + _declarationsItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 50, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _declarationsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _declarationsItopInstanceNmL + ( _declarationsIgUniq,_declarationsIgathPragmas,_declarationsIidOccDefs,_declarationsImainValExists,_declarationsImodDefsRel,_declarationsImodHideDefsRel,_declarationsItopInstanceNmL) | True = + declarations_ _declarationsOgUniq _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Tuple :: Range -> + T_Expressions -> + T_Expression +sem_Expression_Tuple range_ expressions_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionsOgUniq :: UID + _expressionsOmoduleNm :: HsName + _expressionsOnmLev :: NmLev + _expressionsOopts :: EHCOpts + _expressionsOtopInstanceNmL :: ([HsName]) + _expressionsIgUniq :: UID + _expressionsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionsItopInstanceNmL + -- copy rule (down) + _expressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionsOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionsOopts = + _lhsIopts + -- copy rule (down) + _expressionsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionsIgUniq,_expressionsItopInstanceNmL) | True = + expressions_ _expressionsOgUniq _expressionsOmoduleNm _expressionsOnmLev _expressionsOopts _expressionsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Typed :: Range -> + T_Expression -> + T_Type -> + T_Expression +sem_Expression_Typed range_ expression_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _typeOnmLev :: NmLev + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 52, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _expressionIgUniq + -- copy rule (chain) + _typeOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Negate :: Range -> + T_Expression -> + T_Expression +sem_Expression_Negate range_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Annotate :: Range -> + T_ExpressionAnnotation -> + T_Expression -> + T_Expression +sem_Expression_Annotate range_ annotation_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOgUniq :: UID + _annotationOmoduleNm :: HsName + _annotationOnmLev :: NmLev + _annotationOopts :: EHCOpts + _annotationOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _annotationIgUniq :: UID + _annotationItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOopts = + _lhsIopts + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _annotationIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIgUniq,_annotationItopInstanceNmL) | True = + annotation_ _annotationOgUniq _annotationOmoduleNm _annotationOnmLev _annotationOopts _annotationOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_ImpredicativeApplication :: Range -> + T_Expression -> + T_Expressions -> + T_Expression +sem_Expression_ImpredicativeApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIgUniq :: UID + _functionItopInstanceNmL :: ([HsName]) + _argumentsIgUniq :: UID + _argumentsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIgUniq,_functionItopInstanceNmL) | True = + function_ _functionOgUniq _functionOmoduleNm _functionOnmLev _functionOopts _functionOtopInstanceNmL + ( _argumentsIgUniq,_argumentsItopInstanceNmL) | True = + arguments_ _argumentsOgUniq _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_If :: Range -> + T_Expression -> + T_Expression -> + T_Expression -> + T_Expression +sem_Expression_If range_ guardExpression_ thenExpression_ elseExpression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardExpressionOgUniq :: UID + _guardExpressionOmoduleNm :: HsName + _guardExpressionOnmLev :: NmLev + _guardExpressionOopts :: EHCOpts + _guardExpressionOtopInstanceNmL :: ([HsName]) + _thenExpressionOgUniq :: UID + _thenExpressionOmoduleNm :: HsName + _thenExpressionOnmLev :: NmLev + _thenExpressionOopts :: EHCOpts + _thenExpressionOtopInstanceNmL :: ([HsName]) + _elseExpressionOgUniq :: UID + _elseExpressionOmoduleNm :: HsName + _elseExpressionOnmLev :: NmLev + _elseExpressionOopts :: EHCOpts + _elseExpressionOtopInstanceNmL :: ([HsName]) + _guardExpressionIconNm :: Name + _guardExpressionIgUniq :: UID + _guardExpressionItopInstanceNmL :: ([HsName]) + _thenExpressionIconNm :: Name + _thenExpressionIgUniq :: UID + _thenExpressionItopInstanceNmL :: ([HsName]) + _elseExpressionIconNm :: Name + _elseExpressionIgUniq :: UID + _elseExpressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _elseExpressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _elseExpressionItopInstanceNmL + -- copy rule (down) + _guardExpressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _guardExpressionOopts = + _lhsIopts + -- copy rule (down) + _guardExpressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _thenExpressionOgUniq = + _guardExpressionIgUniq + -- copy rule (down) + _thenExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _thenExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _thenExpressionOopts = + _lhsIopts + -- copy rule (chain) + _thenExpressionOtopInstanceNmL = + _guardExpressionItopInstanceNmL + -- copy rule (chain) + _elseExpressionOgUniq = + _thenExpressionIgUniq + -- copy rule (down) + _elseExpressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _elseExpressionOnmLev = + _lhsInmLev + -- copy rule (down) + _elseExpressionOopts = + _lhsIopts + -- copy rule (chain) + _elseExpressionOtopInstanceNmL = + _thenExpressionItopInstanceNmL + ( _guardExpressionIconNm,_guardExpressionIgUniq,_guardExpressionItopInstanceNmL) | True = + guardExpression_ _guardExpressionOgUniq _guardExpressionOmoduleNm _guardExpressionOnmLev _guardExpressionOopts _guardExpressionOtopInstanceNmL + ( _thenExpressionIconNm,_thenExpressionIgUniq,_thenExpressionItopInstanceNmL) | True = + thenExpression_ _thenExpressionOgUniq _thenExpressionOmoduleNm _thenExpressionOnmLev _thenExpressionOopts _thenExpressionOtopInstanceNmL + ( _elseExpressionIconNm,_elseExpressionIgUniq,_elseExpressionItopInstanceNmL) | True = + elseExpression_ _elseExpressionOgUniq _elseExpressionOmoduleNm _elseExpressionOnmLev _elseExpressionOopts _elseExpressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Case :: Range -> + T_Expression -> + T_Alternatives -> + T_Expression +sem_Expression_Case range_ expression_ alternatives_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _alternativesOgUniq :: UID + _alternativesOmoduleNm :: HsName + _alternativesOnmLev :: NmLev + _alternativesOopts :: EHCOpts + _alternativesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _alternativesIgUniq :: UID + _alternativesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _alternativesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _alternativesItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _alternativesOgUniq = + _expressionIgUniq + -- copy rule (down) + _alternativesOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _alternativesOnmLev = + _lhsInmLev + -- copy rule (down) + _alternativesOopts = + _lhsIopts + -- copy rule (chain) + _alternativesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _alternativesIgUniq,_alternativesItopInstanceNmL) | True = + alternatives_ _alternativesOgUniq _alternativesOmoduleNm _alternativesOnmLev _alternativesOopts _alternativesOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_List :: Range -> + T_Expressions -> + T_Expression +sem_Expression_List range_ expressions_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionsOgUniq :: UID + _expressionsOmoduleNm :: HsName + _expressionsOnmLev :: NmLev + _expressionsOopts :: EHCOpts + _expressionsOtopInstanceNmL :: ([HsName]) + _expressionsIgUniq :: UID + _expressionsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionsItopInstanceNmL + -- copy rule (down) + _expressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionsOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionsOopts = + _lhsIopts + -- copy rule (down) + _expressionsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionsIgUniq,_expressionsItopInstanceNmL) | True = + expressions_ _expressionsOgUniq _expressionsOmoduleNm _expressionsOnmLev _expressionsOopts _expressionsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Enum :: Range -> + T_Expression -> + T_MaybeExpression -> + T_MaybeExpression -> + T_Expression +sem_Expression_Enum range_ from_ then_ to_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _fromOgUniq :: UID + _fromOmoduleNm :: HsName + _fromOnmLev :: NmLev + _fromOopts :: EHCOpts + _fromOtopInstanceNmL :: ([HsName]) + _thenOgUniq :: UID + _thenOmoduleNm :: HsName + _thenOnmLev :: NmLev + _thenOopts :: EHCOpts + _thenOtopInstanceNmL :: ([HsName]) + _toOgUniq :: UID + _toOmoduleNm :: HsName + _toOnmLev :: NmLev + _toOopts :: EHCOpts + _toOtopInstanceNmL :: ([HsName]) + _fromIconNm :: Name + _fromIgUniq :: UID + _fromItopInstanceNmL :: ([HsName]) + _thenIgUniq :: UID + _thenItopInstanceNmL :: ([HsName]) + _toIgUniq :: UID + _toItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _toIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _toItopInstanceNmL + -- copy rule (down) + _fromOgUniq = + _lhsIgUniq + -- copy rule (down) + _fromOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _fromOnmLev = + _lhsInmLev + -- copy rule (down) + _fromOopts = + _lhsIopts + -- copy rule (down) + _fromOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _thenOgUniq = + _fromIgUniq + -- copy rule (down) + _thenOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _thenOnmLev = + _lhsInmLev + -- copy rule (down) + _thenOopts = + _lhsIopts + -- copy rule (chain) + _thenOtopInstanceNmL = + _fromItopInstanceNmL + -- copy rule (chain) + _toOgUniq = + _thenIgUniq + -- copy rule (down) + _toOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _toOnmLev = + _lhsInmLev + -- copy rule (down) + _toOopts = + _lhsIopts + -- copy rule (chain) + _toOtopInstanceNmL = + _thenItopInstanceNmL + ( _fromIconNm,_fromIgUniq,_fromItopInstanceNmL) | True = + from_ _fromOgUniq _fromOmoduleNm _fromOnmLev _fromOopts _fromOtopInstanceNmL + ( _thenIgUniq,_thenItopInstanceNmL) | True = + then_ _thenOgUniq _thenOmoduleNm _thenOnmLev _thenOopts _thenOtopInstanceNmL + ( _toIgUniq,_toItopInstanceNmL) | True = + to_ _toOgUniq _toOmoduleNm _toOnmLev _toOopts _toOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Comprehension :: Range -> + T_Expression -> + T_Qualifiers -> + T_Expression +sem_Expression_Comprehension range_ expression_ qualifiers_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _qualifiersOgUniq :: UID + _qualifiersOmoduleNm :: HsName + _qualifiersOnmLev :: NmLev + _qualifiersOopts :: EHCOpts + _qualifiersOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _qualifiersIgUniq :: UID + _qualifiersItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _qualifiersIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _qualifiersItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _qualifiersOgUniq = + _expressionIgUniq + -- copy rule (down) + _qualifiersOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _qualifiersOnmLev = + _lhsInmLev + -- copy rule (down) + _qualifiersOopts = + _lhsIopts + -- copy rule (chain) + _qualifiersOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _qualifiersIgUniq,_qualifiersItopInstanceNmL) | True = + qualifiers_ _qualifiersOgUniq _qualifiersOmoduleNm _qualifiersOnmLev _qualifiersOopts _qualifiersOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_RecordConstruction :: Range -> + Name -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordConstruction range_ name_ recordExpressionBindings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsOgUniq :: UID + _recordExpressionBindingsOmoduleNm :: HsName + _recordExpressionBindingsOnmLev :: NmLev + _recordExpressionBindingsOopts :: EHCOpts + _recordExpressionBindingsOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsIgUniq :: UID + _recordExpressionBindingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _recordExpressionBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordExpressionBindingsItopInstanceNmL + -- copy rule (down) + _recordExpressionBindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _recordExpressionBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordExpressionBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordExpressionBindingsOopts = + _lhsIopts + -- copy rule (down) + _recordExpressionBindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _recordExpressionBindingsIgUniq,_recordExpressionBindingsItopInstanceNmL) | True = + recordExpressionBindings_ _recordExpressionBindingsOgUniq _recordExpressionBindingsOmoduleNm _recordExpressionBindingsOnmLev _recordExpressionBindingsOopts _recordExpressionBindingsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_RecordUpdate :: Range -> + T_Expression -> + T_RecordExpressionBindings -> + T_Expression +sem_Expression_RecordUpdate range_ expression_ recordExpressionBindings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _recordExpressionBindingsOgUniq :: UID + _recordExpressionBindingsOmoduleNm :: HsName + _recordExpressionBindingsOnmLev :: NmLev + _recordExpressionBindingsOopts :: EHCOpts + _recordExpressionBindingsOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _recordExpressionBindingsIgUniq :: UID + _recordExpressionBindingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _recordExpressionBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordExpressionBindingsItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _recordExpressionBindingsOgUniq = + _expressionIgUniq + -- copy rule (down) + _recordExpressionBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordExpressionBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordExpressionBindingsOopts = + _lhsIopts + -- copy rule (chain) + _recordExpressionBindingsOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _recordExpressionBindingsIgUniq,_recordExpressionBindingsItopInstanceNmL) | True = + recordExpressionBindings_ _recordExpressionBindingsOgUniq _recordExpressionBindingsOmoduleNm _recordExpressionBindingsOnmLev _recordExpressionBindingsOopts _recordExpressionBindingsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_RowRecordUpdate :: Range -> + T_Expression -> + T_RowRecordExpressionUpdates -> + T_Expression +sem_Expression_RowRecordUpdate range_ expression_ rowRecordExpressionUpdates_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _rowRecordExpressionUpdatesOgUniq :: UID + _rowRecordExpressionUpdatesOmoduleNm :: HsName + _rowRecordExpressionUpdatesOnmLev :: NmLev + _rowRecordExpressionUpdatesOopts :: EHCOpts + _rowRecordExpressionUpdatesOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _rowRecordExpressionUpdatesIgUniq :: UID + _rowRecordExpressionUpdatesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rowRecordExpressionUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowRecordExpressionUpdatesItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rowRecordExpressionUpdatesOgUniq = + _expressionIgUniq + -- copy rule (down) + _rowRecordExpressionUpdatesOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rowRecordExpressionUpdatesOnmLev = + _lhsInmLev + -- copy rule (down) + _rowRecordExpressionUpdatesOopts = + _lhsIopts + -- copy rule (chain) + _rowRecordExpressionUpdatesOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _rowRecordExpressionUpdatesIgUniq,_rowRecordExpressionUpdatesItopInstanceNmL) | True = + rowRecordExpressionUpdates_ _rowRecordExpressionUpdatesOgUniq _rowRecordExpressionUpdatesOmoduleNm _rowRecordExpressionUpdatesOnmLev _rowRecordExpressionUpdatesOopts _rowRecordExpressionUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_RowRecordEmpty :: Range -> + T_Expression +sem_Expression_RowRecordEmpty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_RowRecordSelect :: Range -> + T_Expression -> + Name -> + T_Expression +sem_Expression_RowRecordSelect range_ expression_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_Do :: Range -> + T_Statements -> + T_Expression +sem_Expression_Do range_ statements_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _statementsOgUniq :: UID + _statementsOmoduleNm :: HsName + _statementsOnmLev :: NmLev + _statementsOopts :: EHCOpts + _statementsOtopInstanceNmL :: ([HsName]) + _statementsIgUniq :: UID + _statementsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _statementsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _statementsItopInstanceNmL + -- copy rule (down) + _statementsOgUniq = + _lhsIgUniq + -- copy rule (down) + _statementsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _statementsOnmLev = + _lhsInmLev + -- copy rule (down) + _statementsOopts = + _lhsIopts + -- copy rule (down) + _statementsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _statementsIgUniq,_statementsItopInstanceNmL) | True = + statements_ _statementsOgUniq _statementsOmoduleNm _statementsOnmLev _statementsOopts _statementsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_ImplicitApplication :: Range -> + T_Expression -> + T_ContextedExpressions -> + T_Expression +sem_Expression_ImplicitApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOmoduleNm :: HsName + _functionOnmLev :: NmLev + _functionOopts :: EHCOpts + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOmoduleNm :: HsName + _argumentsOnmLev :: NmLev + _argumentsOopts :: EHCOpts + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIgUniq :: UID + _functionItopInstanceNmL :: ([HsName]) + _argumentsIgUniq :: UID + _argumentsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOopts = + _lhsIopts + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (down) + _argumentsOopts = + _lhsIopts + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIgUniq,_functionItopInstanceNmL) | True = + function_ _functionOgUniq _functionOmoduleNm _functionOnmLev _functionOopts _functionOtopInstanceNmL + ( _argumentsIgUniq,_argumentsItopInstanceNmL) | True = + arguments_ _argumentsOgUniq _argumentsOmoduleNm _argumentsOnmLev _argumentsOopts _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expression_ImplicitLambda :: Range -> + T_ContextedPatterns -> + T_Expression -> + T_Expression +sem_Expression_ImplicitLambda range_ patterns_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 265, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _patternsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- ExpressionAnnotation ---------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Empty: +-} +-- cata +sem_ExpressionAnnotation :: ExpressionAnnotation -> + T_ExpressionAnnotation +sem_ExpressionAnnotation (ExpressionAnnotation_Empty) = + (sem_ExpressionAnnotation_Empty) +-- semantic domain +type T_ExpressionAnnotation = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_ExpressionAnnotation_Empty :: T_ExpressionAnnotation +sem_ExpressionAnnotation_Empty = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Expressions ------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Expression + child tl : Expressions + alternative Nil: +-} +-- cata +sem_Expressions :: Expressions -> + T_Expressions +sem_Expressions list = + (Prelude.foldr sem_Expressions_Cons sem_Expressions_Nil (Prelude.map sem_Expression list)) +-- semantic domain +type T_Expressions = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_Expressions_Cons :: T_Expression -> + T_Expressions -> + T_Expressions +sem_Expressions_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIconNm :: Name + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconNm,_hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Expressions_Nil :: T_Expressions +sem_Expressions_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- FieldDeclaration -------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + fldrefnames : Names + alternatives: + alternative FieldDeclaration: + child range : {Range} + child names : {Names} + child type : Type + visit 0: + local fldrefnames : _ + local nmLev : _ +-} +-- cata +sem_FieldDeclaration :: FieldDeclaration -> + T_FieldDeclaration +sem_FieldDeclaration (FieldDeclaration_FieldDeclaration _range _names _type) = + (sem_FieldDeclaration_FieldDeclaration _range _names (sem_Type _type)) +-- semantic domain +type T_FieldDeclaration = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( Names,UID,([HsName])) +sem_FieldDeclaration_FieldDeclaration :: Range -> + Names -> + T_Type -> + T_FieldDeclaration +sem_FieldDeclaration_FieldDeclaration range_ names_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOfldrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 83, column 9) + _fldrefnames = + map (hsnSetLevQual _lhsInmLev _lhsImoduleNm) names_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 42, column 9) + _nmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + _fldrefnames + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOfldrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- FieldDeclarations ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + fldrefnames : Names + alternatives: + alternative Cons: + child hd : FieldDeclaration + child tl : FieldDeclarations + alternative Nil: +-} +-- cata +sem_FieldDeclarations :: FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations list = + (Prelude.foldr sem_FieldDeclarations_Cons sem_FieldDeclarations_Nil (Prelude.map sem_FieldDeclaration list)) +-- semantic domain +type T_FieldDeclarations = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( Names,UID,([HsName])) +sem_FieldDeclarations_Cons :: T_FieldDeclaration -> + T_FieldDeclarations -> + T_FieldDeclarations +sem_FieldDeclarations_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOfldrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIfldrefnames :: Names + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIfldrefnames :: Names + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + _hdIfldrefnames ++ _tlIfldrefnames + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIfldrefnames,_hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIfldrefnames,_tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOfldrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_FieldDeclarations_Nil :: T_FieldDeclarations +sem_FieldDeclarations_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOfldrefnames :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 78, column 44) + _lhsOfldrefnames = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOfldrefnames,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- FunctionBinding --------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + mainValExists : Bool + alternatives: + alternative FunctionBinding: + child range : {Range} + child lefthandside : LeftHandSide + child righthandside : RightHandSide + visit 0: + local idOccDef : _ + local idOccDefs : _ + local nmLev : _ + local nmLevFun : _ +-} +-- cata +sem_FunctionBinding :: FunctionBinding -> + T_FunctionBinding +sem_FunctionBinding (FunctionBinding_FunctionBinding _range _lefthandside _righthandside) = + (sem_FunctionBinding_FunctionBinding _range (sem_LeftHandSide _lefthandside) (sem_RightHandSide _righthandside)) +-- semantic domain +type T_FunctionBinding = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([IdOcc]),Bool,([HsName])) +sem_FunctionBinding_FunctionBinding :: Range -> + T_LeftHandSide -> + T_RightHandSide -> + T_FunctionBinding +sem_FunctionBinding_FunctionBinding range_ lefthandside_ righthandside_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOgUniq :: UID + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOtopInstanceNmL :: ([HsName]) + _righthandsideOgUniq :: UID + _righthandsideOmoduleNm :: HsName + _righthandsideOnmLev :: NmLev + _righthandsideOopts :: EHCOpts + _righthandsideOtopInstanceNmL :: ([HsName]) + _lefthandsideIgUniq :: UID + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideImainValExists :: Bool + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _righthandsideIgUniq :: UID + _righthandsideItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 169, column 9) + _idOccDef = + IdOcc _lefthandsideIrefname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 169, column 9) + _idOccDefs = + [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 64, column 9) + _nmLev = + _lhsInmLev + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 64, column 9) + _nmLevFun = + _lhsInmLev + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _lefthandsideImainValExists + -- copy rule (up) + _lhsOgUniq = + _righthandsideIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _righthandsideItopInstanceNmL + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _lefthandsideOnmLev = + _nmLev + -- copy rule (from local) + _lefthandsideOnmLevFun = + _nmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _righthandsideOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _righthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _righthandsideOnmLev = + _nmLev + -- copy rule (down) + _righthandsideOopts = + _lhsIopts + -- copy rule (chain) + _righthandsideOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIgUniq,_lefthandsideIidOccDefs,_lefthandsideImainValExists,_lefthandsideIrefname,_lefthandsideItopInstanceNmL) | True = + lefthandside_ _lefthandsideOgUniq _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOtopInstanceNmL + ( _righthandsideIgUniq,_righthandsideItopInstanceNmL) | True = + righthandside_ _righthandsideOgUniq _righthandsideOmoduleNm _righthandsideOnmLev _righthandsideOopts _righthandsideOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +-- FunctionBindings -------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + mainValExists : Bool + alternatives: + alternative Cons: + child hd : FunctionBinding + child tl : FunctionBindings + alternative Nil: +-} +-- cata +sem_FunctionBindings :: FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings list = + (Prelude.foldr sem_FunctionBindings_Cons sem_FunctionBindings_Nil (Prelude.map sem_FunctionBinding list)) +-- semantic domain +type T_FunctionBindings = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([IdOcc]),Bool,([HsName])) +sem_FunctionBindings_Cons :: T_FunctionBinding -> + T_FunctionBindings -> + T_FunctionBindings +sem_FunctionBindings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIidOccDefs :: ([IdOcc]) + _hdImainValExists :: Bool + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIidOccDefs :: ([IdOcc]) + _tlImainValExists :: Bool + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _hdImainValExists || _tlImainValExists + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIidOccDefs,_hdImainValExists,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlIidOccDefs,_tlImainValExists,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +sem_FunctionBindings_Nil :: T_FunctionBindings +sem_FunctionBindings_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +-- FunctionalDependencies -------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + alternatives: + alternative Cons: + child hd : FunctionalDependency + child tl : FunctionalDependencies + alternative Nil: +-} +-- cata +sem_FunctionalDependencies :: FunctionalDependencies -> + T_FunctionalDependencies +sem_FunctionalDependencies list = + (Prelude.foldr sem_FunctionalDependencies_Cons sem_FunctionalDependencies_Nil (Prelude.map sem_FunctionalDependency list)) +-- semantic domain +type T_FunctionalDependencies = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),([HsName])) +sem_FunctionalDependencies_Cons :: T_FunctionalDependency -> + T_FunctionalDependencies -> + T_FunctionalDependencies +sem_FunctionalDependencies_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdIidOccDefs :: ([IdOcc]) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlIidOccDefs :: ([IdOcc]) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIgathPragmas,_hdIidOccDefs,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlIgathPragmas,_tlIidOccDefs,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +sem_FunctionalDependencies_Nil :: T_FunctionalDependencies +sem_FunctionalDependencies_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- FunctionalDependency ---------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + alternatives: + alternative Dependency: + child range : {Range} + child fromtypevariables : {Names} + child totypevariables : {Names} +-} +-- cata +sem_FunctionalDependency :: FunctionalDependency -> + T_FunctionalDependency +sem_FunctionalDependency (FunctionalDependency_Dependency _range _fromtypevariables _totypevariables) = + (sem_FunctionalDependency_Dependency _range _fromtypevariables _totypevariables) +-- semantic domain +type T_FunctionalDependency = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),([HsName])) +sem_FunctionalDependency_Dependency :: Range -> + Names -> + Names -> + T_FunctionalDependency +sem_FunctionalDependency_Dependency range_ fromtypevariables_ totypevariables_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- GuardedExpression ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative GuardedExpression: + child range : {Range} + child guard : Expression + child expression : Expression +-} +-- cata +sem_GuardedExpression :: GuardedExpression -> + T_GuardedExpression +sem_GuardedExpression (GuardedExpression_GuardedExpression _range _guard _expression) = + (sem_GuardedExpression_GuardedExpression _range (sem_Expression _guard) (sem_Expression _expression)) +-- semantic domain +type T_GuardedExpression = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_GuardedExpression_GuardedExpression :: Range -> + T_Expression -> + T_Expression -> + T_GuardedExpression +sem_GuardedExpression_GuardedExpression range_ guard_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardOgUniq :: UID + _guardOmoduleNm :: HsName + _guardOnmLev :: NmLev + _guardOopts :: EHCOpts + _guardOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _guardIconNm :: Name + _guardIgUniq :: UID + _guardItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _guardOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardOnmLev = + _lhsInmLev + -- copy rule (down) + _guardOopts = + _lhsIopts + -- copy rule (down) + _guardOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _guardIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _guardItopInstanceNmL + ( _guardIconNm,_guardIgUniq,_guardItopInstanceNmL) | True = + guard_ _guardOgUniq _guardOmoduleNm _guardOnmLev _guardOopts _guardOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- GuardedExpressions ------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : GuardedExpression + child tl : GuardedExpressions + alternative Nil: +-} +-- cata +sem_GuardedExpressions :: GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions list = + (Prelude.foldr sem_GuardedExpressions_Cons sem_GuardedExpressions_Nil (Prelude.map sem_GuardedExpression list)) +-- semantic domain +type T_GuardedExpressions = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_GuardedExpressions_Cons :: T_GuardedExpression -> + T_GuardedExpressions -> + T_GuardedExpressions +sem_GuardedExpressions_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_GuardedExpressions_Nil :: T_GuardedExpressions +sem_GuardedExpressions_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Import ------------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modEntSpec : ModEntSpec + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + alternative TypeOrClass: + child range : {Range} + child name : {Name} + child names : {MaybeNames} + alternative TypeOrClassComplete: + child range : {Range} + child name : {Name} +-} +-- cata +sem_Import :: Import -> + T_Import +sem_Import (Import_Variable _range _name) = + (sem_Import_Variable _range _name) +sem_Import (Import_TypeOrClass _range _name _names) = + (sem_Import_TypeOrClass _range _name _names) +sem_Import (Import_TypeOrClassComplete _range _name) = + (sem_Import_TypeOrClassComplete _range _name) +-- semantic domain +type T_Import = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,ModEntSpec,([HsName])) +sem_Import_Variable :: Range -> + Name -> + T_Import +sem_Import_Variable range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpec :: ModEntSpec + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 5, column 9) + _lhsOmodEntSpec = + ModEntSpec name_ range_ Nothing + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodEntSpec,_lhsOtopInstanceNmL))) +sem_Import_TypeOrClass :: Range -> + Name -> + MaybeNames -> + T_Import +sem_Import_TypeOrClass range_ name_ names_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpec :: ModEntSpec + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 7, column 9) + _lhsOmodEntSpec = + case names_ of + Just ns -> ModEntSpec name_ range_ (Just (ModEntSubs ns)) + Nothing -> ModEntSpec name_ range_ Nothing + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodEntSpec,_lhsOtopInstanceNmL))) +sem_Import_TypeOrClassComplete :: Range -> + Name -> + T_Import +sem_Import_TypeOrClassComplete range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpec :: ModEntSpec + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 11, column 9) + _lhsOmodEntSpec = + ModEntSpec name_ range_ (Just ModEntSubAll) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodEntSpec,_lhsOtopInstanceNmL))) +-- ImportDeclaration ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modImpL : [ModImp] + alternatives: + alternative Import: + child range : {Range} + child qualified : {Bool} + child name : {Name} + child asname : {MaybeName} + child importspecification : MaybeImportSpecification + alternative Empty: + child range : {Range} +-} +-- cata +sem_ImportDeclaration :: ImportDeclaration -> + T_ImportDeclaration +sem_ImportDeclaration (ImportDeclaration_Import _range _qualified _name _asname _importspecification) = + (sem_ImportDeclaration_Import _range _qualified _name _asname (sem_MaybeImportSpecification _importspecification)) +sem_ImportDeclaration (ImportDeclaration_Empty _range) = + (sem_ImportDeclaration_Empty _range) +-- semantic domain +type T_ImportDeclaration = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([ModImp]),([HsName])) +sem_ImportDeclaration_Import :: Range -> + Bool -> + Name -> + MaybeName -> + T_MaybeImportSpecification -> + T_ImportDeclaration +sem_ImportDeclaration_Import range_ qualified_ name_ asname_ importspecification_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _importspecificationOgUniq :: UID + _importspecificationOmoduleNm :: HsName + _importspecificationOnmLev :: NmLev + _importspecificationOopts :: EHCOpts + _importspecificationOtopInstanceNmL :: ([HsName]) + _importspecificationIgUniq :: UID + _importspecificationIisHiding :: Bool + _importspecificationImodEntSpecL :: ([ModEntSpec]) + _importspecificationItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 39, column 9) + _lhsOmodImpL = + let as = maybe name_ id asname_ + in [ModImp qualified_ name_ as _importspecificationIisHiding _importspecificationImodEntSpecL range_] + -- copy rule (up) + _lhsOgUniq = + _importspecificationIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _importspecificationItopInstanceNmL + -- copy rule (down) + _importspecificationOgUniq = + _lhsIgUniq + -- copy rule (down) + _importspecificationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importspecificationOnmLev = + _lhsInmLev + -- copy rule (down) + _importspecificationOopts = + _lhsIopts + -- copy rule (down) + _importspecificationOtopInstanceNmL = + _lhsItopInstanceNmL + ( _importspecificationIgUniq,_importspecificationIisHiding,_importspecificationImodEntSpecL,_importspecificationItopInstanceNmL) | True = + importspecification_ _importspecificationOgUniq _importspecificationOmoduleNm _importspecificationOnmLev _importspecificationOopts _importspecificationOtopInstanceNmL + in ( _lhsOgUniq,_lhsOmodImpL,_lhsOtopInstanceNmL))) +sem_ImportDeclaration_Empty :: Range -> + T_ImportDeclaration +sem_ImportDeclaration_Empty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 42, column 9) + _lhsOmodImpL = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodImpL,_lhsOtopInstanceNmL))) +-- ImportDeclarations ------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modImpL : [ModImp] + alternatives: + alternative Cons: + child hd : ImportDeclaration + child tl : ImportDeclarations + alternative Nil: +-} +-- cata +sem_ImportDeclarations :: ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations list = + (Prelude.foldr sem_ImportDeclarations_Cons sem_ImportDeclarations_Nil (Prelude.map sem_ImportDeclaration list)) +-- semantic domain +type T_ImportDeclarations = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([ModImp]),([HsName])) +sem_ImportDeclarations_Cons :: T_ImportDeclaration -> + T_ImportDeclarations -> + T_ImportDeclarations +sem_ImportDeclarations_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdImodImpL :: ([ModImp]) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlImodImpL :: ([ModImp]) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 35, column 46) + _lhsOmodImpL = + _hdImodImpL ++ _tlImodImpL + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdImodImpL,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlImodImpL,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOmodImpL,_lhsOtopInstanceNmL))) +sem_ImportDeclarations_Nil :: T_ImportDeclarations +sem_ImportDeclarations_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodImpL :: ([ModImp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 35, column 46) + _lhsOmodImpL = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodImpL,_lhsOtopInstanceNmL))) +-- ImportSpecification ----------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + isHiding : Bool + modEntSpecL : [ModEntSpec] + alternatives: + alternative Import: + child range : {Range} + child hiding : {Bool} + child imports : Imports +-} +-- cata +sem_ImportSpecification :: ImportSpecification -> + T_ImportSpecification +sem_ImportSpecification (ImportSpecification_Import _range _hiding _imports) = + (sem_ImportSpecification_Import _range _hiding (sem_Imports _imports)) +-- semantic domain +type T_ImportSpecification = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,Bool,([ModEntSpec]),([HsName])) +sem_ImportSpecification_Import :: Range -> + Bool -> + T_Imports -> + T_ImportSpecification +sem_ImportSpecification_Import range_ hiding_ imports_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOisHiding :: Bool + _lhsOgUniq :: UID + _lhsOmodEntSpecL :: ([ModEntSpec]) + _lhsOtopInstanceNmL :: ([HsName]) + _importsOgUniq :: UID + _importsOmoduleNm :: HsName + _importsOnmLev :: NmLev + _importsOopts :: EHCOpts + _importsOtopInstanceNmL :: ([HsName]) + _importsIgUniq :: UID + _importsImodEntSpecL :: ([ModEntSpec]) + _importsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 29, column 9) + _lhsOisHiding = + hiding_ + -- copy rule (up) + _lhsOgUniq = + _importsIgUniq + -- copy rule (up) + _lhsOmodEntSpecL = + _importsImodEntSpecL + -- copy rule (up) + _lhsOtopInstanceNmL = + _importsItopInstanceNmL + -- copy rule (down) + _importsOgUniq = + _lhsIgUniq + -- copy rule (down) + _importsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _importsOnmLev = + _lhsInmLev + -- copy rule (down) + _importsOopts = + _lhsIopts + -- copy rule (down) + _importsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _importsIgUniq,_importsImodEntSpecL,_importsItopInstanceNmL) | True = + imports_ _importsOgUniq _importsOmoduleNm _importsOnmLev _importsOopts _importsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOisHiding,_lhsOmodEntSpecL,_lhsOtopInstanceNmL))) +-- Imports ----------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modEntSpecL : [ModEntSpec] + alternatives: + alternative Cons: + child hd : Import + child tl : Imports + alternative Nil: +-} +-- cata +sem_Imports :: Imports -> + T_Imports +sem_Imports list = + (Prelude.foldr sem_Imports_Cons sem_Imports_Nil (Prelude.map sem_Import list)) +-- semantic domain +type T_Imports = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([ModEntSpec]),([HsName])) +sem_Imports_Cons :: T_Import -> + T_Imports -> + T_Imports +sem_Imports_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpecL :: ([ModEntSpec]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdImodEntSpec :: ModEntSpec + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlImodEntSpecL :: ([ModEntSpec]) + _tlItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 17, column 9) + _lhsOmodEntSpecL = + _hdImodEntSpec : _tlImodEntSpecL + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdImodEntSpec,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlImodEntSpecL,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOmodEntSpecL,_lhsOtopInstanceNmL))) +sem_Imports_Nil :: T_Imports +sem_Imports_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpecL :: ([ModEntSpec]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 19, column 9) + _lhsOmodEntSpecL = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodEntSpecL,_lhsOtopInstanceNmL))) +-- Kind -------------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative NormalApplication: + child range : {Range} + child function : Kind + child arguments : Kinds + alternative InfixApplication: + child range : {Range} + child leftKind : Kind + child operator : Kind + child rightKind : Kind + alternative Constructor: + child range : {Range} + child name : {Name} + alternative Parenthesized: + child range : {Range} + child kind : Kind + alternative Variable: + child range : {Range} + child name : {Name} + alternative Forall: + child range : {Range} + child kindvariables : {Names} + child kind : Kind + alternative Annotate: + child range : {Range} + child annotation : KindAnnotation + child kind : Kind +-} +-- cata +sem_Kind :: Kind -> + T_Kind +sem_Kind (Kind_NormalApplication _range _function _arguments) = + (sem_Kind_NormalApplication _range (sem_Kind _function) (sem_Kinds _arguments)) +sem_Kind (Kind_InfixApplication _range _leftKind _operator _rightKind) = + (sem_Kind_InfixApplication _range (sem_Kind _leftKind) (sem_Kind _operator) (sem_Kind _rightKind)) +sem_Kind (Kind_Constructor _range _name) = + (sem_Kind_Constructor _range _name) +sem_Kind (Kind_Parenthesized _range _kind) = + (sem_Kind_Parenthesized _range (sem_Kind _kind)) +sem_Kind (Kind_Variable _range _name) = + (sem_Kind_Variable _range _name) +sem_Kind (Kind_Forall _range _kindvariables _kind) = + (sem_Kind_Forall _range _kindvariables (sem_Kind _kind)) +sem_Kind (Kind_Annotate _range _annotation _kind) = + (sem_Kind_Annotate _range (sem_KindAnnotation _annotation) (sem_Kind _kind)) +-- semantic domain +type T_Kind = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_Kind_NormalApplication :: Range -> + T_Kind -> + T_Kinds -> + T_Kind +sem_Kind_NormalApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOnmLev :: NmLev + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOnmLev :: NmLev + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIgUniq :: UID + _functionItopInstanceNmL :: ([HsName]) + _argumentsIgUniq :: UID + _argumentsItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIgUniq,_functionItopInstanceNmL) | True = + function_ _functionOgUniq _functionOnmLev _functionOtopInstanceNmL + ( _argumentsIgUniq,_argumentsItopInstanceNmL) | True = + arguments_ _argumentsOgUniq _argumentsOnmLev _argumentsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_InfixApplication :: Range -> + T_Kind -> + T_Kind -> + T_Kind -> + T_Kind +sem_Kind_InfixApplication range_ leftKind_ operator_ rightKind_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftKindOgUniq :: UID + _leftKindOnmLev :: NmLev + _leftKindOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOnmLev :: NmLev + _operatorOtopInstanceNmL :: ([HsName]) + _rightKindOgUniq :: UID + _rightKindOnmLev :: NmLev + _rightKindOtopInstanceNmL :: ([HsName]) + _leftKindIgUniq :: UID + _leftKindItopInstanceNmL :: ([HsName]) + _operatorIgUniq :: UID + _operatorItopInstanceNmL :: ([HsName]) + _rightKindIgUniq :: UID + _rightKindItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _rightKindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightKindItopInstanceNmL + -- copy rule (down) + _leftKindOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftKindOnmLev = + _lhsInmLev + -- copy rule (down) + _leftKindOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftKindIgUniq + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftKindItopInstanceNmL + -- copy rule (chain) + _rightKindOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightKindOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightKindOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftKindIgUniq,_leftKindItopInstanceNmL) | True = + leftKind_ _leftKindOgUniq _leftKindOnmLev _leftKindOtopInstanceNmL + ( _operatorIgUniq,_operatorItopInstanceNmL) | True = + operator_ _operatorOgUniq _operatorOnmLev _operatorOtopInstanceNmL + ( _rightKindIgUniq,_rightKindItopInstanceNmL) | True = + rightKind_ _rightKindOgUniq _rightKindOnmLev _rightKindOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_Constructor :: Range -> + Name -> + T_Kind +sem_Kind_Constructor range_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_Parenthesized :: Range -> + T_Kind -> + T_Kind +sem_Kind_Parenthesized range_ kind_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOnmLev :: NmLev + _kindOtopInstanceNmL :: ([HsName]) + _kindIgUniq :: UID + _kindItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIgUniq,_kindItopInstanceNmL) | True = + kind_ _kindOgUniq _kindOnmLev _kindOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_Variable :: Range -> + Name -> + T_Kind +sem_Kind_Variable range_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_Forall :: Range -> + Names -> + T_Kind -> + T_Kind +sem_Kind_Forall range_ kindvariables_ kind_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOnmLev :: NmLev + _kindOtopInstanceNmL :: ([HsName]) + _kindIgUniq :: UID + _kindItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _kindOgUniq = + _lhsIgUniq + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (down) + _kindOtopInstanceNmL = + _lhsItopInstanceNmL + ( _kindIgUniq,_kindItopInstanceNmL) | True = + kind_ _kindOgUniq _kindOnmLev _kindOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kind_Annotate :: Range -> + T_KindAnnotation -> + T_Kind -> + T_Kind +sem_Kind_Annotate range_ annotation_ kind_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOgUniq :: UID + _annotationOnmLev :: NmLev + _annotationOtopInstanceNmL :: ([HsName]) + _kindOgUniq :: UID + _kindOnmLev :: NmLev + _kindOtopInstanceNmL :: ([HsName]) + _annotationIgUniq :: UID + _annotationItopInstanceNmL :: ([HsName]) + _kindIgUniq :: UID + _kindItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _kindIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _kindItopInstanceNmL + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _kindOgUniq = + _annotationIgUniq + -- copy rule (down) + _kindOnmLev = + _lhsInmLev + -- copy rule (chain) + _kindOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIgUniq,_annotationItopInstanceNmL) | True = + annotation_ _annotationOgUniq _annotationOnmLev _annotationOtopInstanceNmL + ( _kindIgUniq,_kindItopInstanceNmL) | True = + kind_ _kindOgUniq _kindOnmLev _kindOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- KindAnnotation ---------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Empty: +-} +-- cata +sem_KindAnnotation :: KindAnnotation -> + T_KindAnnotation +sem_KindAnnotation (KindAnnotation_Empty) = + (sem_KindAnnotation_Empty) +-- semantic domain +type T_KindAnnotation = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_KindAnnotation_Empty :: T_KindAnnotation +sem_KindAnnotation_Empty = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Kinds ------------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Kind + child tl : Kinds + alternative Nil: +-} +-- cata +sem_Kinds :: Kinds -> + T_Kinds +sem_Kinds list = + (Prelude.foldr sem_Kinds_Cons sem_Kinds_Nil (Prelude.map sem_Kind list)) +-- semantic domain +type T_Kinds = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_Kinds_Cons :: T_Kind -> + T_Kinds -> + T_Kinds +sem_Kinds_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Kinds_Nil :: T_Kinds +sem_Kinds_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- LeftHandSide ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + nmLevFun : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + mainValExists : Bool + refname : HsName + alternatives: + alternative Function: + child range : {Range} + child name : {Name} + child patterns : Patterns + visit 0: + local refname : _ + local mainValExists : _ + alternative Infix: + child range : {Range} + child leftPattern : Pattern + child operator : {Name} + child rightPattern : Pattern + visit 0: + local refname : _ + alternative Parenthesized: + child range : {Range} + child lefthandside : LeftHandSide + child patterns : Patterns + alternative Typed: + child range : {Range} + child lefthandside : LeftHandSide + child type : Type +-} +-- cata +sem_LeftHandSide :: LeftHandSide -> + T_LeftHandSide +sem_LeftHandSide (LeftHandSide_Function _range _name _patterns) = + (sem_LeftHandSide_Function _range _name (sem_Patterns _patterns)) +sem_LeftHandSide (LeftHandSide_Infix _range _leftPattern _operator _rightPattern) = + (sem_LeftHandSide_Infix _range (sem_Pattern _leftPattern) _operator (sem_Pattern _rightPattern)) +sem_LeftHandSide (LeftHandSide_Parenthesized _range _lefthandside _patterns) = + (sem_LeftHandSide_Parenthesized _range (sem_LeftHandSide _lefthandside) (sem_Patterns _patterns)) +sem_LeftHandSide (LeftHandSide_Typed _range _lefthandside _type) = + (sem_LeftHandSide_Typed _range (sem_LeftHandSide _lefthandside) (sem_Type _type)) +-- semantic domain +type T_LeftHandSide = UID -> + HsName -> + NmLev -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([IdOcc]),Bool,HsName,([HsName])) +sem_LeftHandSide_Function :: Range -> + Name -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Function range_ name_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 47, column 9) + _refname = + hsnSetLevQual _lhsInmLevFun _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 79, column 9) + _mainValExists = + name_ == hsnMain + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _mainValExists + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (from local) + _lhsOrefname = + _refname + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOrefname,_lhsOtopInstanceNmL))) +sem_LeftHandSide_Infix :: Range -> + T_Pattern -> + Name -> + T_Pattern -> + T_LeftHandSide +sem_LeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOgUniq :: UID + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOgUniq :: UID + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIgUniq :: UID + _leftPatternIidOccDefs :: ([IdOcc]) + _leftPatternImainValExists :: Bool + _leftPatternImbTopRefname :: (Maybe HsName) + _leftPatternItopInstanceNmL :: ([HsName]) + _rightPatternIgUniq :: UID + _rightPatternIidOccDefs :: ([IdOcc]) + _rightPatternImainValExists :: Bool + _rightPatternImbTopRefname :: (Maybe HsName) + _rightPatternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 49, column 9) + _refname = + hsnSetLevQual _lhsInmLevFun _lhsImoduleNm operator_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _leftPatternIidOccDefs ++ _rightPatternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _leftPatternImainValExists || _rightPatternImainValExists + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (from local) + _lhsOrefname = + _refname + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIgUniq,_leftPatternIidOccDefs,_leftPatternImainValExists,_leftPatternImbTopRefname,_leftPatternItopInstanceNmL) | True = + leftPattern_ _leftPatternOgUniq _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOtopInstanceNmL + ( _rightPatternIgUniq,_rightPatternIidOccDefs,_rightPatternImainValExists,_rightPatternImbTopRefname,_rightPatternItopInstanceNmL) | True = + rightPattern_ _rightPatternOgUniq _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOrefname,_lhsOtopInstanceNmL))) +sem_LeftHandSide_Parenthesized :: Range -> + T_LeftHandSide -> + T_Patterns -> + T_LeftHandSide +sem_LeftHandSide_Parenthesized range_ lefthandside_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOgUniq :: UID + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _lefthandsideIgUniq :: UID + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideImainValExists :: Bool + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs ++ _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _lefthandsideImainValExists || _patternsImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOrefname = + _lefthandsideIrefname + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOnmLevFun = + _lhsInmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _patternsOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (chain) + _patternsOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIgUniq,_lefthandsideIidOccDefs,_lefthandsideImainValExists,_lefthandsideIrefname,_lefthandsideItopInstanceNmL) | True = + lefthandside_ _lefthandsideOgUniq _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOtopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOrefname,_lhsOtopInstanceNmL))) +sem_LeftHandSide_Typed :: Range -> + T_LeftHandSide -> + T_Type -> + T_LeftHandSide +sem_LeftHandSide_Typed range_ lefthandside_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsInmLevFun + _lhsIopts + _lhsItopInstanceNmL -> + (let _typeOnmLev :: NmLev + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOrefname :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOgUniq :: UID + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOnmLevFun :: NmLev + _lefthandsideOopts :: EHCOpts + _lefthandsideOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOtopInstanceNmL :: ([HsName]) + _lefthandsideIgUniq :: UID + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideImainValExists :: Bool + _lefthandsideIrefname :: HsName + _lefthandsideItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 60, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _lefthandsideImainValExists + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOrefname = + _lefthandsideIrefname + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOnmLevFun = + _lhsInmLevFun + -- copy rule (down) + _lefthandsideOopts = + _lhsIopts + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _lefthandsideIgUniq + -- copy rule (chain) + _typeOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIgUniq,_lefthandsideIidOccDefs,_lefthandsideImainValExists,_lefthandsideIrefname,_lefthandsideItopInstanceNmL) | True = + lefthandside_ _lefthandsideOgUniq _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOnmLevFun _lefthandsideOopts _lefthandsideOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOrefname,_lhsOtopInstanceNmL))) +-- Literal ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Int: + child range : {Range} + child base : {Int} + child value : {String} + alternative Char: + child range : {Range} + child value : {String} + alternative String: + child range : {Range} + child value : {String} + alternative Float: + child range : {Range} + child value : {String} +-} +-- cata +sem_Literal :: Literal -> + T_Literal +sem_Literal (Literal_Int _range _base _value) = + (sem_Literal_Int _range _base _value) +sem_Literal (Literal_Char _range _value) = + (sem_Literal_Char _range _value) +sem_Literal (Literal_String _range _value) = + (sem_Literal_String _range _value) +sem_Literal (Literal_Float _range _value) = + (sem_Literal_Float _range _value) +-- semantic domain +type T_Literal = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_Literal_Int :: Range -> + Int -> + String -> + T_Literal +sem_Literal_Int range_ base_ value_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Literal_Char :: Range -> + String -> + T_Literal +sem_Literal_Char range_ value_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Literal_String :: Range -> + String -> + T_Literal +sem_Literal_String range_ value_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Literal_Float :: Range -> + String -> + T_Literal +sem_Literal_Float range_ value_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- MaybeDeclarations ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + gathPragmas : Set.Set Pragma.Pragma + idOccDefs : [IdOcc] + mainValExists : Bool + alternatives: + alternative Just: + child just : Declarations + alternative Nothing: +-} +-- cata +sem_MaybeDeclarations :: MaybeDeclarations -> + T_MaybeDeclarations +sem_MaybeDeclarations (Prelude.Just x) = + (sem_MaybeDeclarations_Just (sem_Declarations x)) +sem_MaybeDeclarations Prelude.Nothing = + sem_MaybeDeclarations_Nothing +-- semantic domain +type T_MaybeDeclarations = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([IdOcc]),Bool,([HsName])) +sem_MaybeDeclarations_Just :: T_Declarations -> + T_MaybeDeclarations +sem_MaybeDeclarations_Just just_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOgUniq :: UID + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOtopInstanceNmL :: ([HsName]) + _justIgUniq :: UID + _justIgathPragmas :: (Set.Set Pragma.Pragma) + _justIidOccDefs :: ([IdOcc]) + _justImainValExists :: Bool + _justImodDefsRel :: ModEntRel + _justImodHideDefsRel :: ModEntRel + _justItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _justIgathPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _justIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _justImainValExists + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIgUniq,_justIgathPragmas,_justIidOccDefs,_justImainValExists,_justImodDefsRel,_justImodHideDefsRel,_justItopInstanceNmL) | True = + just_ _justOgUniq _justOmoduleNm _justOnmLev _justOopts _justOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +sem_MaybeDeclarations_Nothing :: T_MaybeDeclarations +sem_MaybeDeclarations_Nothing = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +-- MaybeExports ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + modExpsMb : Maybe [ModExp] + alternatives: + alternative Just: + child just : Exports + alternative Nothing: +-} +-- cata +sem_MaybeExports :: MaybeExports -> + T_MaybeExports +sem_MaybeExports (Prelude.Just x) = + (sem_MaybeExports_Just (sem_Exports x)) +sem_MaybeExports Prelude.Nothing = + sem_MaybeExports_Nothing +-- semantic domain +type T_MaybeExports = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,(Maybe [ModExp]),([HsName])) +sem_MaybeExports_Just :: T_Exports -> + T_MaybeExports +sem_MaybeExports_Just just_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExpsMb :: (Maybe [ModExp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOgUniq :: UID + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOtopInstanceNmL :: ([HsName]) + _justIgUniq :: UID + _justImodExpL :: ([ModExp]) + _justItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 96, column 9) + _lhsOmodExpsMb = + Just _justImodExpL + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIgUniq,_justImodExpL,_justItopInstanceNmL) | True = + just_ _justOgUniq _justOmoduleNm _justOnmLev _justOopts _justOtopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExpsMb,_lhsOtopInstanceNmL))) +sem_MaybeExports_Nothing :: T_MaybeExports +sem_MaybeExports_Nothing = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodExpsMb :: (Maybe [ModExp]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 98, column 9) + _lhsOmodExpsMb = + Nothing + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOmodExpsMb,_lhsOtopInstanceNmL))) +-- MaybeExpression --------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Just: + child just : Expression + alternative Nothing: +-} +-- cata +sem_MaybeExpression :: MaybeExpression -> + T_MaybeExpression +sem_MaybeExpression (Prelude.Just x) = + (sem_MaybeExpression_Just (sem_Expression x)) +sem_MaybeExpression Prelude.Nothing = + sem_MaybeExpression_Nothing +-- semantic domain +type T_MaybeExpression = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_MaybeExpression_Just :: T_Expression -> + T_MaybeExpression +sem_MaybeExpression_Just just_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOgUniq :: UID + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOtopInstanceNmL :: ([HsName]) + _justIconNm :: Name + _justIgUniq :: UID + _justItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIconNm,_justIgUniq,_justItopInstanceNmL) | True = + just_ _justOgUniq _justOmoduleNm _justOnmLev _justOopts _justOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_MaybeExpression_Nothing :: T_MaybeExpression +sem_MaybeExpression_Nothing = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- MaybeImportSpecification ------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + isHiding : Bool + modEntSpecL : [ModEntSpec] + alternatives: + alternative Just: + child just : ImportSpecification + alternative Nothing: +-} +-- cata +sem_MaybeImportSpecification :: MaybeImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification (Prelude.Just x) = + (sem_MaybeImportSpecification_Just (sem_ImportSpecification x)) +sem_MaybeImportSpecification Prelude.Nothing = + sem_MaybeImportSpecification_Nothing +-- semantic domain +type T_MaybeImportSpecification = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,Bool,([ModEntSpec]),([HsName])) +sem_MaybeImportSpecification_Just :: T_ImportSpecification -> + T_MaybeImportSpecification +sem_MaybeImportSpecification_Just just_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOisHiding :: Bool + _lhsOmodEntSpecL :: ([ModEntSpec]) + _lhsOtopInstanceNmL :: ([HsName]) + _justOgUniq :: UID + _justOmoduleNm :: HsName + _justOnmLev :: NmLev + _justOopts :: EHCOpts + _justOtopInstanceNmL :: ([HsName]) + _justIgUniq :: UID + _justIisHiding :: Bool + _justImodEntSpecL :: ([ModEntSpec]) + _justItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOisHiding = + _justIisHiding + -- copy rule (up) + _lhsOmodEntSpecL = + _justImodEntSpecL + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOopts = + _lhsIopts + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIgUniq,_justIisHiding,_justImodEntSpecL,_justItopInstanceNmL) | True = + just_ _justOgUniq _justOmoduleNm _justOnmLev _justOopts _justOtopInstanceNmL + in ( _lhsOgUniq,_lhsOisHiding,_lhsOmodEntSpecL,_lhsOtopInstanceNmL))) +sem_MaybeImportSpecification_Nothing :: T_MaybeImportSpecification +sem_MaybeImportSpecification_Nothing = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodEntSpecL :: ([ModEntSpec]) + _lhsOisHiding :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 23, column 9) + _lhsOmodEntSpecL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 33, column 9) + _lhsOisHiding = + True + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOisHiding,_lhsOmodEntSpecL,_lhsOtopInstanceNmL))) +-- MaybeType --------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Just: + child just : Type + alternative Nothing: +-} +-- cata +sem_MaybeType :: MaybeType -> + T_MaybeType +sem_MaybeType (Prelude.Just x) = + (sem_MaybeType_Just (sem_Type x)) +sem_MaybeType Prelude.Nothing = + sem_MaybeType_Nothing +-- semantic domain +type T_MaybeType = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_MaybeType_Just :: T_Type -> + T_MaybeType +sem_MaybeType_Just just_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _justOgUniq :: UID + _justOnmLev :: NmLev + _justOtopInstanceNmL :: ([HsName]) + _justIconNm :: Name + _justIgUniq :: UID + _justItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _justIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _justItopInstanceNmL + -- copy rule (down) + _justOgUniq = + _lhsIgUniq + -- copy rule (down) + _justOnmLev = + _lhsInmLev + -- copy rule (down) + _justOtopInstanceNmL = + _lhsItopInstanceNmL + ( _justIconNm,_justIgUniq,_justItopInstanceNmL) | True = + just_ _justOgUniq _justOnmLev _justOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_MaybeType_Nothing :: T_MaybeType +sem_MaybeType_Nothing = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Module ------------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + fileHeaderPragmas : Set.Set Pragma.Pragma + mainValExists : Bool + mod : Mod + modImpNmS : Set.Set HsName + realModuleNm : HsName + alternatives: + alternative Module: + child range : {Range} + child name : {MaybeName} + child fileheaderpragmas : Pragmas + child exports : MaybeExports + child body : Body + visit 0: + local fileHeaderPragmas : _ + local opts : _ + local bodyModImpL : _ + local modImpL : _ + local prelModImpL : _ + local realModuleNm : _ +-} +-- cata +sem_Module :: Module -> + T_Module +sem_Module (Module_Module _range _name _fileheaderpragmas _exports _body) = + (sem_Module_Module _range _name (sem_Pragmas _fileheaderpragmas) (sem_MaybeExports _exports) (sem_Body _body)) +-- semantic domain +type T_Module = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( (Set.Set Pragma.Pragma),UID,Bool,Mod,(Set.Set HsName),HsName,([HsName])) +sem_Module_Module :: Range -> + MaybeName -> + T_Pragmas -> + T_MaybeExports -> + T_Body -> + T_Module +sem_Module_Module range_ name_ fileheaderpragmas_ exports_ body_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOmodImpNmS :: (Set.Set HsName) + _lhsOmod :: Mod + _lhsOfileHeaderPragmas :: (Set.Set Pragma.Pragma) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOrealModuleNm :: HsName + _lhsOtopInstanceNmL :: ([HsName]) + _fileheaderpragmasOgUniq :: UID + _fileheaderpragmasOnmLev :: NmLev + _fileheaderpragmasOtopInstanceNmL :: ([HsName]) + _exportsOgUniq :: UID + _exportsOmoduleNm :: HsName + _exportsOnmLev :: NmLev + _exportsOopts :: EHCOpts + _exportsOtopInstanceNmL :: ([HsName]) + _bodyOgUniq :: UID + _bodyOmoduleNm :: HsName + _bodyOnmLev :: NmLev + _bodyOopts :: EHCOpts + _bodyOtopInstanceNmL :: ([HsName]) + _fileheaderpragmasIgUniq :: UID + _fileheaderpragmasIgathPragmas :: (Set.Set Pragma.Pragma) + _fileheaderpragmasItopInstanceNmL :: ([HsName]) + _exportsIgUniq :: UID + _exportsImodExpsMb :: (Maybe [ModExp]) + _exportsItopInstanceNmL :: ([HsName]) + _bodyIextraModImpL :: ([ModImp]) + _bodyIgUniq :: UID + _bodyImainValExists :: Bool + _bodyImodDefsRel :: ModEntRel + _bodyImodHideDefsRel :: ModEntRel + _bodyImodImpL :: ([ModImp]) + _bodyItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 23, column 9) + _fileHeaderPragmas = + _fileheaderpragmasIgathPragmas + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 23, column 9) + _opts = + fst $ ehcOptUpdateWithPragmas _fileHeaderPragmas _lhsIopts + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 46, column 9) + _bodyModImpL = + _bodyIextraModImpL ++ _bodyImodImpL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 46, column 9) + _modImpL = + _prelModImpL ++ _bodyModImpL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 46, column 9) + _prelModImpL = + if hsnModPrelude `elem` map mimpSource _bodyModImpL + || _realModuleNm == hsnModPrelude + || hsnIsInPrelude _realModuleNm + || not (ehcOptUseAssumePrelude _lhsIopts) + || Set.member Pragma.Pragma_NoImplicitPrelude _fileHeaderPragmas + then [] + else [modImpPrelude] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 61, column 9) + _lhsOmodImpNmS = + Set.fromList $ map mimpSource _modImpL + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 68, column 9) + _realModuleNm = + maybe _lhsImoduleNm id name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Module.ag"(line 160, column 9) + _lhsOmod = + Mod _lhsImoduleNm name_ + _exportsImodExpsMb _modImpL + _bodyImodDefsRel _bodyImodHideDefsRel + (reverse _bodyItopInstanceNmL) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 2, column 43) + _lhsOfileHeaderPragmas = + _fileHeaderPragmas + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _bodyImainValExists + -- copy rule (up) + _lhsOgUniq = + _bodyIgUniq + -- copy rule (from local) + _lhsOrealModuleNm = + _realModuleNm + -- copy rule (up) + _lhsOtopInstanceNmL = + _bodyItopInstanceNmL + -- copy rule (down) + _fileheaderpragmasOgUniq = + _lhsIgUniq + -- copy rule (down) + _fileheaderpragmasOnmLev = + _lhsInmLev + -- copy rule (down) + _fileheaderpragmasOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _exportsOgUniq = + _fileheaderpragmasIgUniq + -- copy rule (down) + _exportsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _exportsOnmLev = + _lhsInmLev + -- copy rule (from local) + _exportsOopts = + _opts + -- copy rule (chain) + _exportsOtopInstanceNmL = + _fileheaderpragmasItopInstanceNmL + -- copy rule (chain) + _bodyOgUniq = + _exportsIgUniq + -- copy rule (down) + _bodyOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _bodyOnmLev = + _lhsInmLev + -- copy rule (from local) + _bodyOopts = + _opts + -- copy rule (chain) + _bodyOtopInstanceNmL = + _exportsItopInstanceNmL + ( _fileheaderpragmasIgUniq,_fileheaderpragmasIgathPragmas,_fileheaderpragmasItopInstanceNmL) | True = + fileheaderpragmas_ _fileheaderpragmasOgUniq _fileheaderpragmasOnmLev _fileheaderpragmasOtopInstanceNmL + ( _exportsIgUniq,_exportsImodExpsMb,_exportsItopInstanceNmL) | True = + exports_ _exportsOgUniq _exportsOmoduleNm _exportsOnmLev _exportsOopts _exportsOtopInstanceNmL + ( _bodyIextraModImpL,_bodyIgUniq,_bodyImainValExists,_bodyImodDefsRel,_bodyImodHideDefsRel,_bodyImodImpL,_bodyItopInstanceNmL) | True = + body_ _bodyOgUniq _bodyOmoduleNm _bodyOnmLev _bodyOopts _bodyOtopInstanceNmL + in ( _lhsOfileHeaderPragmas,_lhsOgUniq,_lhsOmainValExists,_lhsOmod,_lhsOmodImpNmS,_lhsOrealModuleNm,_lhsOtopInstanceNmL))) +-- Pattern ----------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + mainValExists : Bool + mbTopRefname : Maybe HsName + alternatives: + alternative Literal: + child range : {Range} + child sign : {Int} + child literal : Literal + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local refname : _ + local isWildcard : _ + local idOccDef : _ + local idOccDefsNoWildcard : _ + local idOccDefs : _ + local mainValExists : _ + alternative Constructor: + child range : {Range} + child name : {Name} + child patterns : Patterns + visit 0: + local conNm : _ + alternative Parenthesized: + child range : {Range} + child pattern : Pattern + alternative As: + child range : {Range} + child name : {Name} + child pattern : Pattern + visit 0: + local refname : _ + local isWildcard : _ + local idOccDef : _ + local idOccDefsNoWildcard : _ + local idOccDefs : _ + alternative Wildcard: + child range : {Range} + alternative Tuple: + child range : {Range} + child arity : {Int} + child patterns : Patterns + alternative Annotate: + child range : {Range} + child annotation : PatternAnnotation + child pattern : Pattern + alternative Typed: + child range : {Range} + child pattern : Pattern + child type : Type + alternative InfixConstructor: + child range : {Range} + child leftPattern : Pattern + child constructorOperator : {Name} + child rightPattern : Pattern + visit 0: + local conNm : _ + alternative List: + child range : {Range} + child patterns : Patterns + alternative Record: + child range : {Range} + child name : {Name} + child recordPatternBindings : RecordPatternBindings + visit 0: + local conNm : _ + alternative RowRecordBinding: + child range : {Range} + child pattern : Pattern + child rowRecordPattternBindings : RowRecordPatternBindings + alternative RowRecordEmpty: + child range : {Range} + alternative Irrefutable: + child range : {Range} + child pattern : Pattern + alternative Bang: + child range : {Range} + child pattern : Pattern +-} +-- cata +sem_Pattern :: Pattern -> + T_Pattern +sem_Pattern (Pattern_Literal _range _sign _literal) = + (sem_Pattern_Literal _range _sign (sem_Literal _literal)) +sem_Pattern (Pattern_Variable _range _name) = + (sem_Pattern_Variable _range _name) +sem_Pattern (Pattern_Constructor _range _name _patterns) = + (sem_Pattern_Constructor _range _name (sem_Patterns _patterns)) +sem_Pattern (Pattern_Parenthesized _range _pattern) = + (sem_Pattern_Parenthesized _range (sem_Pattern _pattern)) +sem_Pattern (Pattern_As _range _name _pattern) = + (sem_Pattern_As _range _name (sem_Pattern _pattern)) +sem_Pattern (Pattern_Wildcard _range) = + (sem_Pattern_Wildcard _range) +sem_Pattern (Pattern_Tuple _range _arity _patterns) = + (sem_Pattern_Tuple _range _arity (sem_Patterns _patterns)) +sem_Pattern (Pattern_Annotate _range _annotation _pattern) = + (sem_Pattern_Annotate _range (sem_PatternAnnotation _annotation) (sem_Pattern _pattern)) +sem_Pattern (Pattern_Typed _range _pattern _type) = + (sem_Pattern_Typed _range (sem_Pattern _pattern) (sem_Type _type)) +sem_Pattern (Pattern_InfixConstructor _range _leftPattern _constructorOperator _rightPattern) = + (sem_Pattern_InfixConstructor _range (sem_Pattern _leftPattern) _constructorOperator (sem_Pattern _rightPattern)) +sem_Pattern (Pattern_List _range _patterns) = + (sem_Pattern_List _range (sem_Patterns _patterns)) +sem_Pattern (Pattern_Record _range _name _recordPatternBindings) = + (sem_Pattern_Record _range _name (sem_RecordPatternBindings _recordPatternBindings)) +sem_Pattern (Pattern_RowRecordBinding _range _pattern _rowRecordPattternBindings) = + (sem_Pattern_RowRecordBinding _range (sem_Pattern _pattern) (sem_RowRecordPatternBindings _rowRecordPattternBindings)) +sem_Pattern (Pattern_RowRecordEmpty _range) = + (sem_Pattern_RowRecordEmpty _range) +sem_Pattern (Pattern_Irrefutable _range _pattern) = + (sem_Pattern_Irrefutable _range (sem_Pattern _pattern)) +sem_Pattern (Pattern_Bang _range _pattern) = + (sem_Pattern_Bang _range (sem_Pattern _pattern)) +-- semantic domain +type T_Pattern = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),Bool,(Maybe HsName),([HsName])) +sem_Pattern_Literal :: Range -> + Int -> + T_Literal -> + T_Pattern +sem_Pattern_Literal range_ sign_ literal_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _literalOgUniq :: UID + _literalOnmLev :: NmLev + _literalOtopInstanceNmL :: ([HsName]) + _literalIgUniq :: UID + _literalItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (up) + _lhsOgUniq = + _literalIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _literalItopInstanceNmL + -- copy rule (down) + _literalOgUniq = + _lhsIgUniq + -- copy rule (down) + _literalOnmLev = + _lhsInmLev + -- copy rule (down) + _literalOtopInstanceNmL = + _lhsItopInstanceNmL + ( _literalIgUniq,_literalItopInstanceNmL) | True = + literal_ _literalOgUniq _literalOnmLev _literalOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Variable :: Range -> + Name -> + T_Pattern +sem_Pattern_Variable range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 54, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 100, column 9) + _isWildcard = + hsnIsWild name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDefsNoWildcard = + if _isWildcard then [] else [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 178, column 9) + _idOccDefs = + _idOccDefsNoWildcard + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 227, column 9) + _lhsOmbTopRefname = + if _isWildcard then Just _refname else Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 85, column 9) + _mainValExists = + name_ == hsnMain + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _mainValExists + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Constructor :: Range -> + Name -> + T_Patterns -> + T_Pattern +sem_Pattern_Constructor range_ name_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 219, column 9) + _conNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternsImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Parenthesized :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Parenthesized range_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_As :: Range -> + Name -> + T_Pattern -> + T_Pattern +sem_Pattern_As range_ name_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 54, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 100, column 9) + _isWildcard = + hsnIsWild name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 174, column 9) + _idOccDefsNoWildcard = + if _isWildcard then [] else [_idOccDef] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 180, column 9) + _idOccDefs = + _idOccDefsNoWildcard ++ _patternIidOccDefs + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 227, column 9) + _lhsOmbTopRefname = + if _isWildcard then Just _refname else Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _idOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Wildcard :: Range -> + T_Pattern +sem_Pattern_Wildcard range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Tuple :: Range -> + Int -> + T_Patterns -> + T_Pattern +sem_Pattern_Tuple range_ arity_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternsImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Annotate :: Range -> + T_PatternAnnotation -> + T_Pattern -> + T_Pattern +sem_Pattern_Annotate range_ annotation_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOgUniq :: UID + _annotationOmoduleNm :: HsName + _annotationOnmLev :: NmLev + _annotationOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _annotationIgUniq :: UID + _annotationIidOccDefs :: ([IdOcc]) + _annotationItopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _annotationIidOccDefs ++ _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _patternOgUniq = + _annotationIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (chain) + _patternOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIgUniq,_annotationIidOccDefs,_annotationItopInstanceNmL) | True = + annotation_ _annotationOgUniq _annotationOmoduleNm _annotationOnmLev _annotationOtopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Typed :: Range -> + T_Pattern -> + T_Type -> + T_Pattern +sem_Pattern_Typed range_ pattern_ type_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _typeOnmLev :: NmLev + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 56, column 9) + _typeOnmLev = + _lhsInmLev + 1 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _patternIgUniq + -- copy rule (chain) + _typeOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_InfixConstructor :: Range -> + T_Pattern -> + Name -> + T_Pattern -> + T_Pattern +sem_Pattern_InfixConstructor range_ leftPattern_ constructorOperator_ rightPattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOgUniq :: UID + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOgUniq :: UID + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIgUniq :: UID + _leftPatternIidOccDefs :: ([IdOcc]) + _leftPatternImainValExists :: Bool + _leftPatternImbTopRefname :: (Maybe HsName) + _leftPatternItopInstanceNmL :: ([HsName]) + _rightPatternIgUniq :: UID + _rightPatternIidOccDefs :: ([IdOcc]) + _rightPatternImainValExists :: Bool + _rightPatternImbTopRefname :: (Maybe HsName) + _rightPatternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 221, column 9) + _conNm = + constructorOperator_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _leftPatternIidOccDefs ++ _rightPatternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _leftPatternImainValExists || _rightPatternImainValExists + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIgUniq,_leftPatternIidOccDefs,_leftPatternImainValExists,_leftPatternImbTopRefname,_leftPatternItopInstanceNmL) | True = + leftPattern_ _leftPatternOgUniq _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOtopInstanceNmL + ( _rightPatternIgUniq,_rightPatternIidOccDefs,_rightPatternImainValExists,_rightPatternImbTopRefname,_rightPatternItopInstanceNmL) | True = + rightPattern_ _rightPatternOgUniq _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_List :: Range -> + T_Patterns -> + T_Pattern +sem_Pattern_List range_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsIidOccDefs :: ([IdOcc]) + _patternsImainValExists :: Bool + _patternsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternsImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIgUniq,_patternsIidOccDefs,_patternsImainValExists,_patternsItopInstanceNmL) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Record :: Range -> + Name -> + T_RecordPatternBindings -> + T_Pattern +sem_Pattern_Record range_ name_ recordPatternBindings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _recordPatternBindingsOgUniq :: UID + _recordPatternBindingsOmoduleNm :: HsName + _recordPatternBindingsOnmLev :: NmLev + _recordPatternBindingsOtopInstanceNmL :: ([HsName]) + _recordPatternBindingsIgUniq :: UID + _recordPatternBindingsIidOccDefs :: ([IdOcc]) + _recordPatternBindingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 219, column 9) + _conNm = + name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _recordPatternBindingsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (up) + _lhsOgUniq = + _recordPatternBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _recordPatternBindingsItopInstanceNmL + -- copy rule (down) + _recordPatternBindingsOgUniq = + _lhsIgUniq + -- copy rule (down) + _recordPatternBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _recordPatternBindingsOnmLev = + _lhsInmLev + -- copy rule (down) + _recordPatternBindingsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _recordPatternBindingsIgUniq,_recordPatternBindingsIidOccDefs,_recordPatternBindingsItopInstanceNmL) | True = + recordPatternBindings_ _recordPatternBindingsOgUniq _recordPatternBindingsOmoduleNm _recordPatternBindingsOnmLev _recordPatternBindingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_RowRecordBinding :: Range -> + T_Pattern -> + T_RowRecordPatternBindings -> + T_Pattern +sem_Pattern_RowRecordBinding range_ pattern_ rowRecordPattternBindings_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _rowRecordPattternBindingsOgUniq :: UID + _rowRecordPattternBindingsOmoduleNm :: HsName + _rowRecordPattternBindingsOnmLev :: NmLev + _rowRecordPattternBindingsOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _rowRecordPattternBindingsIgUniq :: UID + _rowRecordPattternBindingsIidOccDefs :: ([IdOcc]) + _rowRecordPattternBindingsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs ++ _rowRecordPattternBindingsIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _rowRecordPattternBindingsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowRecordPattternBindingsItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rowRecordPattternBindingsOgUniq = + _patternIgUniq + -- copy rule (down) + _rowRecordPattternBindingsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rowRecordPattternBindingsOnmLev = + _lhsInmLev + -- copy rule (chain) + _rowRecordPattternBindingsOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _rowRecordPattternBindingsIgUniq,_rowRecordPattternBindingsIidOccDefs,_rowRecordPattternBindingsItopInstanceNmL) | True = + rowRecordPattternBindings_ _rowRecordPattternBindingsOgUniq _rowRecordPattternBindingsOmoduleNm _rowRecordPattternBindingsOnmLev _rowRecordPattternBindingsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_RowRecordEmpty :: Range -> + T_Pattern +sem_Pattern_RowRecordEmpty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Irrefutable :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Irrefutable range_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +sem_Pattern_Bang :: Range -> + T_Pattern -> + T_Pattern +sem_Pattern_Bang range_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOmbTopRefname :: (Maybe HsName) + _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 229, column 9) + _lhsOmbTopRefname = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _patternImainValExists + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOmbTopRefname,_lhsOtopInstanceNmL))) +-- PatternAnnotation ------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Empty: +-} +-- cata +sem_PatternAnnotation :: PatternAnnotation -> + T_PatternAnnotation +sem_PatternAnnotation (PatternAnnotation_Empty) = + (sem_PatternAnnotation_Empty) +-- semantic domain +type T_PatternAnnotation = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_PatternAnnotation_Empty :: T_PatternAnnotation +sem_PatternAnnotation_Empty = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- Patterns ---------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + mainValExists : Bool + alternatives: + alternative Cons: + child hd : Pattern + child tl : Patterns + alternative Nil: +-} +-- cata +sem_Patterns :: Patterns -> + T_Patterns +sem_Patterns list = + (Prelude.foldr sem_Patterns_Cons sem_Patterns_Nil (Prelude.map sem_Pattern list)) +-- semantic domain +type T_Patterns = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),Bool,([HsName])) +sem_Patterns_Cons :: T_Pattern -> + T_Patterns -> + T_Patterns +sem_Patterns_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIidOccDefs :: ([IdOcc]) + _hdImainValExists :: Bool + _hdImbTopRefname :: (Maybe HsName) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIidOccDefs :: ([IdOcc]) + _tlImainValExists :: Bool + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + _hdImainValExists || _tlImainValExists + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIidOccDefs,_hdImainValExists,_hdImbTopRefname,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlIidOccDefs,_tlImainValExists,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +sem_Patterns_Nil :: T_Patterns +sem_Patterns_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOmainValExists :: Bool + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/ModImpExp.ag"(line 75, column 25) + _lhsOmainValExists = + False + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOmainValExists,_lhsOtopInstanceNmL))) +-- Pragma ------------------------------------------------------ +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + gathPragmas : Set.Set Pragma.Pragma + alternatives: + alternative Language: + child range : {Range} + child pragmas : {Names} + visit 0: + local pragmaNames : _ + alternative OptionsUHC: + child range : {Range} + child options : {String} + visit 0: + local pragmaNames : _ + alternative Derivable: + child range : {Range} + child className : {Name} + child fieldName : {Name} + child defaultName : {Name} + alternative ExcludeIfTarget: + child range : {Range} + child targetNames : {[String]} + visit 0: + local targets : _ +-} +-- cata +sem_Pragma :: Pragma -> + T_Pragma +sem_Pragma (Pragma_Language _range _pragmas) = + (sem_Pragma_Language _range _pragmas) +sem_Pragma (Pragma_OptionsUHC _range _options) = + (sem_Pragma_OptionsUHC _range _options) +sem_Pragma (Pragma_Derivable _range _className _fieldName _defaultName) = + (sem_Pragma_Derivable _range _className _fieldName _defaultName) +sem_Pragma (Pragma_ExcludeIfTarget _range _targetNames) = + (sem_Pragma_ExcludeIfTarget _range _targetNames) +-- semantic domain +type T_Pragma = UID -> + NmLev -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([HsName])) +sem_Pragma_Language :: Range -> + Names -> + T_Pragma +sem_Pragma_Language range_ pragmas_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 6, column 9) + _pragmaNames = + [ p | p <- map show pragmas_ ] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 12, column 9) + _lhsOgathPragmas = + Set.fromList $ catMaybes [ Map.lookup p Pragma.allSimplePragmaMp | p <- _pragmaNames ] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +sem_Pragma_OptionsUHC :: Range -> + String -> + T_Pragma +sem_Pragma_OptionsUHC range_ options_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 8, column 9) + _pragmaNames = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 16, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_OptionsUHC options_) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +sem_Pragma_Derivable :: Range -> + Name -> + Name -> + Name -> + T_Pragma +sem_Pragma_Derivable range_ className_ fieldName_ defaultName_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 14, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_Derivable className_ fieldName_ defaultName_) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +sem_Pragma_ExcludeIfTarget :: Range -> + ([String]) -> + T_Pragma +sem_Pragma_ExcludeIfTarget range_ targetNames_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 18, column 9) + _targets = + catMaybes $ map (\t -> Map.lookup t supportedTargetMp) targetNames_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 19, column 9) + _lhsOgathPragmas = + Set.singleton (Pragma.Pragma_ExcludeIfTarget _targets) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +-- Pragmas ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + gathPragmas : Set.Set Pragma.Pragma + alternatives: + alternative Cons: + child hd : Pragma + child tl : Pragmas + alternative Nil: +-} +-- cata +sem_Pragmas :: Pragmas -> + T_Pragmas +sem_Pragmas list = + (Prelude.foldr sem_Pragmas_Cons sem_Pragmas_Nil (Prelude.map sem_Pragma list)) +-- semantic domain +type T_Pragmas = UID -> + NmLev -> + ([HsName]) -> + ( UID,(Set.Set Pragma.Pragma),([HsName])) +sem_Pragmas_Cons :: T_Pragma -> + T_Pragmas -> + T_Pragmas +sem_Pragmas_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIgathPragmas :: (Set.Set Pragma.Pragma) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIgathPragmas :: (Set.Set Pragma.Pragma) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + _hdIgathPragmas `Set.union` _tlIgathPragmas + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIgathPragmas,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlIgathPragmas,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +sem_Pragmas_Nil :: T_Pragmas +sem_Pragmas_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgathPragmas :: (Set.Set Pragma.Pragma) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/Pragmas.ag"(line 1, column 49) + _lhsOgathPragmas = + Set.empty + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOgathPragmas,_lhsOtopInstanceNmL))) +-- Qualifier --------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + opts : EHCOpts + chained attributes: + gUniq : UID + nmLev : NmLev + topInstanceNmL : [HsName] + alternatives: + alternative Guard: + child range : {Range} + child guard : Expression + alternative Let: + child range : {Range} + child declarations : Declarations + visit 0: + local nmLev : _ + alternative Generator: + child range : {Range} + child pattern : Pattern + child expression : Expression + visit 0: + local nmLev : _ + alternative Empty: + child range : {Range} +-} +-- cata +sem_Qualifier :: Qualifier -> + T_Qualifier +sem_Qualifier (Qualifier_Guard _range _guard) = + (sem_Qualifier_Guard _range (sem_Expression _guard)) +sem_Qualifier (Qualifier_Let _range _declarations) = + (sem_Qualifier_Let _range (sem_Declarations _declarations)) +sem_Qualifier (Qualifier_Generator _range _pattern _expression) = + (sem_Qualifier_Generator _range (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Qualifier (Qualifier_Empty _range) = + (sem_Qualifier_Empty _range) +-- semantic domain +type T_Qualifier = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,NmLev,([HsName])) +sem_Qualifier_Guard :: Range -> + T_Expression -> + T_Qualifier +sem_Qualifier_Guard range_ guard_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _guardOgUniq :: UID + _guardOmoduleNm :: HsName + _guardOnmLev :: NmLev + _guardOopts :: EHCOpts + _guardOtopInstanceNmL :: ([HsName]) + _guardIconNm :: Name + _guardIgUniq :: UID + _guardItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _guardIgUniq + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _guardItopInstanceNmL + -- copy rule (down) + _guardOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _guardOnmLev = + _lhsInmLev + -- copy rule (down) + _guardOopts = + _lhsIopts + -- copy rule (down) + _guardOtopInstanceNmL = + _lhsItopInstanceNmL + ( _guardIconNm,_guardIgUniq,_guardItopInstanceNmL) | True = + guard_ _guardOgUniq _guardOmoduleNm _guardOnmLev _guardOopts _guardOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Qualifier_Let :: Range -> + T_Declarations -> + T_Qualifier +sem_Qualifier_Let range_ declarations_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOgUniq :: UID + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOtopInstanceNmL :: ([HsName]) + _declarationsIgUniq :: UID + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsImainValExists :: Bool + _declarationsImodDefsRel :: ModEntRel + _declarationsImodHideDefsRel :: ModEntRel + _declarationsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 77, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _declarationsIgUniq,_declarationsIgathPragmas,_declarationsIidOccDefs,_declarationsImainValExists,_declarationsImodDefsRel,_declarationsImodHideDefsRel,_declarationsItopInstanceNmL) | True = + declarations_ _declarationsOgUniq _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Qualifier_Generator :: Range -> + T_Pattern -> + T_Expression -> + T_Qualifier +sem_Qualifier_Generator range_ pattern_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 77, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _patternIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Qualifier_Empty :: Range -> + T_Qualifier +sem_Qualifier_Empty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +-- Qualifiers -------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Qualifier + child tl : Qualifiers + alternative Nil: +-} +-- cata +sem_Qualifiers :: Qualifiers -> + T_Qualifiers +sem_Qualifiers list = + (Prelude.foldr sem_Qualifiers_Cons sem_Qualifiers_Nil (Prelude.map sem_Qualifier list)) +-- semantic domain +type T_Qualifiers = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_Qualifiers_Cons :: T_Qualifier -> + T_Qualifiers -> + T_Qualifiers +sem_Qualifiers_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdInmLev :: NmLev + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (chain) + _tlOnmLev = + _hdInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdInmLev,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Qualifiers_Nil :: T_Qualifiers +sem_Qualifiers_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RecordExpressionBinding ------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Binding: + child range : {Range} + child name : {Name} + child expression : Expression +-} +-- cata +sem_RecordExpressionBinding :: RecordExpressionBinding -> + T_RecordExpressionBinding +sem_RecordExpressionBinding (RecordExpressionBinding_Binding _range _name _expression) = + (sem_RecordExpressionBinding_Binding _range _name (sem_Expression _expression)) +-- semantic domain +type T_RecordExpressionBinding = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_RecordExpressionBinding_Binding :: Range -> + Name -> + T_Expression -> + T_RecordExpressionBinding +sem_RecordExpressionBinding_Binding range_ name_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RecordExpressionBindings ------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : RecordExpressionBinding + child tl : RecordExpressionBindings + alternative Nil: +-} +-- cata +sem_RecordExpressionBindings :: RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings list = + (Prelude.foldr sem_RecordExpressionBindings_Cons sem_RecordExpressionBindings_Nil (Prelude.map sem_RecordExpressionBinding list)) +-- semantic domain +type T_RecordExpressionBindings = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_RecordExpressionBindings_Cons :: T_RecordExpressionBinding -> + T_RecordExpressionBindings -> + T_RecordExpressionBindings +sem_RecordExpressionBindings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_RecordExpressionBindings_Nil :: T_RecordExpressionBindings +sem_RecordExpressionBindings_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RecordPatternBinding ---------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Binding: + child range : {Range} + child name : {Name} + child pattern : Pattern + alternative Pun: + child range : {Range} + child name : {Name} + visit 0: + local refname : _ + local idOccDef : _ +-} +-- cata +sem_RecordPatternBinding :: RecordPatternBinding -> + T_RecordPatternBinding +sem_RecordPatternBinding (RecordPatternBinding_Binding _range _name _pattern) = + (sem_RecordPatternBinding_Binding _range _name (sem_Pattern _pattern)) +sem_RecordPatternBinding (RecordPatternBinding_Pun _range _name) = + (sem_RecordPatternBinding_Pun _range _name) +-- semantic domain +type T_RecordPatternBinding = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_RecordPatternBinding_Binding :: Range -> + Name -> + T_Pattern -> + T_RecordPatternBinding +sem_RecordPatternBinding_Binding range_ name_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +sem_RecordPatternBinding_Pun :: Range -> + Name -> + T_RecordPatternBinding +sem_RecordPatternBinding_Pun range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 92, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 184, column 9) + _idOccDef = + IdOcc _refname IdOcc_Val + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- RecordPatternBindings --------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Cons: + child hd : RecordPatternBinding + child tl : RecordPatternBindings + alternative Nil: +-} +-- cata +sem_RecordPatternBindings :: RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings list = + (Prelude.foldr sem_RecordPatternBindings_Cons sem_RecordPatternBindings_Nil (Prelude.map sem_RecordPatternBinding list)) +-- semantic domain +type T_RecordPatternBindings = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_RecordPatternBindings_Cons :: T_RecordPatternBinding -> + T_RecordPatternBindings -> + T_RecordPatternBindings +sem_RecordPatternBindings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIidOccDefs :: ([IdOcc]) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIidOccDefs :: ([IdOcc]) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIidOccDefs,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlIidOccDefs,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +sem_RecordPatternBindings_Nil :: T_RecordPatternBindings +sem_RecordPatternBindings_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- RightHandSide ----------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Expression: + child range : {Range} + child expression : Expression + child where : MaybeDeclarations + visit 0: + local nmLev : _ + alternative Guarded: + child range : {Range} + child guardedexpressions : GuardedExpressions + child where : MaybeDeclarations + visit 0: + local nmLev : _ +-} +-- cata +sem_RightHandSide :: RightHandSide -> + T_RightHandSide +sem_RightHandSide (RightHandSide_Expression _range _expression _where) = + (sem_RightHandSide_Expression _range (sem_Expression _expression) (sem_MaybeDeclarations _where)) +sem_RightHandSide (RightHandSide_Guarded _range _guardedexpressions _where) = + (sem_RightHandSide_Guarded _range (sem_GuardedExpressions _guardedexpressions) (sem_MaybeDeclarations _where)) +-- semantic domain +type T_RightHandSide = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_RightHandSide_Expression :: Range -> + T_Expression -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Expression range_ expression_ where_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _whereOgUniq :: UID + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + _whereIgUniq :: UID + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidOccDefs :: ([IdOcc]) + _whereImainValExists :: Bool + _whereItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 69, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _whereItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _whereOgUniq = + _expressionIgUniq + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (chain) + _whereOtopInstanceNmL = + _expressionItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + ( _whereIgUniq,_whereIgathPragmas,_whereIidOccDefs,_whereImainValExists,_whereItopInstanceNmL) | True = + where_ _whereOgUniq _whereOmoduleNm _whereOnmLev _whereOopts _whereOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_RightHandSide_Guarded :: Range -> + T_GuardedExpressions -> + T_MaybeDeclarations -> + T_RightHandSide +sem_RightHandSide_Guarded range_ guardedexpressions_ where_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _guardedexpressionsOgUniq :: UID + _guardedexpressionsOmoduleNm :: HsName + _guardedexpressionsOnmLev :: NmLev + _guardedexpressionsOopts :: EHCOpts + _guardedexpressionsOtopInstanceNmL :: ([HsName]) + _whereOgUniq :: UID + _whereOmoduleNm :: HsName + _whereOnmLev :: NmLev + _whereOopts :: EHCOpts + _whereOtopInstanceNmL :: ([HsName]) + _guardedexpressionsIgUniq :: UID + _guardedexpressionsItopInstanceNmL :: ([HsName]) + _whereIgUniq :: UID + _whereIgathPragmas :: (Set.Set Pragma.Pragma) + _whereIidOccDefs :: ([IdOcc]) + _whereImainValExists :: Bool + _whereItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 69, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _whereIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _whereItopInstanceNmL + -- copy rule (down) + _guardedexpressionsOgUniq = + _lhsIgUniq + -- copy rule (down) + _guardedexpressionsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _guardedexpressionsOnmLev = + _nmLev + -- copy rule (down) + _guardedexpressionsOopts = + _lhsIopts + -- copy rule (down) + _guardedexpressionsOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _whereOgUniq = + _guardedexpressionsIgUniq + -- copy rule (down) + _whereOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _whereOnmLev = + _nmLev + -- copy rule (down) + _whereOopts = + _lhsIopts + -- copy rule (chain) + _whereOtopInstanceNmL = + _guardedexpressionsItopInstanceNmL + ( _guardedexpressionsIgUniq,_guardedexpressionsItopInstanceNmL) | True = + guardedexpressions_ _guardedexpressionsOgUniq _guardedexpressionsOmoduleNm _guardedexpressionsOnmLev _guardedexpressionsOopts _guardedexpressionsOtopInstanceNmL + ( _whereIgUniq,_whereIgathPragmas,_whereIidOccDefs,_whereImainValExists,_whereItopInstanceNmL) | True = + where_ _whereOgUniq _whereOmoduleNm _whereOnmLev _whereOopts _whereOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RowRecordExpressionUpdate ----------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Update: + child range : {Range} + child name : {Name} + child expression : Expression + alternative Extends: + child range : {Range} + child name : {MaybeName} + child expression : Expression +-} +-- cata +sem_RowRecordExpressionUpdate :: RowRecordExpressionUpdate -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate (RowRecordExpressionUpdate_Update _range _name _expression) = + (sem_RowRecordExpressionUpdate_Update _range _name (sem_Expression _expression)) +sem_RowRecordExpressionUpdate (RowRecordExpressionUpdate_Extends _range _name _expression) = + (sem_RowRecordExpressionUpdate_Extends _range _name (sem_Expression _expression)) +-- semantic domain +type T_RowRecordExpressionUpdate = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_RowRecordExpressionUpdate_Update :: Range -> + Name -> + T_Expression -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate_Update range_ name_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_RowRecordExpressionUpdate_Extends :: Range -> + MaybeName -> + T_Expression -> + T_RowRecordExpressionUpdate +sem_RowRecordExpressionUpdate_Extends range_ name_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RowRecordExpressionUpdates ---------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : RowRecordExpressionUpdate + child tl : RowRecordExpressionUpdates + alternative Nil: +-} +-- cata +sem_RowRecordExpressionUpdates :: RowRecordExpressionUpdates -> + T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates list = + (Prelude.foldr sem_RowRecordExpressionUpdates_Cons sem_RowRecordExpressionUpdates_Nil (Prelude.map sem_RowRecordExpressionUpdate list)) +-- semantic domain +type T_RowRecordExpressionUpdates = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_RowRecordExpressionUpdates_Cons :: T_RowRecordExpressionUpdate -> + T_RowRecordExpressionUpdates -> + T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_RowRecordExpressionUpdates_Nil :: T_RowRecordExpressionUpdates +sem_RowRecordExpressionUpdates_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RowRecordPatternBinding ------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Binding: + child range : {Range} + child name : {MaybeName} + child pattern : Pattern +-} +-- cata +sem_RowRecordPatternBinding :: RowRecordPatternBinding -> + T_RowRecordPatternBinding +sem_RowRecordPatternBinding (RowRecordPatternBinding_Binding _range _name _pattern) = + (sem_RowRecordPatternBinding_Binding _range _name (sem_Pattern _pattern)) +-- semantic domain +type T_RowRecordPatternBinding = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_RowRecordPatternBinding_Binding :: Range -> + MaybeName -> + T_Pattern -> + T_RowRecordPatternBinding +sem_RowRecordPatternBinding_Binding range_ name_ pattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _patternIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _patternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternOnmLev = + _lhsInmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- RowRecordPatternBindings ------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + idOccDefs : [IdOcc] + alternatives: + alternative Cons: + child hd : RowRecordPatternBinding + child tl : RowRecordPatternBindings + alternative Nil: +-} +-- cata +sem_RowRecordPatternBindings :: RowRecordPatternBindings -> + T_RowRecordPatternBindings +sem_RowRecordPatternBindings list = + (Prelude.foldr sem_RowRecordPatternBindings_Cons sem_RowRecordPatternBindings_Nil (Prelude.map sem_RowRecordPatternBinding list)) +-- semantic domain +type T_RowRecordPatternBindings = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),([HsName])) +sem_RowRecordPatternBindings_Cons :: T_RowRecordPatternBinding -> + T_RowRecordPatternBindings -> + T_RowRecordPatternBindings +sem_RowRecordPatternBindings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdIidOccDefs :: ([IdOcc]) + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlIidOccDefs :: ([IdOcc]) + _tlItopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _hdIidOccDefs ++ _tlIidOccDefs + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdIidOccDefs,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlIidOccDefs,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +sem_RowRecordPatternBindings_Nil :: T_RowRecordPatternBindings +sem_RowRecordPatternBindings_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOtopInstanceNmL))) +-- RowTypeUpdate ----------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Extends: + child range : {Range} + child name : {MaybeName} + child type : Type +-} +-- cata +sem_RowTypeUpdate :: RowTypeUpdate -> + T_RowTypeUpdate +sem_RowTypeUpdate (RowTypeUpdate_Extends _range _name _type) = + (sem_RowTypeUpdate_Extends _range _name (sem_Type _type)) +-- semantic domain +type T_RowTypeUpdate = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_RowTypeUpdate_Extends :: Range -> + MaybeName -> + T_Type -> + T_RowTypeUpdate +sem_RowTypeUpdate_Extends range_ name_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- RowTypeUpdates ---------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : RowTypeUpdate + child tl : RowTypeUpdates + alternative Nil: +-} +-- cata +sem_RowTypeUpdates :: RowTypeUpdates -> + T_RowTypeUpdates +sem_RowTypeUpdates list = + (Prelude.foldr sem_RowTypeUpdates_Cons sem_RowTypeUpdates_Nil (Prelude.map sem_RowTypeUpdate list)) +-- semantic domain +type T_RowTypeUpdates = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_RowTypeUpdates_Cons :: T_RowTypeUpdate -> + T_RowTypeUpdates -> + T_RowTypeUpdates +sem_RowTypeUpdates_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_RowTypeUpdates_Nil :: T_RowTypeUpdates +sem_RowTypeUpdates_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Statement --------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + opts : EHCOpts + chained attributes: + gUniq : UID + nmLev : NmLev + topInstanceNmL : [HsName] + alternatives: + alternative Expression: + child range : {Range} + child expression : Expression + alternative Let: + child range : {Range} + child declarations : Declarations + visit 0: + local nmLev : _ + alternative Generator: + child range : {Range} + child pattern : Pattern + child expression : Expression + visit 0: + local nmLev : _ + alternative Empty: + child range : {Range} +-} +-- cata +sem_Statement :: Statement -> + T_Statement +sem_Statement (Statement_Expression _range _expression) = + (sem_Statement_Expression _range (sem_Expression _expression)) +sem_Statement (Statement_Let _range _declarations) = + (sem_Statement_Let _range (sem_Declarations _declarations)) +sem_Statement (Statement_Generator _range _pattern _expression) = + (sem_Statement_Generator _range (sem_Pattern _pattern) (sem_Expression _expression)) +sem_Statement (Statement_Empty _range) = + (sem_Statement_Empty _range) +-- semantic domain +type T_Statement = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,NmLev,([HsName])) +sem_Statement_Expression :: Range -> + T_Expression -> + T_Statement +sem_Statement_Expression range_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _expressionOgUniq = + _lhsIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _expressionOnmLev = + _lhsInmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (down) + _expressionOtopInstanceNmL = + _lhsItopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Statement_Let :: Range -> + T_Declarations -> + T_Statement +sem_Statement_Let range_ declarations_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _declarationsOgUniq :: UID + _declarationsOmoduleNm :: HsName + _declarationsOnmLev :: NmLev + _declarationsOopts :: EHCOpts + _declarationsOtopInstanceNmL :: ([HsName]) + _declarationsIgUniq :: UID + _declarationsIgathPragmas :: (Set.Set Pragma.Pragma) + _declarationsIidOccDefs :: ([IdOcc]) + _declarationsImainValExists :: Bool + _declarationsImodDefsRel :: ModEntRel + _declarationsImodHideDefsRel :: ModEntRel + _declarationsItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 81, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _declarationsIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _declarationsItopInstanceNmL + -- copy rule (down) + _declarationsOgUniq = + _lhsIgUniq + -- copy rule (down) + _declarationsOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _declarationsOnmLev = + _nmLev + -- copy rule (down) + _declarationsOopts = + _lhsIopts + -- copy rule (down) + _declarationsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _declarationsIgUniq,_declarationsIgathPragmas,_declarationsIidOccDefs,_declarationsImainValExists,_declarationsImodDefsRel,_declarationsImodHideDefsRel,_declarationsItopInstanceNmL) | True = + declarations_ _declarationsOgUniq _declarationsOmoduleNm _declarationsOnmLev _declarationsOopts _declarationsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Statement_Generator :: Range -> + T_Pattern -> + T_Expression -> + T_Statement +sem_Statement_Generator range_ pattern_ expression_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + _patternOgUniq :: UID + _patternOmoduleNm :: HsName + _patternOnmLev :: NmLev + _patternOtopInstanceNmL :: ([HsName]) + _expressionOgUniq :: UID + _expressionOmoduleNm :: HsName + _expressionOnmLev :: NmLev + _expressionOopts :: EHCOpts + _expressionOtopInstanceNmL :: ([HsName]) + _patternIgUniq :: UID + _patternIidOccDefs :: ([IdOcc]) + _patternImainValExists :: Bool + _patternImbTopRefname :: (Maybe HsName) + _patternItopInstanceNmL :: ([HsName]) + _expressionIconNm :: Name + _expressionIgUniq :: UID + _expressionItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 81, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _expressionIgUniq + -- copy rule (from local) + _lhsOnmLev = + _nmLev + -- copy rule (up) + _lhsOtopInstanceNmL = + _expressionItopInstanceNmL + -- copy rule (down) + _patternOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _patternOnmLev = + _nmLev + -- copy rule (down) + _patternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _expressionOgUniq = + _patternIgUniq + -- copy rule (down) + _expressionOmoduleNm = + _lhsImoduleNm + -- copy rule (from local) + _expressionOnmLev = + _nmLev + -- copy rule (down) + _expressionOopts = + _lhsIopts + -- copy rule (chain) + _expressionOtopInstanceNmL = + _patternItopInstanceNmL + ( _patternIgUniq,_patternIidOccDefs,_patternImainValExists,_patternImbTopRefname,_patternItopInstanceNmL) | True = + pattern_ _patternOgUniq _patternOmoduleNm _patternOnmLev _patternOtopInstanceNmL + ( _expressionIconNm,_expressionIgUniq,_expressionItopInstanceNmL) | True = + expression_ _expressionOgUniq _expressionOmoduleNm _expressionOnmLev _expressionOopts _expressionOtopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +sem_Statement_Empty :: Range -> + T_Statement +sem_Statement_Empty range_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOnmLev :: NmLev + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOnmLev = + _lhsInmLev + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOnmLev,_lhsOtopInstanceNmL))) +-- Statements -------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + opts : EHCOpts + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Statement + child tl : Statements + alternative Nil: +-} +-- cata +sem_Statements :: Statements -> + T_Statements +sem_Statements list = + (Prelude.foldr sem_Statements_Cons sem_Statements_Nil (Prelude.map sem_Statement list)) +-- semantic domain +type T_Statements = UID -> + HsName -> + NmLev -> + EHCOpts -> + ([HsName]) -> + ( UID,([HsName])) +sem_Statements_Cons :: T_Statement -> + T_Statements -> + T_Statements +sem_Statements_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOopts :: EHCOpts + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOopts :: EHCOpts + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdInmLev :: NmLev + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOopts = + _lhsIopts + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (chain) + _tlOnmLev = + _hdInmLev + -- copy rule (down) + _tlOopts = + _lhsIopts + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdInmLev,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOopts _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOopts _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Statements_Nil :: T_Statements +sem_Statements_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsIopts + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Strings ----------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : {String} + child tl : Strings + alternative Nil: +-} +-- cata +sem_Strings :: Strings -> + T_Strings +sem_Strings list = + (Prelude.foldr sem_Strings_Cons sem_Strings_Nil list) +-- semantic domain +type T_Strings = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_Strings_Cons :: String -> + T_Strings -> + T_Strings +sem_Strings_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _tlOgUniq = + _lhsIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (down) + _tlOtopInstanceNmL = + _lhsItopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Strings_Nil :: T_Strings +sem_Strings_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- Type -------------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + conNm : Name + alternatives: + alternative NormalApplication: + child range : {Range} + child function : Type + child arguments : Types + alternative InfixApplication: + child range : {Range} + child leftType : Type + child operator : Type + child rightType : Type + alternative InfixApplicationChainTop: + child range : {Range} + child type : Type + alternative Constructor: + child range : {Range} + child name : {Name} + alternative Parenthesized: + child range : {Range} + child type : Type + alternative SectionApplication: + child range : {Range} + child leftType : MaybeType + child operator : Type + child rightType : MaybeType + alternative Annotate: + child range : {Range} + child annotation : TypeAnnotation + child type : Type + alternative Wildcard: + child range : {Range} + alternative MonoWildcard: + child range : {Range} + alternative Variable: + child range : {Range} + child name : {Name} + alternative NamedWildcard: + child range : {Range} + child name : {Name} + alternative Forall: + child range : {Range} + child typevariables : {Names} + child type : Type + visit 0: + local nmLev : _ + alternative Exists: + child range : {Range} + child typevariables : {Names} + child type : Type + visit 0: + local nmLev : _ + alternative RowUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + alternative RowEmpty: + child range : {Range} + alternative RowRecUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + alternative RowRecEmpty: + child range : {Range} + alternative RowSumUpdate: + child range : {Range} + child type : Type + child rowTypeUpdates : RowTypeUpdates + alternative RowSumEmpty: + child range : {Range} + alternative Qualified: + child range : {Range} + child context : ContextItems + child type : Type + alternative TupleConstructor: + child range : {Range} + child arity : {Int} +-} +-- cata +sem_Type :: Type -> + T_Type +sem_Type (Type_NormalApplication _range _function _arguments) = + (sem_Type_NormalApplication _range (sem_Type _function) (sem_Types _arguments)) +sem_Type (Type_InfixApplication _range _leftType _operator _rightType) = + (sem_Type_InfixApplication _range (sem_Type _leftType) (sem_Type _operator) (sem_Type _rightType)) +sem_Type (Type_InfixApplicationChainTop _range _type) = + (sem_Type_InfixApplicationChainTop _range (sem_Type _type)) +sem_Type (Type_Constructor _range _name) = + (sem_Type_Constructor _range _name) +sem_Type (Type_Parenthesized _range _type) = + (sem_Type_Parenthesized _range (sem_Type _type)) +sem_Type (Type_SectionApplication _range _leftType _operator _rightType) = + (sem_Type_SectionApplication _range (sem_MaybeType _leftType) (sem_Type _operator) (sem_MaybeType _rightType)) +sem_Type (Type_Annotate _range _annotation _type) = + (sem_Type_Annotate _range (sem_TypeAnnotation _annotation) (sem_Type _type)) +sem_Type (Type_Wildcard _range) = + (sem_Type_Wildcard _range) +sem_Type (Type_MonoWildcard _range) = + (sem_Type_MonoWildcard _range) +sem_Type (Type_Variable _range _name) = + (sem_Type_Variable _range _name) +sem_Type (Type_NamedWildcard _range _name) = + (sem_Type_NamedWildcard _range _name) +sem_Type (Type_Forall _range _typevariables _type) = + (sem_Type_Forall _range _typevariables (sem_Type _type)) +sem_Type (Type_Exists _range _typevariables _type) = + (sem_Type_Exists _range _typevariables (sem_Type _type)) +sem_Type (Type_RowUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowEmpty _range) = + (sem_Type_RowEmpty _range) +sem_Type (Type_RowRecUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowRecUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowRecEmpty _range) = + (sem_Type_RowRecEmpty _range) +sem_Type (Type_RowSumUpdate _range _type _rowTypeUpdates) = + (sem_Type_RowSumUpdate _range (sem_Type _type) (sem_RowTypeUpdates _rowTypeUpdates)) +sem_Type (Type_RowSumEmpty _range) = + (sem_Type_RowSumEmpty _range) +sem_Type (Type_Qualified _range _context _type) = + (sem_Type_Qualified _range (sem_ContextItems _context) (sem_Type _type)) +sem_Type (Type_TupleConstructor _range _arity) = + (sem_Type_TupleConstructor _range _arity) +-- semantic domain +type T_Type = UID -> + NmLev -> + ([HsName]) -> + ( Name,UID,([HsName])) +sem_Type_NormalApplication :: Range -> + T_Type -> + T_Types -> + T_Type +sem_Type_NormalApplication range_ function_ arguments_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _functionOgUniq :: UID + _functionOnmLev :: NmLev + _functionOtopInstanceNmL :: ([HsName]) + _argumentsOgUniq :: UID + _argumentsOnmLev :: NmLev + _argumentsOtopInstanceNmL :: ([HsName]) + _functionIconNm :: Name + _functionIgUniq :: UID + _functionItopInstanceNmL :: ([HsName]) + _argumentsIgUniq :: UID + _argumentsItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOconNm = + _functionIconNm + -- copy rule (up) + _lhsOgUniq = + _argumentsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _argumentsItopInstanceNmL + -- copy rule (down) + _functionOgUniq = + _lhsIgUniq + -- copy rule (down) + _functionOnmLev = + _lhsInmLev + -- copy rule (down) + _functionOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _argumentsOgUniq = + _functionIgUniq + -- copy rule (down) + _argumentsOnmLev = + _lhsInmLev + -- copy rule (chain) + _argumentsOtopInstanceNmL = + _functionItopInstanceNmL + ( _functionIconNm,_functionIgUniq,_functionItopInstanceNmL) | True = + function_ _functionOgUniq _functionOnmLev _functionOtopInstanceNmL + ( _argumentsIgUniq,_argumentsItopInstanceNmL) | True = + arguments_ _argumentsOgUniq _argumentsOnmLev _argumentsOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_InfixApplication :: Range -> + T_Type -> + T_Type -> + T_Type -> + T_Type +sem_Type_InfixApplication range_ leftType_ operator_ rightType_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOgUniq :: UID + _leftTypeOnmLev :: NmLev + _leftTypeOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOnmLev :: NmLev + _operatorOtopInstanceNmL :: ([HsName]) + _rightTypeOgUniq :: UID + _rightTypeOnmLev :: NmLev + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIconNm :: Name + _leftTypeIgUniq :: UID + _leftTypeItopInstanceNmL :: ([HsName]) + _operatorIconNm :: Name + _operatorIgUniq :: UID + _operatorItopInstanceNmL :: ([HsName]) + _rightTypeIconNm :: Name + _rightTypeIgUniq :: UID + _rightTypeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 256, column 9) + _lhsOconNm = + _operatorIconNm + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (down) + _leftTypeOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftTypeIgUniq + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftTypeItopInstanceNmL + -- copy rule (chain) + _rightTypeOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightTypeOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftTypeIconNm,_leftTypeIgUniq,_leftTypeItopInstanceNmL) | True = + leftType_ _leftTypeOgUniq _leftTypeOnmLev _leftTypeOtopInstanceNmL + ( _operatorIconNm,_operatorIgUniq,_operatorItopInstanceNmL) | True = + operator_ _operatorOgUniq _operatorOnmLev _operatorOtopInstanceNmL + ( _rightTypeIconNm,_rightTypeIgUniq,_rightTypeItopInstanceNmL) | True = + rightType_ _rightTypeOgUniq _rightTypeOnmLev _rightTypeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_InfixApplicationChainTop :: Range -> + T_Type -> + T_Type +sem_Type_InfixApplicationChainTop range_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOconNm = + _typeIconNm + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Constructor :: Range -> + Name -> + T_Type +sem_Type_Constructor range_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 254, column 9) + _lhsOconNm = + name_ + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Parenthesized :: Range -> + T_Type -> + T_Type +sem_Type_Parenthesized range_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_SectionApplication :: Range -> + T_MaybeType -> + T_Type -> + T_MaybeType -> + T_Type +sem_Type_SectionApplication range_ leftType_ operator_ rightType_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftTypeOgUniq :: UID + _leftTypeOnmLev :: NmLev + _leftTypeOtopInstanceNmL :: ([HsName]) + _operatorOgUniq :: UID + _operatorOnmLev :: NmLev + _operatorOtopInstanceNmL :: ([HsName]) + _rightTypeOgUniq :: UID + _rightTypeOnmLev :: NmLev + _rightTypeOtopInstanceNmL :: ([HsName]) + _leftTypeIgUniq :: UID + _leftTypeItopInstanceNmL :: ([HsName]) + _operatorIconNm :: Name + _operatorIgUniq :: UID + _operatorItopInstanceNmL :: ([HsName]) + _rightTypeIgUniq :: UID + _rightTypeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rightTypeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightTypeItopInstanceNmL + -- copy rule (down) + _leftTypeOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftTypeOnmLev = + _lhsInmLev + -- copy rule (down) + _leftTypeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _operatorOgUniq = + _leftTypeIgUniq + -- copy rule (down) + _operatorOnmLev = + _lhsInmLev + -- copy rule (chain) + _operatorOtopInstanceNmL = + _leftTypeItopInstanceNmL + -- copy rule (chain) + _rightTypeOgUniq = + _operatorIgUniq + -- copy rule (down) + _rightTypeOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightTypeOtopInstanceNmL = + _operatorItopInstanceNmL + ( _leftTypeIgUniq,_leftTypeItopInstanceNmL) | True = + leftType_ _leftTypeOgUniq _leftTypeOnmLev _leftTypeOtopInstanceNmL + ( _operatorIconNm,_operatorIgUniq,_operatorItopInstanceNmL) | True = + operator_ _operatorOgUniq _operatorOnmLev _operatorOtopInstanceNmL + ( _rightTypeIgUniq,_rightTypeItopInstanceNmL) | True = + rightType_ _rightTypeOgUniq _rightTypeOnmLev _rightTypeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Annotate :: Range -> + T_TypeAnnotation -> + T_Type -> + T_Type +sem_Type_Annotate range_ annotation_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _annotationOgUniq :: UID + _annotationOnmLev :: NmLev + _annotationOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _annotationIgUniq :: UID + _annotationItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _annotationOgUniq = + _lhsIgUniq + -- copy rule (down) + _annotationOnmLev = + _lhsInmLev + -- copy rule (down) + _annotationOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _annotationIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (chain) + _typeOtopInstanceNmL = + _annotationItopInstanceNmL + ( _annotationIgUniq,_annotationItopInstanceNmL) | True = + annotation_ _annotationOgUniq _annotationOnmLev _annotationOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Wildcard :: Range -> + T_Type +sem_Type_Wildcard range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_MonoWildcard :: Range -> + T_Type +sem_Type_MonoWildcard range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Variable :: Range -> + Name -> + T_Type +sem_Type_Variable range_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_NamedWildcard :: Range -> + Name -> + T_Type +sem_Type_NamedWildcard range_ name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Forall :: Range -> + Names -> + T_Type -> + T_Type +sem_Type_Forall range_ typevariables_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 33, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Exists :: Range -> + Names -> + T_Type -> + T_Type +sem_Type_Exists range_ typevariables_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameLevel.ag"(line 33, column 9) + _nmLev = + _lhsInmLev + 1 + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (from local) + _typeOnmLev = + _nmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + ( _rowTypeUpdatesIgUniq,_rowTypeUpdatesItopInstanceNmL) | True = + rowTypeUpdates_ _rowTypeUpdatesOgUniq _rowTypeUpdatesOnmLev _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowEmpty :: Range -> + T_Type +sem_Type_RowEmpty range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowRecUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowRecUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + ( _rowTypeUpdatesIgUniq,_rowTypeUpdatesItopInstanceNmL) | True = + rowTypeUpdates_ _rowTypeUpdatesOgUniq _rowTypeUpdatesOnmLev _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowRecEmpty :: Range -> + T_Type +sem_Type_RowRecEmpty range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowSumUpdate :: Range -> + T_Type -> + T_RowTypeUpdates -> + T_Type +sem_Type_RowSumUpdate range_ type_ rowTypeUpdates_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _rowTypeUpdatesOgUniq :: UID + _rowTypeUpdatesOnmLev :: NmLev + _rowTypeUpdatesOtopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + _rowTypeUpdatesIgUniq :: UID + _rowTypeUpdatesItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _rowTypeUpdatesIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rowTypeUpdatesItopInstanceNmL + -- copy rule (down) + _typeOgUniq = + _lhsIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (down) + _typeOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rowTypeUpdatesOgUniq = + _typeIgUniq + -- copy rule (down) + _rowTypeUpdatesOnmLev = + _lhsInmLev + -- copy rule (chain) + _rowTypeUpdatesOtopInstanceNmL = + _typeItopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + ( _rowTypeUpdatesIgUniq,_rowTypeUpdatesItopInstanceNmL) | True = + rowTypeUpdates_ _rowTypeUpdatesOgUniq _rowTypeUpdatesOnmLev _rowTypeUpdatesOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_RowSumEmpty :: Range -> + T_Type +sem_Type_RowSumEmpty range_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_Qualified :: Range -> + T_ContextItems -> + T_Type -> + T_Type +sem_Type_Qualified range_ context_ type_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _contextOgUniq :: UID + _contextOnmLev :: NmLev + _contextOtopInstanceNmL :: ([HsName]) + _typeOgUniq :: UID + _typeOnmLev :: NmLev + _typeOtopInstanceNmL :: ([HsName]) + _contextIgUniq :: UID + _contextItopInstanceNmL :: ([HsName]) + _typeIconNm :: Name + _typeIgUniq :: UID + _typeItopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (up) + _lhsOgUniq = + _typeIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _typeItopInstanceNmL + -- copy rule (down) + _contextOgUniq = + _lhsIgUniq + -- copy rule (down) + _contextOnmLev = + _lhsInmLev + -- copy rule (down) + _contextOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _typeOgUniq = + _contextIgUniq + -- copy rule (down) + _typeOnmLev = + _lhsInmLev + -- copy rule (chain) + _typeOtopInstanceNmL = + _contextItopInstanceNmL + ( _contextIgUniq,_contextItopInstanceNmL) | True = + context_ _contextOgUniq _contextOnmLev _contextOtopInstanceNmL + ( _typeIconNm,_typeIgUniq,_typeItopInstanceNmL) | True = + type_ _typeOgUniq _typeOnmLev _typeOtopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Type_TupleConstructor :: Range -> + Int -> + T_Type +sem_Type_TupleConstructor range_ arity_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOconNm :: Name + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 259, column 9) + _lhsOconNm = + hsnUnknown + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOconNm,_lhsOgUniq,_lhsOtopInstanceNmL))) +-- TypeAnnotation ---------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Strict: + alternative AnnotationName: + child name : {Name} + alternative AnnotationVar: + child name : {Name} + child var : {Name} +-} +-- cata +sem_TypeAnnotation :: TypeAnnotation -> + T_TypeAnnotation +sem_TypeAnnotation (TypeAnnotation_Strict) = + (sem_TypeAnnotation_Strict) +sem_TypeAnnotation (TypeAnnotation_AnnotationName _name) = + (sem_TypeAnnotation_AnnotationName _name) +sem_TypeAnnotation (TypeAnnotation_AnnotationVar _name _var) = + (sem_TypeAnnotation_AnnotationVar _name _var) +-- semantic domain +type T_TypeAnnotation = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_TypeAnnotation_Strict :: T_TypeAnnotation +sem_TypeAnnotation_Strict = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_TypeAnnotation_AnnotationName :: Name -> + T_TypeAnnotation +sem_TypeAnnotation_AnnotationName name_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_TypeAnnotation_AnnotationVar :: Name -> + Name -> + T_TypeAnnotation +sem_TypeAnnotation_AnnotationVar name_ var_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +-- TypeLeftHandSide -------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attributes: + idOccDefs : [IdOcc] + name : Name + range : Range + typevariables : Names + alternatives: + alternative Function: + child range : {Range} + child name : {Name} + child patterns : TypePatterns + alternative Infix: + child range : {Range} + child leftPattern : TypePattern + child operator : {Name} + child rightPattern : TypePattern + alternative Parenthesized: + child range : {Range} + child lefthandside : TypeLeftHandSide + child patterns : TypePatterns +-} +-- cata +sem_TypeLeftHandSide :: TypeLeftHandSide -> + T_TypeLeftHandSide +sem_TypeLeftHandSide (TypeLeftHandSide_Function _range _name _patterns) = + (sem_TypeLeftHandSide_Function _range _name (sem_TypePatterns _patterns)) +sem_TypeLeftHandSide (TypeLeftHandSide_Infix _range _leftPattern _operator _rightPattern) = + (sem_TypeLeftHandSide_Infix _range (sem_TypePattern _leftPattern) _operator (sem_TypePattern _rightPattern)) +sem_TypeLeftHandSide (TypeLeftHandSide_Parenthesized _range _lefthandside _patterns) = + (sem_TypeLeftHandSide_Parenthesized _range (sem_TypeLeftHandSide _lefthandside) (sem_TypePatterns _patterns)) +-- semantic domain +type T_TypeLeftHandSide = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([IdOcc]),Name,Range,([HsName]),Names) +sem_TypeLeftHandSide_Function :: Range -> + Name -> + T_TypePatterns -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Function range_ name_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOrange :: Range + _lhsOname :: Name + _lhsOidOccDefs :: ([IdOcc]) + _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _patternsIgUniq :: UID + _patternsItopInstanceNmL :: ([HsName]) + _patternsItypevariables :: Names + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 205, column 9) + _lhsOrange = + range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 205, column 9) + _lhsOname = + name_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _patternsItypevariables + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _patternsOgUniq = + _lhsIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (down) + _patternsOtopInstanceNmL = + _lhsItopInstanceNmL + ( _patternsIgUniq,_patternsItopInstanceNmL,_patternsItypevariables) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOname,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables))) +sem_TypeLeftHandSide_Infix :: Range -> + T_TypePattern -> + Name -> + T_TypePattern -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Infix range_ leftPattern_ operator_ rightPattern_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOrange :: Range + _lhsOname :: Name + _lhsOidOccDefs :: ([IdOcc]) + _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _leftPatternOgUniq :: UID + _leftPatternOmoduleNm :: HsName + _leftPatternOnmLev :: NmLev + _leftPatternOtopInstanceNmL :: ([HsName]) + _rightPatternOgUniq :: UID + _rightPatternOmoduleNm :: HsName + _rightPatternOnmLev :: NmLev + _rightPatternOtopInstanceNmL :: ([HsName]) + _leftPatternIgUniq :: UID + _leftPatternItopInstanceNmL :: ([HsName]) + _leftPatternItypevariables :: Names + _rightPatternIgUniq :: UID + _rightPatternItopInstanceNmL :: ([HsName]) + _rightPatternItypevariables :: Names + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 208, column 9) + _lhsOrange = + range_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 208, column 9) + _lhsOname = + operator_ + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _leftPatternItypevariables ++ _rightPatternItypevariables + -- copy rule (up) + _lhsOgUniq = + _rightPatternIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _rightPatternItopInstanceNmL + -- copy rule (down) + _leftPatternOgUniq = + _lhsIgUniq + -- copy rule (down) + _leftPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _leftPatternOnmLev = + _lhsInmLev + -- copy rule (down) + _leftPatternOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _rightPatternOgUniq = + _leftPatternIgUniq + -- copy rule (down) + _rightPatternOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _rightPatternOnmLev = + _lhsInmLev + -- copy rule (chain) + _rightPatternOtopInstanceNmL = + _leftPatternItopInstanceNmL + ( _leftPatternIgUniq,_leftPatternItopInstanceNmL,_leftPatternItypevariables) | True = + leftPattern_ _leftPatternOgUniq _leftPatternOmoduleNm _leftPatternOnmLev _leftPatternOtopInstanceNmL + ( _rightPatternIgUniq,_rightPatternItopInstanceNmL,_rightPatternItypevariables) | True = + rightPattern_ _rightPatternOgUniq _rightPatternOmoduleNm _rightPatternOnmLev _rightPatternOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOname,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables))) +sem_TypeLeftHandSide_Parenthesized :: Range -> + T_TypeLeftHandSide -> + T_TypePatterns -> + T_TypeLeftHandSide +sem_TypeLeftHandSide_Parenthesized range_ lefthandside_ patterns_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOidOccDefs :: ([IdOcc]) + _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOname :: Name + _lhsOrange :: Range + _lhsOtopInstanceNmL :: ([HsName]) + _lefthandsideOgUniq :: UID + _lefthandsideOmoduleNm :: HsName + _lefthandsideOnmLev :: NmLev + _lefthandsideOtopInstanceNmL :: ([HsName]) + _patternsOgUniq :: UID + _patternsOmoduleNm :: HsName + _patternsOnmLev :: NmLev + _patternsOtopInstanceNmL :: ([HsName]) + _lefthandsideIgUniq :: UID + _lefthandsideIidOccDefs :: ([IdOcc]) + _lefthandsideIname :: Name + _lefthandsideIrange :: Range + _lefthandsideItopInstanceNmL :: ([HsName]) + _lefthandsideItypevariables :: Names + _patternsIgUniq :: UID + _patternsItopInstanceNmL :: ([HsName]) + _patternsItypevariables :: Names + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 109, column 21) + _lhsOidOccDefs = + _lefthandsideIidOccDefs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _lefthandsideItypevariables ++ _patternsItypevariables + -- copy rule (up) + _lhsOgUniq = + _patternsIgUniq + -- copy rule (up) + _lhsOname = + _lefthandsideIname + -- copy rule (up) + _lhsOrange = + _lefthandsideIrange + -- copy rule (up) + _lhsOtopInstanceNmL = + _patternsItopInstanceNmL + -- copy rule (down) + _lefthandsideOgUniq = + _lhsIgUniq + -- copy rule (down) + _lefthandsideOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _lefthandsideOnmLev = + _lhsInmLev + -- copy rule (down) + _lefthandsideOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _patternsOgUniq = + _lefthandsideIgUniq + -- copy rule (down) + _patternsOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _patternsOnmLev = + _lhsInmLev + -- copy rule (chain) + _patternsOtopInstanceNmL = + _lefthandsideItopInstanceNmL + ( _lefthandsideIgUniq,_lefthandsideIidOccDefs,_lefthandsideIname,_lefthandsideIrange,_lefthandsideItopInstanceNmL,_lefthandsideItypevariables) | True = + lefthandside_ _lefthandsideOgUniq _lefthandsideOmoduleNm _lefthandsideOnmLev _lefthandsideOtopInstanceNmL + ( _patternsIgUniq,_patternsItopInstanceNmL,_patternsItypevariables) | True = + patterns_ _patternsOgUniq _patternsOmoduleNm _patternsOnmLev _patternsOtopInstanceNmL + in ( _lhsOgUniq,_lhsOidOccDefs,_lhsOname,_lhsOrange,_lhsOtopInstanceNmL,_lhsOtypevariables))) +-- TypePattern ------------------------------------------------- +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + typevariables : Names + alternatives: + alternative Variable: + child range : {Range} + child name : {Name} + visit 0: + local refname : _ +-} +-- cata +sem_TypePattern :: TypePattern -> + T_TypePattern +sem_TypePattern (TypePattern_Variable _range _name) = + (sem_TypePattern_Variable _range _name) +-- semantic domain +type T_TypePattern = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([HsName]),Names) +sem_TypePattern_Variable :: Range -> + Name -> + T_TypePattern +sem_TypePattern_Variable range_ name_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 58, column 9) + _refname = + hsnSetLevQual _lhsInmLev _lhsImoduleNm name_ + -- "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 213, column 9) + _lhsOtypevariables = + [name_] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL,_lhsOtypevariables))) +-- TypePatterns ------------------------------------------------ +{- + visit 0: + inherited attributes: + moduleNm : HsName + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + synthesized attribute: + typevariables : Names + alternatives: + alternative Cons: + child hd : TypePattern + child tl : TypePatterns + alternative Nil: +-} +-- cata +sem_TypePatterns :: TypePatterns -> + T_TypePatterns +sem_TypePatterns list = + (Prelude.foldr sem_TypePatterns_Cons sem_TypePatterns_Nil (Prelude.map sem_TypePattern list)) +-- semantic domain +type T_TypePatterns = UID -> + HsName -> + NmLev -> + ([HsName]) -> + ( UID,([HsName]),Names) +sem_TypePatterns_Cons :: T_TypePattern -> + T_TypePatterns -> + T_TypePatterns +sem_TypePatterns_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOmoduleNm :: HsName + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOmoduleNm :: HsName + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _hdItypevariables :: Names + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + _tlItypevariables :: Names + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + _hdItypevariables ++ _tlItypevariables + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOmoduleNm = + _lhsImoduleNm + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIgUniq,_hdItopInstanceNmL,_hdItypevariables) | True = + hd_ _hdOgUniq _hdOmoduleNm _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL,_tlItypevariables) | True = + tl_ _tlOgUniq _tlOmoduleNm _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL,_lhsOtypevariables))) +sem_TypePatterns_Nil :: T_TypePatterns +sem_TypePatterns_Nil = + (\ _lhsIgUniq + _lhsImoduleNm + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOtypevariables :: Names + _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/HS/NameDef.ag"(line 201, column 25) + _lhsOtypevariables = + [] + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL,_lhsOtypevariables))) +-- Types ------------------------------------------------------- +{- + visit 0: + inherited attribute: + nmLev : NmLev + chained attributes: + gUniq : UID + topInstanceNmL : [HsName] + alternatives: + alternative Cons: + child hd : Type + child tl : Types + alternative Nil: +-} +-- cata +sem_Types :: Types -> + T_Types +sem_Types list = + (Prelude.foldr sem_Types_Cons sem_Types_Nil (Prelude.map sem_Type list)) +-- semantic domain +type T_Types = UID -> + NmLev -> + ([HsName]) -> + ( UID,([HsName])) +sem_Types_Cons :: T_Type -> + T_Types -> + T_Types +sem_Types_Cons hd_ tl_ = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + _hdOgUniq :: UID + _hdOnmLev :: NmLev + _hdOtopInstanceNmL :: ([HsName]) + _tlOgUniq :: UID + _tlOnmLev :: NmLev + _tlOtopInstanceNmL :: ([HsName]) + _hdIconNm :: Name + _hdIgUniq :: UID + _hdItopInstanceNmL :: ([HsName]) + _tlIgUniq :: UID + _tlItopInstanceNmL :: ([HsName]) + -- copy rule (up) + _lhsOgUniq = + _tlIgUniq + -- copy rule (up) + _lhsOtopInstanceNmL = + _tlItopInstanceNmL + -- copy rule (down) + _hdOgUniq = + _lhsIgUniq + -- copy rule (down) + _hdOnmLev = + _lhsInmLev + -- copy rule (down) + _hdOtopInstanceNmL = + _lhsItopInstanceNmL + -- copy rule (chain) + _tlOgUniq = + _hdIgUniq + -- copy rule (down) + _tlOnmLev = + _lhsInmLev + -- copy rule (chain) + _tlOtopInstanceNmL = + _hdItopInstanceNmL + ( _hdIconNm,_hdIgUniq,_hdItopInstanceNmL) | True = + hd_ _hdOgUniq _hdOnmLev _hdOtopInstanceNmL + ( _tlIgUniq,_tlItopInstanceNmL) | True = + tl_ _tlOgUniq _tlOnmLev _tlOtopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) +sem_Types_Nil :: T_Types +sem_Types_Nil = + (\ _lhsIgUniq + _lhsInmLev + _lhsItopInstanceNmL -> + (let _lhsOgUniq :: UID + _lhsOtopInstanceNmL :: ([HsName]) + -- copy rule (chain) + _lhsOgUniq = + _lhsIgUniq + -- copy rule (chain) + _lhsOtopInstanceNmL = + _lhsItopInstanceNmL + in ( _lhsOgUniq,_lhsOtopInstanceNmL))) diff --git a/src/UHC/Light/Compiler/HS/Parser.hs b/src/UHC/Light/Compiler/HS/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/HS/Parser.hs @@ -0,0 +1,1628 @@ +module UHC.Light.Compiler.HS.Parser +( HSParser, HSParser' +, pAGItf +, pAGItfImport ) +where +import UU.Parsing +import UU.Parsing.Offside +import UHC.Util.ParseUtils +import UU.Scanner.GenToken +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.HS +import System.IO +import UHC.Util.Utils +import UHC.Util.Pretty +import Data.Maybe +import UHC.Light.Compiler.Base.Target +import qualified UHC.Util.FastSeq as Seq + + + + + +{-# LINE 41 "src/ehc/HS/Parser.chs" #-} +pPacked' :: HSParser Token -> HSParser Token -> HSParser (Range -> v) -> HSParser v +pPacked' pO pC pMk = (\o mk c -> mk (mkRange2 o c)) <$> pO <*> pMk <*> pC + +pParens' :: HSParser (Range -> v) -> HSParser v +pParens' = pPacked' pOPAREN pCPAREN + +pBracks' :: HSParser (Range -> v) -> HSParser v +pBracks' = pPacked' pOBRACK pCBRACK + +pCurlys' :: HSParser (Range -> v) -> HSParser v +pCurlys' = pPacked' pOCURLY pCCURLY + +{-# LINE 55 "src/ehc/HS/Parser.chs" #-} +pImpls' :: HSParser (Range -> v) -> HSParser v +pImpls' = pPacked' pOIMPL pCIMPL + +pImpls :: IsParser p Token => p v -> p v +pImpls = pPacked pOIMPL pCIMPL + +{-# LINE 63 "src/ehc/HS/Parser.chs" #-} +pApp :: AppLike a boundmeta => HSParser a -> HSParser a +pApp p = appTopApp <$> pList1 p + +{-# LINE 72 "src/ehc/HS/Parser.chs" #-} +type HSParser ep = LayoutParser Token ep +type HSParser2 ep = LayoutParser2 Token ep +type HSParser' ep = PlainParser Token ep + +{-# LINE 78 "src/ehc/HS/Parser.chs" #-} +pAGItf :: EHCOpts -> HSParser AGItf +pAGItf opts + = AGItf_AGItf <$> pModule opts pBody' + +{-# LINE 88 "src/ehc/HS/Parser.chs" #-} +pAGItfImport :: EHCOpts -> HSParser AGItf +pAGItfImport opts + = AGItf_AGItf <$> pModule opts (\opts _ -> pBodyImport opts) + +{-# LINE 102 "src/ehc/HS/Parser.chs" #-} +data Expression4Result + = Expression4Result_Op (Expression,Range) + | Expression4Result_CommaList [Expression] + | Expression4Result_Typed + | Expression4Result_NotOpPre + -- deriving Eq + +type Expression4 = (Expression,Int,[Expression4Result]) + + +{-# LINE 118 "src/ehc/HS/Parser.chs" #-} +pPragma' :: (Range -> Pragma -> x) -> HSParser x +pPragma' mk + = pPacked' pOPRAGMA pCPRAGMA + ( (\t ps r -> mk r $ Pragma_Language (mkRange1 t) ps) + <$> pLANGUAGE_prag <*> pCommas (tokMkQName <$> conid) + <|> (\t cl fld val r -> mk r $ Pragma_Derivable (mkRange1 t) (tokMkQName cl) (tokMkQName fld) (tokMkQName val)) + <$> pDERIVABLE_prag <*> gtycon' tyconsym <*> var <*> qvar + <|> (\t targ r -> mk r $ Pragma_ExcludeIfTarget (mkRange1 t) (map tokMkStr $ concat targ)) + <$> pEXCLUDEIFTARGET_prag <*> pList1Sep pCOMMA (pList1 (conid <|> varid)) + <|> (\t targ r -> mk r $ Pragma_OptionsUHC (mkRange1 t) (tokMkStr targ)) + <$> pOPTIONSUHC_prag <*> pStringTk + ) + +pPragma :: HSParser Pragma +pPragma = pPragma' (flip const) + +pDeclarationPragma :: HSParser Declaration +pDeclarationPragma + = pPragma' Declaration_Pragma + + +{-# LINE 145 "src/ehc/HS/Parser.chs" #-} +pModule :: EHCOpts -> (EHCOpts -> (HSParser2 Declaration) -> HSParser Body) -> HSParser Module +pModule opts pBody + = pList_gr pPragma + <**> ( (\ b p -> Module_Module emptyRange Nothing p Nothing b) <$> pBody opts id + <|> (\t m e b p -> Module_Module (mkRange1 t) (Just $ tokMkQName $ m) p e b) <$> pMODULE <*> modid <*> pMaybeExports <* pWHERE <*> pBody opts (\d -> d <|> pDeclarationPragma) + ) + "pModule" + +{-# LINE 171 "src/ehc/HS/Parser.chs" #-} +pImportExport :: (Range -> Name -> ie,Range -> Name -> MaybeNames -> ie,Range -> Name -> ie) -> HSParser ie +pImportExport (sem_Var,sem_tOrC,sem_tOrC_complete) + = mkRngNm sem_Var <$> qvar + <|> qtycon + <**> ( pParens + ( (\c n -> mkRngNm sem_tOrC n (Just (tokMkQNames c))) <$> qcnames + <|> mkRngNm sem_tOrC_complete <$ pDOTDOT + ) + <|> pSucceed (\n -> mkRngNm sem_tOrC n Nothing) + ) + "pImportExport" + +{-# LINE 185 "src/ehc/HS/Parser.chs" #-} +pExport :: HSParser Export +pExport + = (\t m -> Export_Module (mkRange1 t) (tokMkQName m)) <$> pMODULE <*> modid + <|> pImportExport (Export_Variable,Export_TypeOrClass,Export_TypeOrClassComplete) + "pExport" + +pMaybeExports :: HSParser MaybeExports +pMaybeExports + = Just <$> pParens (pListSep_ng pCOMMA pExport <* pMb pCOMMA) + <|> pSucceed Nothing + "pMaybeExports" + +{-# LINE 199 "src/ehc/HS/Parser.chs" #-} +pImport :: HSParser Import +pImport + = pImportExport (Import_Variable,Import_TypeOrClass,Import_TypeOrClassComplete) + "pImport" + +pImportDeclaration :: HSParser ImportDeclaration +pImportDeclaration + = (\q m a i -> ImportDeclaration_Import (mkRange1 m) q (tokMkQName m) (fmap tokMkQName a) i) + <$ pIMPORT <*> (True <$ pQUALIFIED <|> pSucceed False) + <*> modid + <*> (Just <$ pAS <*> modid <|> pSucceed Nothing) + <*> (Just <$> pImportSpecification <|> pSucceed Nothing) + "pImportDeclaration" + where pImportSpecification :: HSParser ImportSpecification + pImportSpecification + = (True <$ pHIDING <|> pSucceed False) + <**> pParens' + ((\i r h -> ImportSpecification_Import r h i) <$> pListSep_ng pCOMMA pImport <* pMb pCOMMA) + +{-# LINE 224 "src/ehc/HS/Parser.chs" #-} +pLayoutList :: HSParser d -> HSParser [d] +pLayoutList pD + = pBlock pOCURLY pSEMI pCCURLY pD + +pLayoutList1 :: HSParser d -> HSParser [d] +pLayoutList1 pD + = pBlock1 pOCURLY pSEMI pCCURLY pD + + +{-# LINE 239 "src/ehc/HS/Parser.chs" #-} +pBodyImport :: EHCOpts -> HSParser Body +pBodyImport opts + = (\d -> Body_Body emptyRange d []) <$> pLayoutList pImportDeclaration + "pBodyImport" + +{-# LINE 246 "src/ehc/HS/Parser.chs" #-} +pBody :: EHCOpts -> HSParser Body +pBody opts = pBody' opts id + +{-# LINE 251 "src/ehc/HS/Parser.chs" #-} +pBody' :: EHCOpts -> (HSParser2 Declaration) -> HSParser Body +pBody' opts addDecl + = (\ids -> let (i,d) = foldr cmbid ([],[]) ids in Body_Body emptyRange i d) + <$> pLayoutList ( (\d -> ([],[d])) <$> (addDecl pTopDeclaration) + <|> (\i -> ([i],[])) <$> pImportDeclaration + ) + "pBody" + where + cmbid ([i],_) (is,ds) = (i:is,ds) + cmbid (_,[d]) (_ ,ds) = ([],d:ds) + +{-# LINE 275 "src/ehc/HS/Parser.chs" #-} + pDeclaration :: HSParser Declaration + pDeclaration + = pDeclarationValue + <|> pDeclarationTypeSignature + <|> pDeclarationData + <|> pDeclarationKindSignature + <|> pDeclarationInstance + <|> pDeclarationType + <|> pDeclarationFusion + <|> pDeclarationConversion + "pDeclaration" + +{-# LINE 299 "src/ehc/HS/Parser.chs" #-} + pTopDeclaration :: HSParser Declaration + pTopDeclaration + = pDeclaration + <|> pDeclarationFixity + <|> pDeclarationForeign + <|> pDeclarationClass + <|> pDeclarationDefault + "pTopDeclaration" + +{-# LINE 314 "src/ehc/HS/Parser.chs" #-} + pDeclarations :: HSParser Declarations + pDeclarations + = pLayoutList pDeclaration + + pDeclarations1 :: HSParser Declarations + pDeclarations1 + = pLayoutList1 pDeclaration + +{-# LINE 324 "src/ehc/HS/Parser.chs" #-} + pWhere'' :: HSParser d -> HSParser [d] + pWhere'' pD = pWHERE *> pLayoutList pD + + pWhere' :: HSParser d -> HSParser (Maybe [d]) + pWhere' pD = pMb (pWhere'' pD) + + pWhere :: HSParser MaybeDeclarations + pWhere = pWhere' pDeclaration + +{-# LINE 339 "src/ehc/HS/Parser.chs" #-} + pDeclarationFixity :: HSParser Declaration + pDeclarationFixity + = (\f p os@(o:_) -> Declaration_Fixity (mkRange1 o) f p (tokMkQNames os)) + <$> pFixity + <*> ((Just . tokMkInt) <$> pInteger10Tk <|> pSucceed Nothing) + <*> pList1Sep pCOMMA op + + pFixity :: HSParser' Fixity + pFixity = Fixity_Infixl <$ pINFIXL <|> Fixity_Infixr <$ pINFIXR <|> Fixity_Infix <$ pINFIX + +{-# LINE 355 "src/ehc/HS/Parser.chs" #-} + pDeclarationTypeSignature :: HSParser Declaration + pDeclarationTypeSignature + = (\(v:vs) t -> Declaration_TypeSignature (mkRange1 v) (tokMkQNames (v:vs)) t) + <$> pList1Sep pCOMMA var <* pDCOLON <*> pType + "pDeclarationTypeSignature" + + pDeclarationValue :: HSParser Declaration + pDeclarationValue + = mkF <$> pLhs <*> rhs + <|> pPatternOp + <**> ( (flip mkP) <$> rhs + <|> (\o r rhs l -> mkF (mkLI l o r) rhs) + <$> pVarOp <*> pPatternOp <*> rhs + ) + "pDeclarationValue" + where pVarOp :: HSParser Token + pVarOp = if ehcOptBangPatterns opts then varop_no_bang else varop + pLhsTail :: HSParser [Pattern] + pLhsTail = pList1 pPatternBaseCon + pLhs :: HSParser (Range,LeftHandSide) + pLhs = (\v lhs -> let r = mkRange1 v in (r, LeftHandSide_Function r (tokMkQName v) lhs)) <$> var <*> pLhsTail + <|> pParens' + ( (\l r t -> (r, mkLP r l t)) + <$> pLhs + <|> (\pl o pr r t -> (r, mkLP r (mkLI pl o pr) t)) + <$> pPatternOp <*> varop <*> pPatternOp + ) + <*> pLhsTail + mkP p rhs = Declaration_PatternBinding emptyRange (p2p p) rhs' + where (p2p,rhs') = mkTyPat rhs + mkF (r,lhs) rhs= Declaration_FunctionBindings r [FunctionBinding_FunctionBinding r (l2l lhs) rhs'] + where (l2l,rhs') = mkTyLhs rhs + mkLI l o rh = (r, LeftHandSide_Infix r l (tokMkQName o) rh) + where r = mkRange1 o + mkLP r (_,l) t = LeftHandSide_Parenthesized r l t + rhs = pMbTy <+> pRhs pEQUAL + pMbTy :: HSParser (Maybe (Token,Type)) + pMbTy = pMb (pDCOLON <+> pType) + mkTyLhs (Just (tok,ty),rhs) = (\l -> LeftHandSide_Typed (mkRange1 tok) l ty,rhs) + mkTyLhs (_ ,rhs) = (id ,rhs) + mkTyPat (Just (tok,ty),rhs) = (\p -> Pattern_Typed (mkRange1 tok) p ty,rhs) + mkTyPat (_ ,rhs) = (id ,rhs) + +{-# LINE 410 "src/ehc/HS/Parser.chs" #-} + pDeclarationSimpleValue :: HSParser Declaration + pDeclarationSimpleValue + = Declaration_PatternBinding emptyRange <$> lhs <*> rhs + "pDeclarationSimpleValue" + where lhs = mkRngNm Pattern_Variable <$> var + rhs = (\t e -> RightHandSide_Expression (mkRange1 t) e Nothing) <$> pEQUAL <*> pExpression + +{-# LINE 419 "src/ehc/HS/Parser.chs" #-} + pRhs :: HSParser Token -> HSParser RightHandSide + pRhs pSep + = (RightHandSide_Expression . mkRange1) <$> pSep <*> pExpression <*> pWhere + <|> RightHandSide_Guarded emptyRange + <$> pList1 ((GuardedExpression_GuardedExpression . mkRange1) <$> pVBAR <*> pExpression <* pSep <*> pExpression) + <*> pWhere + "pRhs" + +{-# LINE 431 "src/ehc/HS/Parser.chs" #-} + pDeclarationKindSignature :: HSParser Declaration + pDeclarationKindSignature + = (\(v:vs) t -> Declaration_KindSignature (mkRange1 v) (tokMkQNames (v:vs)) t) + <$> pList1Sep pCOMMA con <* pDCOLON <*> pKind + "pDeclarationKindSignature" + +{-# LINE 443 "src/ehc/HS/Parser.chs" #-} + pDeclarationData :: HSParser Declaration + pDeclarationData + = pDATA + <**> (pCtxt + <**> (pTypeLeftHandSide + <**> ( (\cs der lhs cx k -> mk Declaration_Data k cx lhs cs der) + <$> (pEQUAL *> pListSep pVBAR pDCon) <*> pDer + <|> (\cs der lhs cx k -> mk Declaration_Data k cx lhs cs der) + <$> pWhere'' (pGADTConstructor) <*> pDer + <|> pSucceed (\lhs cx k -> mk Declaration_Data k cx lhs [] []) + ))) + <|> pNEWTYPE + <**> ( (\cx lhs c der k -> mk Declaration_Newtype k cx lhs c der) + <$> pCtxt <*> pTypeLeftHandSide <* pEQUAL <*> pNCon <*> pDer + ) + "pDeclarationData" + where mk sem = + \k cx lhs cs der + -> sem (mkRange1 k) cx lhs cs der + -- TBD, for now: parse, but ignore quantifiers + pDCon, pNCon :: HSParser Constructor + pDCon = pList pTypeQuantPrefix *> pContextedConstructor + pNCon = pList pTypeQuantPrefix *> pConstructor + pCtxt :: HSParser ContextItems + pCtxt = pContextItemsPrefixOpt + pDer :: HSParser [Deriving] + pDer = pDERIVING *> ((:[]) <$> pDeriving <|> pParens (pListSep pCOMMA pDeriving)) <|> pSucceed [] + +{-# LINE 495 "src/ehc/HS/Parser.chs" #-} + pDeriving :: HSParser Deriving + pDeriving + = (\(n,u) t -> Deriving_Deriving (mkRange1 t) n u (tokMkQName t)) <$> pInstanceName <*> qconid + +{-# LINE 501 "src/ehc/HS/Parser.chs" #-} + pConstructor :: HSParser Constructor + pConstructor + = con + <**> ( (\ts c -> mkRngNm Constructor_Constructor c ts) <$> pList pTB +{-# LINE 507 "src/ehc/HS/Parser.chs" #-} + <|> pCurlys' ((\fs r c -> mkRngNm Constructor_Record c fs) <$> pListSep pCOMMA pFieldDeclaration) +{-# LINE 510 "src/ehc/HS/Parser.chs" #-} + ) + <|> (\l o r -> Constructor_Infix (mkRange1 o) l (tokMkQName o) r) <$> pT <*> conop <*> pT + where pT = pAnnotatedType pType + pTB = pAnnotatedType pTypeBase + +{-# LINE 517 "src/ehc/HS/Parser.chs" #-} + pContextedConstructor :: HSParser Constructor + pContextedConstructor + = Constructor_Contexted emptyRange <$> pContextItemsPrefix <*> pConstructor + <|> pConstructor + +{-# LINE 524 "src/ehc/HS/Parser.chs" #-} + pGADTConstructor :: HSParser Constructor + pGADTConstructor + = mkRngNm Constructor_GADTFunction <$> con <* pDCOLON <*> pType + +{-# LINE 530 "src/ehc/HS/Parser.chs" #-} + pFieldDeclaration :: HSParser FieldDeclaration + pFieldDeclaration + = (\vs@(v:_) -> FieldDeclaration_FieldDeclaration (mkRange1 v) (tokMkQNames vs)) + <$> pList1Sep pCOMMA var <* pDCOLON <*> pAnnotatedType pType + +{-# LINE 541 "src/ehc/HS/Parser.chs" #-} + pDeclarationForeign :: HSParser Declaration + pDeclarationForeign + = pFOREIGN + <**> ( (\c s (i,n,t) r -> Declaration_ForeignImport (mkRange1 r) (fst c) s i (tokMkQName n) t) + <$ pIMPORT <*> pFFIWay <*> pSafety <*> pFSpec + <|> (\c (i,n,t) r -> Declaration_ForeignExport (mkRange1 r) (fst c) i (tokMkQName n) t) + <$ pEXPORT <*> pFFIWay <*> pFSpec + ) + where pSafety = (Just . tokMkStr) <$> safety <|> pSucceed Nothing + pFSpec = (,,) <$> ((Just . tokMkStr) <$> pStringTk <|> pSucceed Nothing) <*> var{-id_no_foreign-} <* pDCOLON <*> pType + +{-# LINE 560 "src/ehc/HS/Parser.chs" #-} + pDeclarationClass :: HSParser Declaration + pDeclarationClass + = (\t -> Declaration_Class (mkRange1 t)) + <$> pCLASS + <*> pContextItemsPrefixOpt <*> pTypeLeftHandSide + <*> (pVBAR *> pListSep pCOMMA pFunctionalDependency + `opt` [] + ) + <*> pWhere' (pDeclarationValue <|> pDeclarationTypeSignature) + where pFunctionalDependency :: HSParser FunctionalDependency + pFunctionalDependency + = (\vs1@(v:_) vs2 -> FunctionalDependency_Dependency (mkRange1 v) (tokMkQNames vs1) (tokMkQNames vs2)) + <$> pList1 tyvar <* pRARROW <*> pList1 tyvar + +{-# LINE 580 "src/ehc/HS/Parser.chs" #-} + pInstanceName :: HSParser (Maybe HsName,Bool) + pInstanceName + = (\n e -> (Just (tokMkQName n),e)) <$> varid <*> (True <$ pLTCOLON <|> False <$ pDCOLON) + <|> pSucceed (Nothing,True) + +{-# LINE 587 "src/ehc/HS/Parser.chs" #-} + pDeclarationInstance :: HSParser Declaration + pDeclarationInstance + = pINSTANCE + <**> ( -- (\((n,u),c,cl,ts) d t -> Declaration_Instance (mkRange1 t) InstNormal n u c (tokMkQName cl) ts d) + (\((n,u),c,h) d t -> Declaration_Instance (mkRange1 t) InstNormal n u c h d) + <$> pHeader + <*> pWhere' pDeclarationValue + <|> (\e cl ts t -> Declaration_InstanceUseImplicitly (mkRange1 t) e (tokMkQName cl) ts) + <$> pExpression <* pLTCOLON <*> qconid <*> pList1 pTypeBase + ) + <|> -- (\t ((n,u),c,cl,ts) -> Declaration_Instance (mkRange1 t) (InstDeriving InstDerivingFrom_Standalone) n u c (tokMkQName cl) ts Nothing) + (\t ((n,u),c,h) -> Declaration_Instance (mkRange1 t) (InstDeriving InstDerivingFrom_Standalone) n u c h Nothing) + <$> pDERIVING <* pINSTANCE <*> pHeader + -- where pHeader = (,,,) <$> pInstanceName <*> pContextItemsPrefixOpt <*> qconid <*> pList1 pTypeBase + where pHeader = (,,) <$> pInstanceName <*> pContextItemsPrefixOpt <*> pType' pTypeOpBase (\_ p -> p) + +{-# LINE 607 "src/ehc/HS/Parser.chs" #-} + pDeclarationDefault :: HSParser Declaration + pDeclarationDefault + = (Declaration_Default . mkRange1) <$> pDEFAULT <*> pMb (tokMkQName <$> qtyconid) + <*> ( (:[]) <$> pTypeBase + <|> pParens (pListSep pCOMMA pTypeBase) + ) + +{-# LINE 620 "src/ehc/HS/Parser.chs" #-} + pDeclarationType :: HSParser Declaration + pDeclarationType + = (Declaration_Type . mkRange1) <$> pTYPE <*> pTypeLeftHandSide <* pEQUAL <*> pType + +{-# LINE 631 "src/ehc/HS/Parser.chs" #-} + + pDeclarationFusion :: HSParser Declaration + pDeclarationFusion + = (Declaration_FusionDeclaration . mkRange1) <$> pFUSE <*> (tokMkQName <$> qvar) -- <* pWITH <*> (tokMkQName <$> qvar) + + pDeclarationConversion :: HSParser Declaration + pDeclarationConversion + = (Declaration_FusionConversion . mkRange1) <$> pCONVERT <*> (tokMkQName <$> qvar) <* pCOMMA <*> (tokMkQName <$> qvar) + +{-# LINE 647 "src/ehc/HS/Parser.chs" #-} + pKindBase :: HSParser Kind + pKindBase + = mkRngNm Kind_Constructor <$> pSTAR + <|> mkRngNm Kind_Variable <$> tyvar + <|> pParens' pInParens + "pKindBase" + where pInParens :: HSParser (Range -> Kind) + pInParens + = (pKind + <**> ( pSucceed (flip Kind_Parenthesized) + ) ) + + pKind :: HSParser Kind + pKind + = mkK <$> pK + "pKind" + where pK :: HSParser (Kind,Int) + pK = pKindBase + <**> ( pSucceed (\k -> (k,1)) + <|> (\(op,rng) (r,opCnt) l -> (Kind_InfixApplication rng l op r,opCnt+1)) <$> pKindOp <*> pK + ) + <|> (\p e -> (p $ mkK $ e,1)) <$> pKindPrefix <*> pK + mkK (e,1) = e + mkK (e,_) = {- Expression_InfixApplicationChainTop emptyRange -} e + pKindOp :: HSParser (Kind,Range) + pKindOp = mkRngNm' Kind_Constructor <$> pRARROW + + pKindPrefix :: HSParser (Kind -> Kind) + pKindPrefix + = ((Kind_Forall . mkRange1) <$> pFORALL) + <*> (tokMkQNames <$> pTyVarBinds) <* pDOT + +{-# LINE 685 "src/ehc/HS/Parser.chs" #-} + pTypeBaseCon :: HSParser Type + pTypeBaseCon + = mkRngNm Type_Constructor <$> gtycon_no_delims_commas + + pTypeBase :: HSParser Type + pTypeBase + = pTypeBaseCon + <|> (Type_Wildcard . mkRange1) <$> pTDOT + <|> (Type_MonoWildcard . mkRange1) <$> pQDOT + <|> mkRngNm Type_Variable <$> var_no_ty + <|> mkRngNm Type_NamedWildcard <$ pPERCENT <*> tyvar + <|> pBracks' + ( (\t r -> Type_NormalApplication r (Type_Constructor r hsnDataList) [t]) + <$> pType + <|> pSucceed (\r -> Type_Constructor r hsnDataList) + ) + <|> pParens' pInParens + <|> pPacked' pOROWROW pCROWROW + ( pExtFlds Type_RowEmpty Type_RowUpdate + <|> (\fs r -> Type_RowUpdate r (Type_RowEmpty r) fs) <$> pFlds + ) + <|> pPacked' pOROWSUM pCROWSUM + ( pExtFlds Type_RowSumEmpty Type_RowSumUpdate + <|> (\fs r -> Type_RowSumUpdate r (Type_RowSumEmpty r) fs) <$> pFlds + ) + where pInParens :: HSParser (Range -> Type) + pInParens + = (pType + <**> ( pSucceed (flip Type_Parenthesized) + <|> (\es e r -> Type_RowRecUpdate r (Type_RowRecEmpty r) + (map (RowTypeUpdate_Extends r Nothing) (e:es))) + <$> pList1 (pComma *> pType) + <|> (\(o,_) e r -> Type_SectionApplication r (Just e) o Nothing) + <$> pTypeOpBaseEq + ) ) + <|> (pTypeOpBaseEq + <**> ( (\e (o,_) r -> Type_SectionApplication r Nothing o (Just e)) <$> pType + -- <|> pSucceed (\(o,_) r -> Type_SectionApplication r Nothing o Nothing) + ) ) + <|> flip Type_TupleConstructor <$> commas_arity + <|> pSucceed (\r -> Type_RowRecEmpty r) + <|> (\fs r -> Type_RowRecUpdate r (Type_RowRecEmpty r) fs) <$> pFlds + <|> pExtFlds Type_RowRecEmpty Type_RowRecUpdate + pFld :: HSParser (Type -> RowTypeUpdate) + pFld = qvarid + <**> ( (\l -> RowTypeUpdate_Extends (mkRange1 l) (Just (tokMkQName l))) <$ pDCOLON + ) + pFlds :: HSParser [RowTypeUpdate] + pFlds = pList1Sep pComma (pFld <*> pType) + pExtFlds :: (Range -> Type) -> (Range -> Type -> [RowTypeUpdate] -> Type) -> HSParser (Range -> Type) + pExtFlds semEmp semFromRow + = (\e fs r -> semFromRow r e fs) + <$> ( mkRngNm Type_Variable <$> qvarid + <|> pSucceed (semEmp emptyRange) + ) + <* pVBAR <*> pFlds + +{-# LINE 775 "src/ehc/HS/Parser.chs" #-} + pType' :: HSParser (Type,Range) -> (HSParser Type -> HSParser (Type,Int) -> HSParser (Type,Int)) -> HSParser Type + pType' pOp extend + = pT' + where pT' :: HSParser Type + pT' = mkT <$> pT + pT :: HSParser (Type,Int) + pT = extend pT' + $ pTypeApp + <**> ( pSucceed unit + <|> (\(op,rng) (r,cnt) l -> (Type_InfixApplication rng l op r,cnt+1)) <$> pOp <*> pT + ) + unit e = (e,0) + mkT (e,0) = e + mkT (e,_) = Type_InfixApplicationChainTop emptyRange e + +{-# LINE 796 "src/ehc/HS/Parser.chs" #-} + pType :: HSParser Type + pType + = pType' + pTypeOp + (\pT pTApp -> + pTApp + <|> (\c t -> unit $ Type_Qualified emptyRange [c] t) <$> pContextItemImpl <* pRARROW <*> pT + <|> unit <$> (pTypeQuantPrefix <*> pT) + ) + where unit e = (e,0) +{- + = mkT <$> pT + where pT :: HSParser (Type,Int) + pT = pTypeApp + <**> ( pSucceed unit + <|> (\(op,rng) (r,cnt) l -> (Type_InfixApplication rng l op r,cnt+1)) <$> pTypeOp <*> pT + ) + <|> (\c t -> unit $ Type_Qualified emptyRange [c] t) <$> pContextItemImpl <* pRARROW <*> pType + <|> unit <$> (pTypeQuantPrefix <*> pType) + unit e = (e,0) + mkT (e,0) = e + mkT (e,_) = Type_InfixApplicationChainTop emptyRange e +-} + +{-# LINE 830 "src/ehc/HS/Parser.chs" #-} + pTypeQuantPrefix :: HSParser (Type -> Type) + pTypeQuantPrefix + = ((Type_Forall . mkRange1) <$> pFORALL <|> (Type_Exists . mkRange1) <$> pEXISTS) + <*> (tokMkQNames <$> pTyVarBinds) <* pDOT + +{-# LINE 837 "src/ehc/HS/Parser.chs" #-} + pTypeOpPrefix :: HSParser (Type -> Type) + pTypeOpPrefix + = (\l (op,rng) r -> Type_InfixApplication rng l op r) <$> pTypeApp <*> pTypeOp + <|> (\c -> Type_Qualified emptyRange [c]) <$> pContextItemImpl <* pRARROW + +{-# LINE 846 "src/ehc/HS/Parser.chs" #-} + pTypeOp :: HSParser (Type,Range) + pTypeOp + = pTypeOpBaseEq + <|> mkRngNm' Type_Variable <$> varop_no_ty + <|> mkRngNm' Type_Constructor <$> pDARROW + +{-# LINE 858 "src/ehc/HS/Parser.chs" #-} + pTypeOpBase :: HSParser (Type,Range) + pTypeOpBase + = mkRngNm' Type_Constructor + <$> ( gtycon_for_insection + ) + +{-# LINE 866 "src/ehc/HS/Parser.chs" #-} + pTypeOpBaseEq :: HSParser (Type,Range) + pTypeOpBaseEq + = pTypeOpBase + <|> mkRngNm' Type_Constructor <$> pTILDE + +{-# LINE 879 "src/ehc/HS/Parser.chs" #-} + pTypeApp :: HSParser Type + pTypeApp + = pT pA + where pT = pTypeBase + pA = (\es e -> Type_NormalApplication emptyRange e es) <$> pList1 pT + +{-# LINE 887 "src/ehc/HS/Parser.chs" #-} + pTyVarBind :: HSParser Token + pTyVarBind = tyvar + + pTyVarBinds :: HSParser [Token] + pTyVarBinds = pList1 pTyVarBind + +{-# LINE 901 "src/ehc/HS/Parser.chs" #-} + pTypeLeftHandSide :: HSParser TypeLeftHandSide + pTypeLeftHandSide + = pLhs + <|> (\c -> mkRngNm TypeLeftHandSide_Function c []) <$> gtycon' tyconsym + "pTypeLeftHandSide" + where pLhs :: HSParser TypeLeftHandSide + pLhs = mkRngNm TypeLeftHandSide_Function <$> gtycon' tyconsym <*> pLhsTail + <|> pParens' + ( (\l r t -> TypeLeftHandSide_Parenthesized r l t) + <$> pLhs + ) + <*> pLhsTail + <|> (\l o r -> TypeLeftHandSide_Infix (mkRange1 o) l (tokMkQName o) r) + <$> pTypePatternBase <*> tyconop <*> pTypePatternBase + pLhsTail :: HSParser [TypePattern] + pLhsTail = pList1 pTypePatternBase + +{-# LINE 920 "src/ehc/HS/Parser.chs" #-} + pAnnotatedType :: HSParser Type -> HSParser Type + pAnnotatedType pT + = (\(r,s) t -> if s + then Type_Annotate r TypeAnnotation_Strict t + else t + ) + <$> ((\t -> (mkRange1 t,True)) <$> pBANG <|> pSucceed (emptyRange,False)) + <*> pT + +{-# LINE 943 "src/ehc/HS/Parser.chs" #-} + pContextItemsPrefix1 :: HSParser ContextItems + pContextItemsPrefix1 + = (:[]) <$> pContextItemImpl <* pRARROW + + pContextItemsPrefix2 :: HSParser ContextItems + pContextItemsPrefix2 + = ( (:[]) <$> (pContextItemBase <|> pContextItemImplWild) + <|> pParens ((:) <$> pContextItemBase + <*> ( pImO + <|> (++) <$> pList1 (pCOMMA *> pContextItemBase) <*> pImO + ) + <|> pSucceed [] + ) + ) + <* pDARROW + where pImO = (:[]) <$ pCOMMA <*> pContextItemImplWild `opt` [] + pImO :: HSParser ContextItems + + pContextItemsPrefix :: HSParser ContextItems + pContextItemsPrefix + = pContextItemsPrefix1 + <|> pContextItemsPrefix2 + + pContextItemsPrefixOpt :: HSParser ContextItems + pContextItemsPrefixOpt = pContextItemsPrefix <|> pSucceed [] + + pTypeContextPrefix :: HSParser (Type -> Type) + pTypeContextPrefix + = Type_Qualified emptyRange <$> pContextItemsPrefix + +{-# LINE 979 "src/ehc/HS/Parser.chs" #-} + pContextItemClass :: HSParser ContextItem + pContextItemClass + = mkRngNm ContextItem_Class <$> qconid <*> pList1 pTypeBase + +{-# LINE 985 "src/ehc/HS/Parser.chs" #-} + pContextItemPrefix :: HSParser (ContextItem -> ContextItem) + pContextItemPrefix + = (ContextItem_Forall . mkRange1) <$> pFORALL <*> (tokMkQNames <$> pTyVarBinds) <* pDOT + +{-# LINE 991 "src/ehc/HS/Parser.chs" #-} + pContextItem :: HSParser ContextItem + pContextItem + = pContextItemBase + <**> ( pSucceed id + <|> (\o r l -> ContextItem_Arrow (mkRange1 o) l r) <$> pDARROW <*> pContextItem + ) + <|> pContextItemPrefix <*> pContextItem + +{-# LINE 1005 "src/ehc/HS/Parser.chs" #-} + pContextItemImplWild :: HSParser ContextItem + pContextItemImplWild = (ContextItem_Implicits . mkRange1) <$> pTDOT + +{-# LINE 1010 "src/ehc/HS/Parser.chs" #-} + pContextItemImpl :: HSParser ContextItem + pContextItemImpl + = pImpls' + ( const <$> (pContextItem <|> pContextItemImplWild) + <|> pSucceed ContextItem_NoImplicits + ) + +{-# LINE 1019 "src/ehc/HS/Parser.chs" #-} + pContextItemBase :: HSParser ContextItem + pContextItemBase + = pContextItemClass + <|> tyvar <**> ( (\s tv -> mkRngNm ContextItem_RowLacksLabel tv (tokMkQName s)) + <$ pLAM <*> pSelector + ) + +{-# LINE 1043 "src/ehc/HS/Parser.chs" #-} + pLiteralNumber :: HSParser Literal + pLiteralNumber + = mk 8 <$> pInteger8Tk + <|> mk 10 <$> pInteger10Tk + <|> mk 16 <$> pInteger16Tk + "pLiteralNumber" + where mk b t = Literal_Int (mkRange1 t) b (tokMkStr t) + +{-# LINE 1059 "src/ehc/HS/Parser.chs" #-} + pLiteral :: HSParser Literal + pLiteral + = pLiteralNumber + <|> mkRngStr Literal_Char <$> pCharTk + <|> mkRngStr Literal_String <$> pStringTk + <|> mkRngStr Literal_Float <$> pFractionTk + "pLiteral" + +{-# LINE 1077 "src/ehc/HS/Parser.chs" #-} + pExpressionMinusPrefix :: HSParser (Expression -> Expression) + pExpressionMinusPrefix + = (Expression_Negate . mkRange1) <$> pMINUS + + pExpressionMbMinusPrefix :: HSParser (Expression -> Expression) + pExpressionMbMinusPrefix + = pExpressionMinusPrefix + <|> pSucceed id + + pExpressionBase :: HSParser Expression + pExpressionBase + = Expression_Literal emptyRange <$> pLiteral + <|> mkRngNm Expression_Variable <$> qvar + <|> pExpressionList + <|> pParens' pInParens + "pExpressionBase" + where pInParens :: HSParser (Range -> Expression) + pInParens + {- + = (\(e,res) r -> + let mk res e + = case res of + Expression3OpSection_None + -> Expression_Parenthesized r e + Expression3OpSection_Op (o,_) + -> Expression_SectionApplication r (Just e) o Nothing + Expression3OpSection_CommaList es + -> Expression_RowRecordUpdate r (Expression_RowRecordEmpty r) + (map (RowRecordExpressionUpdate_Extends r Nothing) (e:es)) + Expression3OpSection_Typed (t,r) + -> Expression_Typed r e t + in foldr mk e $ reverse res + ) + <$> pExpression3OpSection pOp pExpressionPreBase + -} + {- + -} + = (\(e,_,res) r -> + let chk ress e + = case ress of + (Expression4Result_Op (o,_) : _) + -> Expression_SectionApplication r (Just e) o Nothing + (Expression4Result_CommaList es : _) + -> Expression_RowRecordUpdate r (Expression_RowRecordEmpty r) + (map (RowRecordExpressionUpdate_Extends r Nothing) (e:es)) + _ -> Expression_Parenthesized r e + in chk res e + ) + <$> pExpression4'' True pOp pExpressionPrefix pExpressionLayout + {- + = (pExpression <**> + ( (\(o,_) e r -> Expression_SectionApplication r (Just e) o Nothing) + <$> pOp + <|> pSucceed (flip Expression_Parenthesized) + <|> (\es e r -> Expression_RowRecordUpdate r (Expression_RowRecordEmpty r) + (map (RowRecordExpressionUpdate_Extends r Nothing) (e:es))) + <$> pList1 (pComma *> pExpression) + ) ) + -} + <|> flip Expression_TupleConstructor <$> commas_arity + <|> (pOpm + <**> ( (\e (o,_) r -> Expression_SectionApplication r Nothing o (Just e)) <$> pExpression + -- <|> pSucceed (\(o,_) r -> Expression_SectionApplication r Nothing o Nothing) + ) ) + <|> pSucceed (\r -> Expression_RowRecordEmpty r) + <|> (\fs r -> Expression_RowRecordUpdate r (Expression_RowRecordEmpty r) fs) <$> pFlds + <|> pExtFlds + where pFld :: HSParser (Expression -> RowRecordExpressionUpdate) + pFld = qvarid + <**> ( (\l -> RowRecordExpressionUpdate_Extends (mkRange1 l) (Just (tokMkQName l))) <$ pEQUAL + <|> mkRngNm RowRecordExpressionUpdate_Update <$ pCOLEQUAL + ) + pFlds :: HSParser [RowRecordExpressionUpdate] + pFlds = pList1Sep pComma (pFld <*> pExpression) + pExtFlds :: HSParser (Range -> Expression) + pExtFlds + = (\e fs r -> Expression_RowRecordUpdate r e fs) + <$> ( pParens' pExtFlds + <|> mkRngNm Expression_Variable <$> qvarid + <|> pSucceed (Expression_RowRecordEmpty emptyRange) + ) + <* pVBAR <*> pFlds + +{-# LINE 1181 "src/ehc/HS/Parser.chs" #-} + pExpressionList :: HSParser Expression + pExpressionList + = pBracks' + (pExpression + <**> ( pDOTDOT + *> ( (\e3 e1 r -> Expression_Enum r e1 Nothing (Just e3)) <$> pExpression + `opt` (\ e1 r -> Expression_Enum r e1 Nothing Nothing ) + ) + <|> pCOMMA + *> (pExpression + <**> ( pDOTDOT + *> ( (\e3 e2 e1 r -> Expression_Enum r e1 (Just e2) (Just e3)) <$> pExpression + `opt` (\ e2 e1 r -> Expression_Enum r e1 (Just e2) Nothing ) + ) + <|> (\es e2 e1 r -> Expression_List r (e1:e2:es)) <$> pList (pComma *> pExpression) + ) ) + <|> pVBAR + *> ((\c e r -> Expression_Comprehension r e (c ++ [Qualifier_Empty emptyRange])) <$> pListSep pCOMMA pQualifier) + `opt` flip one + ) + `opt` zero + ) + "pExpressionList" + where zero r = Expression_List r [] + one r h = Expression_List r [h] + pQualifier :: HSParser Qualifier + pQualifier + = Qualifier_Guard emptyRange <$> pExpressionNoLet + <|> (Qualifier_Let . mkRange1) <$> pLET <*> pDeclarations + <|> Qualifier_Generator emptyRange <$> pPattern <* pLARROW <*> pExpression + +{-# LINE 1221 "src/ehc/HS/Parser.chs" #-} + pExpressionDo :: HSParser Expression + pExpressionDo + = (Expression_Do . mkRange1) <$> pDO <*> pBlock1 pOCURLY pSEMI pCCURLY pStatement + "pExpressionDo" + where pStatement :: HSParser Statement + pStatement + = Statement_Expression emptyRange <$> pExpression {- pExpressionNoLet -} + <|> (\p t e -> Statement_Generator (mkRange1 t) p e) <$> pPattern <*> pLARROW <*> pExpression + -- common prefix with 'let x=e in e' dies out + <|> (Statement_Let . mkRange1) <$> pLET <*> pDeclarations + +{-# LINE 1269 "src/ehc/HS/Parser.chs" #-} + pExpressionConUpd :: HSParser Expression + pExpressionConUpd + = qcon + <**> ( pSucceed (mkRngNm Expression_Constructor) + <|> pCurlys' ((\bs _ c -> mkRngNm Expression_RecordConstruction c bs) <$> pListSep pCOMMA pRecordExpressionBinding) + ) + <|> pExpressionBase + <**> ((\u e -> foldr ($) e u) <$> pList pU) + "pExpressionConUpd" + where pU = pCurlys' ((\bs r e -> Expression_RecordUpdate r e bs) <$> pList1Sep pCOMMA pRecordExpressionBinding) + <|> pRowRecordSelectionSuffix + +{-# LINE 1289 "src/ehc/HS/Parser.chs" #-} + pRecordExpressionBinding :: HSParser RecordExpressionBinding + pRecordExpressionBinding + = mkRngNm RecordExpressionBinding_Binding <$> qvar <* pEQUAL <*> pExpression + "pRecordExpressionBinding" + +{-# LINE 1296 "src/ehc/HS/Parser.chs" #-} + pExpressionApp :: HSParser Expression + pExpressionApp + = pE <**> ((\as e -> foldl (flip ($)) e as) <$> pList pA) + "pExpressionApp" + where pE = pExpressionConUpd + pA = (\es e -> Expression_NormalApplication emptyRange e es) <$> pList1 pE + <|> (\es e -> Expression_ImpredicativeApplication emptyRange e es) <$> pList1 (pTILDE *> pE) + <|> (\es e -> Expression_ImplicitApplication emptyRange e es) <$> pList1 (pImpls' pContextedExpression) + where pContextedExpression = (\e c r -> ContextedExpression_Contexted r e c) <$> pExpression <* pLTCOLON <*> pContextItem + pContextedExpression :: HSParser (Range -> ContextedExpression) + +{-# LINE 1313 "src/ehc/HS/Parser.chs" #-} + pExpressionLayout :: HSParser Expression + pExpressionLayout + = pMaybe id id pExpressionMinusPrefix <*> pExpressionApp + <|> (Expression_Case . mkRange1) <$> pCASE <*> pExpression <* pOptSEMISeparator <* pOF <*> pAlternatives + <|> pExpressionDo + "pExpressionLayout" + +{-# LINE 1326 "src/ehc/HS/Parser.chs" #-} + pOp, pOpm :: HSParser (Expression,Range) + pOp = mkRngNm' Expression_Variable <$> qvarop <|> mkRngNm' Expression_Constructor <$> qconop + pOpm = mkRngNm' Expression_Variable <$> qvarop_no_minus <|> mkRngNm' Expression_Constructor <$> qconop + +{-# LINE 1332 "src/ehc/HS/Parser.chs" #-} + pExpression4'' :: Bool -> HSParser (Expression,Range) -> HSParser (Expression -> Expression) -> HSParser Expression -> HSParser Expression4 + pExpression4'' inParen pOp pPreNotOp pBase + = ((\(e,cnt,res) -> (mkC cnt e,0,res)) <$> pE) + <**> (addCommaP $ addOpP + $ ( (addCommaP2 + $ ((\c t (e,cnt,res) -> (Expression_Typed (mkRange1 c) (mkC cnt e) t, 0, Expression4Result_Typed : res)) + <$> pDCOLON <*> pType + ) ) + <|> pSucceed id + ) ) + where pE :: HSParser Expression4 + pE = pBase <**> + ( pSucceed (\e -> (e,0,[])) + <|> (\(op,rng) (r,opCnt,res) l -> (Expression_InfixApplication rng l op r, opCnt+1, res)) <$> pOp <*> pE + ) + <|> (\p (e,cnt,res) -> (p $ mkC cnt $ e, 0, Expression4Result_NotOpPre : res)) + <$> pPreNotOp <*> pE + + -- add trailing parsers, depending on being inside parenthesis + addCommaP, addCommaP2, addOpP :: HSParser (Expression4 -> Expression4) -> HSParser (Expression4 -> Expression4) + + -- optionally add tuple expr remainder as choice + addCommaP p | inParen = p <|> (\es (e,cnt,res) -> (mkC cnt e, 0, Expression4Result_CommaList es : res)) + <$> pList1 (pComma *> pExpression) + | otherwise = p + + -- optionally add tuple expr remainder as following in a sequence + addCommaP2 p | inParen = (\mkecntres es ecntres -> + let (e,cnt,res) = mkecntres ecntres + in (mkC cnt e, 0, (if null es then [] else [Expression4Result_CommaList es]) ++ res) + ) + <$> p <*> pList (pComma *> pExpression) + | otherwise = p + + -- optionally add operator as choice + addOpP p | inParen = p <|> (\o (e,cnt,res) -> (mkC cnt e, 0, Expression4Result_Op o : res)) + <$> pOp + | otherwise = p + + -- add additional AST depending on nr of operators + mkC cnt = if cnt > 0 then Expression_InfixApplicationChainTop emptyRange else id + + pExpression4' :: HSParser (Expression -> Expression) -> HSParser Expression + pExpression4' pPreNotOp = (\(e,_,_) -> e) <$> pExpression4'' False pOp pPreNotOp pExpressionLayout + +{-# LINE 1379 "src/ehc/HS/Parser.chs" #-} + pExpressionPreBase :: HSParser Expression + pExpressionPreBase = (\ps e -> foldr ($) e ps) <$> pList_gr pExpressionPrefix <*> pExpressionLayout + + pExpression :: HSParser Expression + pExpression + -- = pExpression1' pExpressionPrefix + -- = pExpression2' pExpressionPrefix + -- = pExpression3' pExpressionPreBase + = pExpression4' pExpressionPrefix + "pExpression" + +{-# LINE 1392 "src/ehc/HS/Parser.chs" #-} + pExpressionNoLet :: HSParser Expression + pExpressionNoLet + -- = pExpression' pExpressionNoLetPrefix + -- = pExpression2' pExpressionNoLetPrefix + -- = pExpression3' pBase3 + = pExpression4' pExpressionNoLetPrefix + "pExpressionNoLet" + where pBase3 :: HSParser Expression + pBase3 = (\ps e -> foldr ($) e ps) <$> pList pExpressionNoLetPrefix <*> pExpressionLayout + +{-# LINE 1404 "src/ehc/HS/Parser.chs" #-} + pExpressionLetPrefix :: HSParser (Expression -> Expression) + pExpressionLetPrefix + = (\(s,t,d) -> Expression_Let (mkRange1 t) s d) + <$> ( (,,) False <$> pLET <*> pDeclarations <* pIN + <|> (,,) True <$> pLETSTRICT <*> pLayoutList pDeclarationSimpleValue <* pIN + ) + "pExpressionLetPrefix" + +{-# LINE 1420 "src/ehc/HS/Parser.chs" #-} + pExpressionNoLetPrefix :: HSParser (Expression -> Expression) + pExpressionNoLetPrefix + = pLAM <**> pLamArgs + <|> (Expression_If . mkRange1) <$> pIF <*> pExpression <* pOptSEMISeparator <* pTHEN <*> pExpression <* pOptSEMISeparator <* pELSE + -- <|> pExpressionMinusPrefix + "pExpressionNoLetPrefix" + where pLamArgs + = (\a1 a2 t e -> a1 t (a2 t e)) + <$> ( (\ps t e -> Expression_Lambda (mkRange1 t) ps e) <$> pList1 pPatternBaseCon + <|> (\ps t e -> Expression_ImplicitLambda (mkRange1 t) ps e) <$> pList1 (pImpls' pContextedPattern) + ) + <*> pLamArgs + <|> (\_ e -> e) <$ pRARROW + pContextedPattern = (\p c r -> ContextedPattern_Contexted r p c) <$> pPattern <* pLTCOLON <*> pContextItem + pContextedPattern :: HSParser (Range -> ContextedPattern) + +{-# LINE 1444 "src/ehc/HS/Parser.chs" #-} + pExpressionPrefix :: HSParser (Expression -> Expression) + pExpressionPrefix + = pExpressionLetPrefix + <|> pExpressionNoLetPrefix + "pExpressionPrefix" + +{-# LINE 1456 "src/ehc/HS/Parser.chs" #-} + pAlternative :: HSParser Alternative + pAlternative + = Alternative_Alternative emptyRange <$> pPattern <*> pRhs pRARROW + + pAlternatives :: HSParser Alternatives + pAlternatives + = pBlock1 pOCURLY pSEMI pCCURLY pAlternative + +{-# LINE 1470 "src/ehc/HS/Parser.chs" #-} + pPatternBaseInParens :: HSParser (Range -> Pattern) + pPatternBaseInParens + = (pPattern + <**> ( pSucceed (flip Pattern_Parenthesized) + <|> (\es e r -> Pattern_RowRecordBinding r (Pattern_RowRecordEmpty r) + (map (RowRecordPatternBinding_Binding r Nothing) (e:es))) + <$> pList1 (pComma *> pPattern) + ) ) + <|> (\v _ -> mkRngNm Pattern_Variable v) <$> qvarsym_for_inparens + <|> pSucceed (\r -> Pattern_RowRecordEmpty r) + <|> (\fs r -> Pattern_RowRecordBinding r (Pattern_RowRecordEmpty r) fs) <$> pFlds + <|> pExtFlds + "pPatternBaseInParens" + where pFld :: HSParser (Pattern -> RowRecordPatternBinding) + pFld = qvarid + <**> ( (\l -> RowRecordPatternBinding_Binding (mkRange1 l) (Just (tokMkQName l))) <$ pEQUAL + ) + pFlds :: HSParser [RowRecordPatternBinding] + pFlds = pList1Sep pComma (pFld <*> pPattern) + pExtFlds :: HSParser (Range -> Pattern) + pExtFlds + = (\e fs r -> Pattern_RowRecordBinding r e fs) + <$> ( mkRngNm Pattern_Variable <$> qvar + <|> pSucceed (Pattern_RowRecordEmpty emptyRange) + ) + <* pVBAR <*> pFlds + +{-# LINE 1508 "src/ehc/HS/Parser.chs" #-} + pPatternBaseMinusLiteral :: HSParser Pattern + pPatternBaseMinusLiteral = (\m n -> Pattern_Literal (mkRange1 m) (-1) n) <$> pMINUS <*> pLiteralNumber + +{-# LINE 1513 "src/ehc/HS/Parser.chs" #-} + pPatternBaseNoParens :: HSParser Pattern + pPatternBaseNoParens + = ( + (if ehcOptBangPatterns opts + then (\p -> p <|> (Pattern_Bang . mkRange1) <$> pBANG <*> pPatternBaseCon) + else id + ) $ + ( qvarid + <**> ( (\a p v -> Pattern_As (mkRange1 a) (tokMkQName v) p) <$> pAT <*> pPatternBaseCon + <|> pSucceed (mkRngNm Pattern_Variable) + ) + <|> Pattern_Literal emptyRange 1 <$> pLiteral + <|> pBracks' (flip Pattern_List <$> pListSep pCOMMA pPattern) + <|> (Pattern_Irrefutable . mkRange1) <$> pTILDE <*> pPatternBaseCon + ) ) + "pPatternBaseNoParens" + +{-# LINE 1539 "src/ehc/HS/Parser.chs" #-} + pPatternBase :: HSParser Pattern + pPatternBase + = pPatternBaseNoParens + <|> pParens' pPatternBaseInParens + "pPatternBase" + +{-# LINE 1547 "src/ehc/HS/Parser.chs" #-} + pPatternConSuffix :: HSParser (Token -> Pattern) + pPatternConSuffix + = pSucceed (\c -> mkRngNm Pattern_Constructor c []) + <|> pCurlys' ((\bs _ c -> mkRngNm Pattern_Record c bs) <$> pListSep pCOMMA pRecordPatternBinding) + "pPatternConSuffix" + +{-# LINE 1557 "src/ehc/HS/Parser.chs" #-} + pPatternBaseCon :: HSParser Pattern + pPatternBaseCon + = pPatternBase + <|> qconid <**> pPatternConSuffix + "pPatternBaseCon" + +{-# LINE 1565 "src/ehc/HS/Parser.chs" #-} + pRecordPatternBinding :: HSParser RecordPatternBinding + pRecordPatternBinding + = qvar + <**> ( pSucceed (\v -> mkRngNm RecordPatternBinding_Pun v) + <|> (\p v -> mkRngNm RecordPatternBinding_Binding v p) <$ pEQUAL <*> pPattern + ) + "pRecordPatternBinding" + +{-# LINE 1575 "src/ehc/HS/Parser.chs" #-} + pPatternApp :: HSParser Pattern + pPatternApp + = pPatternBase + <|> pPatternBaseMinusLiteral + <|> qcon + <**> ( (\l c -> mkRngNm Pattern_Constructor c l) <$> pList1 pPatternBaseCon + <|> pPatternConSuffix + ) + <|> (Pattern_Tuple emptyRange) <$> pParens commas_arity <*> pList1 pPatternBaseCon + "pPatternApp" + +{-# LINE 1590 "src/ehc/HS/Parser.chs" #-} + pPatternOp :: HSParser Pattern + pPatternOp + -- = (\l rs -> foldr (\(o,r) mk -> \l -> o l (mk r)) id rs l) <$> pPatternApp <*> pList_ng (pOp <+> pPatternApp) + = pChainr_ng pOp pPatternApp + "pPatternOp" + where pOp = + ((\o l r -> Pattern_InfixConstructor (mkRange1 o) l (tokMkQName o) r) <$> qconop) + +{-# LINE 1604 "src/ehc/HS/Parser.chs" #-} + pPattern :: HSParser Pattern + pPattern + = pPatternOp + ((\c t p -> Pattern_Typed (mkRange1 c) p t) <$> pDCOLON <*> pType) + "pPattern" + +{-# LINE 1614 "src/ehc/HS/Parser.chs" #-} + pRowRecordSelectionSuffix :: HSParser (Expression -> Expression) + pRowRecordSelectionSuffix + = (\lbls e -> foldl (\e l -> Expression_RowRecordSelect (mkRange1 l) e (tokMkQName l)) e lbls) + <$> pList1 (pHASH *> pSelector) + +{-# LINE 1621 "src/ehc/HS/Parser.chs" #-} + pSelector :: HSParser Token + pSelector + = qvarid <|> qconid <|> pIntegerTk + +{-# LINE 1631 "src/ehc/HS/Parser.chs" #-} + pTypePatternBase :: HSParser TypePattern + pTypePatternBase + = mkRngNm TypePattern_Variable <$> var_no_ty + "pTypePatternBase" + + +{-# LINE 1653 "src/ehc/HS/Parser.chs" #-} +commas' :: HSParser [Token] +commas' = pList1 pCOMMA + +commas :: HSParser Token +commas = (map (\s -> strProd (length s + 1)) . foldr tokConcat tokEmpty) <$> commas' + where map = tokenMap + +{-# LINE 1666 "src/ehc/HS/Parser.chs" #-} +commas_arity :: HSParser Int +commas_arity = (\ts -> length ts + 1) <$> commas' + +{-# LINE 1673 "src/ehc/HS/Parser.chs" #-} +pOptSEMISeparator :: HSParser (Maybe ()) +pOptSEMISeparator = pMb (pSeparator <|> () <$ pSEMI) + +{-# LINE 1678 "src/ehc/HS/Parser.chs" #-} +modid :: HSParser Token +modid + = pCONID + <|> pQCONID + "modid" + +{-# LINE 1688 "src/ehc/HS/Parser.chs" #-} +qcnames :: HSParser [Token] +qcnames + = pListSep pCOMMA qcname + "qcnames" + +qcname :: HSParser Token -- Variable or data constructor +qcname + = qvar + <|> gcon + "qcname" + +{-# LINE 1701 "src/ehc/HS/Parser.chs" #-} +identifier :: HSParser Token +identifier + = qvar + <|> gcon + <|> qop + "identifier" + +depreclist :: HSParser [Token] +depreclist + = pList1Sep pCOMMA deprec_var + +deprec_var :: HSParser Token +deprec_var + = var + <|> tyconid + "deprec_var" + +gcon :: HSParser Token -- Data constructor namespace +gcon + = sysdcon + <|> qcon +-- the case of '[:' ':]' is part of the production `parr' + "gcon" + +sysdcon :: HSParser Token -- Wired in data constructors +sysdcon + = pParens commas + <|> tokConcat <$> pOBRACK <*> pCBRACK + "sysdcon" + + +{-# LINE 1740 "src/ehc/HS/Parser.chs" #-} +qcon :: HSParser Token +qcon + = qconid + <|> pParens qconsym + "qcon" + + + +conop :: HSParser Token +conop + = consym + <|> pBACKQUOTE *> conid <* pBACKQUOTE + "conop" + +qconop :: HSParser Token +qconop + = qconsym + <|> pBACKQUOTE *> qconid <* pBACKQUOTE + "qconop" + +{-# LINE 1767 "src/ehc/HS/Parser.chs" #-} +qconid :: HSParser Token -- Qualified or unqualifiedb +qconid + = conid + <|> pQCONID + "qconid" + +{-# LINE 1777 "src/ehc/HS/Parser.chs" #-} +conid_nopragma :: HSParser Token +conid_nopragma + = pCONID + "conid_nopragma" + +conid :: HSParser Token +conid + = conid_nopragma + <|> pLANGUAGE_prag + <|> pDERIVABLE_prag + "conid" + +qconsym :: HSParser Token -- Qualified or unqualified +qconsym + = consym + <|> pQCONSYM + "qconsym" + +{-# LINE 1801 "src/ehc/HS/Parser.chs" #-} +consym :: HSParser Token +consym + = pCONSYM + <|> pCOLON -- ':' means only list cons + "consym" + +{-# LINE 1809 "src/ehc/HS/Parser.chs" #-} +con :: HSParser Token +con + = conid + <|> pParens consym + "con" + +{-# LINE 1817 "src/ehc/HS/Parser.chs" #-} +----------------------------------------------------------------------------- +-- Any operator + +op :: HSParser Token -- used in infix decls +op + = varop + <|> conop + "op" + +qop :: HSParser Token -- used in sections +qop + = qvarop + <|> qconop + "qop" + + +{-# LINE 1854 "src/ehc/HS/Parser.chs" #-} +tyvar :: HSParser Token +tyvar + = varid_no_ty + "tyvar" + +{-# LINE 1865 "src/ehc/HS/Parser.chs" #-} +-- | special identifier: FFI safety +safety :: HSParser Token +safety + = pSAFE + <|> pUNSAFE + <|> pTHREADSAFE + "safety" + +{-# LINE 1877 "src/ehc/HS/Parser.chs" #-} +-- | special identifier: FFI calling convention +callconv :: HSParser Token +callconv + = snd <$> pFFIWay + "callconv" + +{-# LINE 1885 "src/ehc/HS/Parser.chs" #-} +-- These special_ids are treated as keywords in various places, +-- but as ordinary ids elsewhere. 'special_id' collects all these +-- except 'unsafe' and 'forall' whose treatment differs depending on context +-- | special identifier: some context sensitive meaningful +special_id_no_callconv :: HSParser Token +special_id_no_callconv + = pLABEL + <|> pEXPORT + <|> pAS + <|> pQUALIFIED + <|> pHIDING + <|> pDYNAMIC + "special_id_no_callconv" + +{-# LINE 1905 "src/ehc/HS/Parser.chs" #-} +special_id :: HSParser Token +special_id + = special_id_no_callconv + <|> callconv + "special_id" + +{-# LINE 1913 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified value/function, e.g.: f, except type related keywords +varid_no_ty :: HSParser Token +varid_no_ty + = pVARID + <|> special_id_no_callconv + <|> callconv + <|> safety + "varid_no_ty" + +{-# LINE 1929 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified value/function, e.g.: f +varid :: HSParser Token +varid + = varid_no_ty + <|> pFORALL + <|> pEXISTS + "varid" + +{-# LINE 1941 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified value/function, e.g.: X.f +qvarid :: HSParser Token +qvarid + = varid + <|> pQVARID + "qvarid" + +{-# LINE 1952 "src/ehc/HS/Parser.chs" #-} +-- | See comments with special_id +special_sym_no_bang :: HSParser Token +special_sym_no_bang + = pDOT + <|> pSTAR + <|> pPERCENT + "special_sym_no_bang" + +special_sym :: HSParser Token +special_sym + = pBANG + <|> special_sym_no_bang + "special_sym" + +{-# LINE 1968 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified operator, e.g.: +, except -, ! +varsym_no_minus_bang :: HSParser Token +varsym_no_minus_bang + = pVARSYM + <|> special_sym_no_bang + "varsym_no_minus_bang" + +varsym_no_minus :: HSParser Token +varsym_no_minus + = pVARSYM + <|> special_sym + "varsym_no_minus" + +{-# LINE 1983 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified operator, e.g.: + +varsym :: HSParser Token +varsym + = varsym_no_minus + <|> pMINUS + "varsym" + +{-# LINE 1992 "src/ehc/HS/Parser.chs" #-} +-- | Qualified operator, e.g.: X.+, only base +qvarsym_base :: HSParser Token +qvarsym_base + = pQVARSYM + "qvarsym1" + +{-# LINE 2000 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: X.+, except - +qvarsym_no_minus :: HSParser Token +qvarsym_no_minus + = varsym_no_minus + <|> qvarsym_base + "qvarsym_no_minus" + +{-# LINE 2011 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: X.+, for use inside parens +qvarsym_for_inparens :: HSParser Token +qvarsym_for_inparens + = varsym + <|> qvarsym_base + "qvarsym_for_inparens" + +{-# LINE 2022 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: X.+ +qvarsym :: HSParser Token +qvarsym + = qvarsym_for_inparens + "qvarsym" + +{-# LINE 2030 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: +, `f`, except -, ! +varop_no_minus_bang :: HSParser Token +varop_no_minus_bang + = varsym_no_minus_bang + <|> pBACKQUOTE *> varid <* pBACKQUOTE + "varop_no_minus_bang" + +-- | (Un)qualified operator, e.g.: +, `f`, except - +varop_no_minus :: HSParser Token +varop_no_minus + = varsym_no_minus + <|> pBACKQUOTE *> varid <* pBACKQUOTE + "varop_no_minus" + +{-# LINE 2046 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: +, `f`, except type related keywords +varop_no_ty :: HSParser Token +varop_no_ty + = varsym + <|> pBACKQUOTE *> varid_no_ty <* pBACKQUOTE + "varop_no_minus" + +{-# LINE 2055 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: +, `f`, except ! +varop_no_bang :: HSParser Token +varop_no_bang + = varop_no_minus_bang + <|> pMINUS + "varop_no_bang" + +-- | (Un)qualified operator, e.g.: +, `f` +varop :: HSParser Token +varop + = varop_no_minus + <|> pMINUS + "varop" + +{-# LINE 2071 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: X.+, `X.f`, except - +qvarop_no_minus :: HSParser Token +qvarop_no_minus + = qvarsym_no_minus + <|> pBACKQUOTE *> qvarid <* pBACKQUOTE + "qvarop_no_minus" + +{-# LINE 2080 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified operator, e.g.: X.+, `X.f` +qvarop :: HSParser Token +qvarop + = qvarsym + <|> pBACKQUOTE *> qvarid <* pBACKQUOTE + "qvarop" + +{-# LINE 2089 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified value/function, e.g.: f, (+), except type related keywords +var_no_ty :: HSParser Token +var_no_ty + = varid_no_ty + <|> pParens varsym + "var" + +{-# LINE 2098 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified value/function, e.g.: f, (+) +var :: HSParser Token +var + = varid + <|> pParens varsym + "var" + +{-# LINE 2107 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified value/function, e.g.: X.f, (X.+) +qvar :: HSParser Token +qvar + = qvarid + <|> pParens qvarsym_for_inparens + "qvar" + +{-# LINE 2124 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified type constructor, e.g.: :+: +tyconsym :: HSParser Token +tyconsym + = pCONSYM + "tyconsym" + +{-# LINE 2132 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified type constructor, e.g.: X.:+: +qtyconsym :: HSParser Token +qtyconsym + = tyconsym + <|> pQCONSYM + "qtyconsym" + +{-# LINE 2143 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified type constructor, e.g.: Either +tyconid :: HSParser Token +tyconid + = pCONID + "tyconid" + +{-# LINE 2154 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified type constructor, e.g.: X.Either +qtyconid :: HSParser Token +qtyconid + = tyconid + <|> pQCONID + "qtyconid" + +{-# LINE 2165 "src/ehc/HS/Parser.chs" #-} +-- | Unqualified infix type operator, e.g.: `Either`, :+: +tyconop :: HSParser Token -- Unqualified +tyconop + = tyconsym + <|> pBACKQUOTE *> tyconid <* pBACKQUOTE + "tyconop" + +{-# LINE 2174 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified infix type operator, e.g.: `X.Either`, X.:+: +qtyconop :: HSParser Token +qtyconop + = qtyconsym + <|> pBACKQUOTE *> qtyconid <* pBACKQUOTE + "qtyconop" + +{-# LINE 2183 "src/ehc/HS/Parser.chs" #-} +-- | (Un)qualified prefix type constructor, e.g.: X.Either, (X.:+:) +qtycon :: HSParser Token +qtycon + = qtyconid + <|> pParens qtyconsym + "qtycon" + +{-# LINE 2192 "src/ehc/HS/Parser.chs" #-} +-- | General (un)qualified prefix type constructor, no delimiting brackets (e.g. []), to be parameterized with the part inside parenthesis (the general part) +gtycon_no_delims' :: HSParser Token -> HSParser Token +gtycon_no_delims' pInParens + = qtyconid + <|> pParens pInParens + "gtycon_no_delims" + +{-# LINE 2201 "src/ehc/HS/Parser.chs" #-} +-- | Inside parenthesis part for gtycon +gtycon_for_inparens_arrow :: HSParser Token +gtycon_for_inparens_arrow + = pRARROW + <|> qtyconsym + "gtycon_for_inparens_arrow" + +-- | Inside parenthesis part for gtycon +gtycon_for_inparens_arrow_commas :: HSParser Token +gtycon_for_inparens_arrow_commas + = gtycon_for_inparens_arrow + <|> commas + "gtycon_for_inparens_arrow" + +-- | Inside parenthesis part for type sections +gtycon_for_insection :: HSParser Token +gtycon_for_insection + = pRARROW + <|> qtyconop + "gtycon_for_insection" + +{-# LINE 2226 "src/ehc/HS/Parser.chs" #-} +-- | General (un)qualified prefix type constructor, e.g.: X.Either, (X.:+:), and (->) +gtycon_no_delims_commas :: HSParser Token +gtycon_no_delims_commas + = gtycon_no_delims' gtycon_for_inparens_arrow + "gtycon_no_delims_commas" + +{-# LINE 2234 "src/ehc/HS/Parser.chs" #-} +-- | General (un)qualified prefix type constructor, e.g.: X.Either, (X.:+:), and (,,,), (->) +gtycon_no_delims :: HSParser Token -- A "general" qualified tycon +gtycon_no_delims + = gtycon_no_delims' gtycon_for_inparens_arrow_commas + "gtycon_no_delims" + +{-# LINE 2242 "src/ehc/HS/Parser.chs" #-} +gtycon_only_bracks :: HSParser Token -- A "general" qualified tycon +gtycon_only_bracks + = tokConcat <$> pOBRACK <*> pCBRACK + -- <|> tokConcat <$> pOPABRACK <*> pCPABRACK + "gtycon_only_delims" + +{-# LINE 2250 "src/ehc/HS/Parser.chs" #-} +-- | General (un)qualified prefix type constructor, including delimiting brackets, to be parameterized with the part inside parenthesis (the general part) +gtycon' :: HSParser Token -> HSParser Token +gtycon' pInParens + = gtycon_no_delims' pInParens + <|> gtycon_only_bracks + "gtycon'" + +{-# LINE 2261 "src/ehc/HS/Parser.chs" #-} +-- | General (un)qualified prefix type constructor, e.g.: X.Either, (X.:+:), and (,,,), (->), [] +gtycon :: HSParser Token -- A "general" qualified tycon +gtycon + = gtycon' gtycon_for_inparens_arrow_commas + "gtycon" + diff --git a/src/UHC/Light/Compiler/LamInfo.hs b/src/UHC/Light/Compiler/LamInfo.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/LamInfo.hs @@ -0,0 +1,222 @@ +module UHC.Light.Compiler.LamInfo +( StackTraceInfo (..) +, LamInfoBindAsp (..) +, LamInfo (..), emptyLamInfo, emptyLamInfo' +, LamMp, emptyLamMp +, lamMpUnionBindAspMp, lamMpUnionsBindAspMp +, lamMpMergeInto +, lamMpLookupAsp, lamMpLookupAsp2, lamMpLookupLam, lamMpLookupCaf +, lamMpFilterLam, lamMpFilterCaf +, lamMpMergeFrom +, initLamMp +, laminfo1stArgIsStackTrace +, FusionRole (..) ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.AnaDomain +import UHC.Util.Utils +import UHC.Util.Pretty +import UHC.Light.Compiler.AnaDomain.Pretty +import qualified Data.Map as Map +import qualified Data.Set as Set +import Control.Monad +import UHC.Util.Serialize +import Data.Typeable (Typeable,Typeable2) +import Data.Generics (Data) + + + +{-# LINE 68 "src/ehc/LamInfo.chs" #-} +data StackTraceInfo + = StackTraceInfo_None + | StackTraceInfo_HasStackTraceEquiv HsName -- has a stack traced equivalent + | StackTraceInfo_IsStackTraceEquiv HsName -- is a stack traced equivalent + deriving ( Show + , Data, Typeable + ) + +{-# LINE 80 "src/ehc/LamInfo.chs" #-} +-- | The role a value takes in fusion +data FusionRole + = FusionRole_Fuse -- fuse this, i.e. inline, turned on by 'fuse f' for f + | FusionRole_BuildLeft -- role of g in 'convert g,h' + | FusionRole_BuildRight -- role of h in 'convert g,h' + deriving ( Enum, Show + , Data,Typeable + ) + +{-# LINE 91 "src/ehc/LamInfo.chs" #-} +instance PP FusionRole where + pp r = pp $ drop l $ show r + where l = length "FusionRole_" + +{-# LINE 97 "src/ehc/LamInfo.chs" #-} +-- | per aspect info +data LamInfoBindAsp + = LamInfoBindAsp_RelevTy -- relevance typing + { libindaspRelevTy :: !RelevTy + } + | LamInfoBindAsp_Ty -- plain good old type + { libindaspTy :: !Ty + } + | LamInfoBindAsp_Core -- actual Core, should go paired with Ty (?? maybe pair them directly) + { libindaspMetaLev :: !MetaLev + , libindaspCore :: !CExpr + } + | LamInfoBindAsp_FusionRole -- role in fusion + { libindaspFusionRole :: !FusionRole + } + deriving ( Show + , Data, Typeable + ) + +type LamInfoBindAspMp = Map.Map ACoreBindAspectKeyS LamInfoBindAsp + +{-# LINE 129 "src/ehc/LamInfo.chs" #-} +instance PP LamInfoBindAsp where + pp (LamInfoBindAsp_RelevTy t) = "RTy" >#< pp t + pp (LamInfoBindAsp_Ty t) = "Ty" >#< pp t + pp (LamInfoBindAsp_Core ml c) = pp "Core" -- >#< pp c -- Core.Pretty uses LamInfo, so module cycle... + pp (LamInfoBindAsp_FusionRole r) = "Fuse" >#< pp r + +{-# LINE 139 "src/ehc/LamInfo.chs" #-} +-- | per lambda implementation info +data LamInfo + = LamInfo + { laminfoArity :: !Int -- arity of function + , laminfoStackTrace :: !StackTraceInfo -- stacktrace + , laminfoBindAspMp :: !LamInfoBindAspMp -- info organized per/keyed on aspect + } + deriving ( Show + , Data, Typeable + ) + +emptyLamInfo' :: LamInfo +emptyLamInfo' + = LamInfo 0 StackTraceInfo_None + Map.empty + +emptyLamInfo :: LamInfo +emptyLamInfo + = LamInfo 0 StackTraceInfo_None + Map.empty + +{-# LINE 173 "src/ehc/LamInfo.chs" #-} +instance PP LamInfo where + pp (LamInfo {laminfoBindAspMp=m}) = ppAssocL $ assocLMapKey ppACBaspKeyS $ Map.toList m + +{-# LINE 178 "src/ehc/LamInfo.chs" #-} +laminfo1stArgIsStackTrace :: LamInfo -> Bool +laminfo1stArgIsStackTrace (LamInfo {laminfoStackTrace=StackTraceInfo_IsStackTraceEquiv _}) = True +laminfo1stArgIsStackTrace _ = False + +{-# LINE 190 "src/ehc/LamInfo.chs" #-} +type LamMp = Map.Map HsName LamInfo + +emptyLamMp :: LamMp +emptyLamMp = Map.empty + +{-# LINE 197 "src/ehc/LamInfo.chs" #-} +-- union, including the aspect map, but arbitrary for the info itself +lamMpUnionBindAspMp :: LamMp -> LamMp -> LamMp +lamMpUnionBindAspMp = Map.unionWith (\i1 i2 -> i1 {laminfoBindAspMp = laminfoBindAspMp i1 `Map.union` laminfoBindAspMp i2}) + +lamMpUnionsBindAspMp :: [LamMp] -> LamMp +lamMpUnionsBindAspMp = foldr lamMpUnionBindAspMp Map.empty + +{-# LINE 206 "src/ehc/LamInfo.chs" #-} +-- propagate from new (left) to prev (right), adding new entries if necessary, combining with mergeL2RInfo, finally combining/choosing maps with mergeL2RMp +lamMpMergeInto :: (LamInfo -> LamInfo -> LamInfo) -> (LamMp -> LamMp -> LamMp) -> LamMp -> LamMp -> LamMp +lamMpMergeInto mergeL2RInfo mergeL2RMp newMp prevMp + = mergeL2RMp newMpMerge prevMp + where newMpMerge + = Map.mapWithKey + (\n i -> maybe i (mergeL2RInfo i) $ Map.lookup n prevMp + ) newMp + +{-# LINE 228 "src/ehc/LamInfo.chs" #-} +lamMpLookupAsp :: HsName -> ACoreBindAspectKeyS -> LamMp -> Maybe LamInfoBindAsp +lamMpLookupAsp n a m + = fmap snd $ mapLookup2' laminfoBindAspMp n a m + +lamMpLookupAsp2 :: ACoreBindRef -> LamMp -> Maybe LamInfoBindAsp +lamMpLookupAsp2 (ACoreBindRef n (Just a)) m = lamMpLookupAsp n a m + +lamMpLookupLam :: HsName -> LamMp -> Maybe Int +lamMpLookupLam n m + = case Map.lookup n m of + j@(Just (LamInfo {laminfoArity=a})) | a > 0 + -> Just a + _ -> Nothing + +lamMpLookupCaf :: HsName -> LamMp -> Maybe Int +lamMpLookupCaf n m + = case Map.lookup n m of + j@(Just (LamInfo {laminfoArity=a})) | a == 0 + -> Just a + _ -> Nothing + +{-# LINE 251 "src/ehc/LamInfo.chs" #-} +lamMpFilterLam :: LamMp -> LamMp +lamMpFilterLam = Map.filter ((>0) . laminfoArity) + +lamMpFilterCaf :: LamMp -> LamMp +lamMpFilterCaf = Map.filter ((==0) . laminfoArity) + +{-# LINE 259 "src/ehc/LamInfo.chs" #-} +-- | merge info from arbitrary map m into LamMp holding LamInfo's +lamMpMergeFrom + :: (LamInfo -> Maybe x) -- extract relevant info from a LamInfo + -> (Maybe x -> LamInfo -> LamInfo) -- set the info + -> (z -> x -> x) -- merge info from new map and old info + -> LamInfo -- default, empty LamInfo + -> Map.Map HsName z -- arbitrary map holding info to merge + -> LamMp -> LamMp +lamMpMergeFrom get set merge empty m lm + = Map.foldrWithKey (\n z lm -> Map.alter (Just . upd z) n lm) + lm m + where upd z (Just i) = set (Just (merge z $ maybe emptyExtra id $ get i)) i + upd z Nothing = set (Just (merge z emptyExtra )) empty + emptyExtra = panicJust "lamMpMergeFrom" $ get $ empty + +{-# LINE 316 "src/ehc/LamInfo.chs" #-} +initLamMp :: LamMp +initLamMp = emptyLamMp + +{-# LINE 345 "src/ehc/LamInfo.chs" #-} +instance Serialize FusionRole where + sput = sputEnum8 + sget = sgetEnum8 + +{-# LINE 351 "src/ehc/LamInfo.chs" #-} +instance Serialize LamInfoBindAsp where + sput (LamInfoBindAsp_RelevTy a) = sputWord8 0 >> sput a + sput (LamInfoBindAsp_Ty a) = sputWord8 1 >> sput a + sput (LamInfoBindAsp_Core a b) = sputWord8 2 >> sput a >> sput b + sput (LamInfoBindAsp_FusionRole a) = sputWord8 3 >> sput a + sget = do + t <- sgetWord8 + case t of + 0 -> liftM LamInfoBindAsp_RelevTy sget + 1 -> liftM LamInfoBindAsp_Ty sget + 2 -> liftM2 LamInfoBindAsp_Core sget sget + 3 -> liftM LamInfoBindAsp_FusionRole sget + +instance Serialize LamInfo where + sput (LamInfo a b c) = sput a >> sput b >> sput c + sget = liftM3 LamInfo sget sget sget + +instance Serialize StackTraceInfo where + sput (StackTraceInfo_None ) = sputWord8 0 + sput (StackTraceInfo_HasStackTraceEquiv a) = sputWord8 1 >> sput a + sput (StackTraceInfo_IsStackTraceEquiv a) = sputWord8 2 >> sput a + sget + = do t <- sgetWord8 + case t of + 0 -> return StackTraceInfo_None + 1 -> liftM StackTraceInfo_HasStackTraceEquiv sget + 2 -> liftM StackTraceInfo_IsStackTraceEquiv sget + diff --git a/src/UHC/Light/Compiler/Module/ImportExport.hs b/src/UHC/Light/Compiler/Module/ImportExport.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Module/ImportExport.hs @@ -0,0 +1,468 @@ +module UHC.Light.Compiler.Module.ImportExport +( ModEnt (..), ModExp (..), ModEntSpec (..), ModEntSubSpec (..), ModImp (..), Mod (..), ModEntRel, ModEntDomMp, ModEntRngMp +, emptyMod +, mentrelStrip +, ModEntRelFilterMp, mentrelFilterMpUnion, mentrelFilterMpUnions, mentrelToFilterMp, mentrelToFilterMp' +, mentrelFilterMpModuleNames +, mentrelFilterMpSingleton +, modImpBuiltin +, emptyMod' +, modBuiltin +, ModMpInfo (..), ModMp, emptyModMpInfo, mkModMpInfo +, ppModMp +, modMpAddHiddenExps +, modMpCombine', modMpCombine +, modImpPrelude ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.NameAspect +import Data.Maybe +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.Utils +import UHC.Util.Pretty +import qualified UHC.Util.Rel as Rel +import UHC.Light.Compiler.CodeGen.ValAccess as VA +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.TyGam (initTyGam) +import UHC.Light.Compiler.Gam.KiGam (initKiGam) +import UHC.Light.Compiler.CodeGen.RefGenerator +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +import UHC.Light.Compiler.Base.Debug + + + + + + + +{-# LINE 59 "src/ehc/Module/ImportExport.chs" #-} +data ModEnt + = ModEnt + { mentKind :: !IdOccKind + , mentIdOcc :: !IdOcc + , mentOwns :: !(Set.Set ModEnt) + , mentRange :: !Range + } + deriving (Show) + +instance Eq ModEnt where + e1 == e2 = mentKind e1 == mentKind e2 && mentIdOcc e1 == mentIdOcc e2 + +instance Ord ModEnt where + e1 `compare` e2 + = case mentKind e1 `compare` mentKind e2 of + EQ -> mentIdOcc e1 `compare` mentIdOcc e2 + c -> c + +type ModEntRel = Rel.Rel HsName ModEnt +type ModEntDomMp = Map.Map HsName [ModEnt] +type ModEntRngMp = Map.Map IdOcc [HsName] + +mentIsCon :: ModEnt -> Bool +mentIsCon e = mentKind e == IdOcc_Data || mentKind e == IdOcc_Class + + +{-# LINE 87 "src/ehc/Module/ImportExport.chs" #-} +mentStrip :: ModEnt -> ModEnt +mentStrip e = e {mentRange = emptyRange} + +mentrelStrip :: ModEntRel -> ModEntRel +mentrelStrip = Rel.mapDomRng (\(n,e) -> (n,mentStrip e)) + +{-# LINE 95 "src/ehc/Module/ImportExport.chs" #-} +deriving instance Typeable ModEnt +deriving instance Data ModEnt + +{-# LINE 100 "src/ehc/Module/ImportExport.chs" #-} +-- intended for parsing +ppModEnt :: ModEnt -> PP_Doc +ppModEnt e + = ppCurlysCommasBlock (l1 ++ l2) + where l1 = [pp (mentKind e),pp (mentIdOcc e)] + l2 = if Set.null (mentOwns e) then [] else [ppCurlysCommasBlock (map ppModEnt $ Set.toList $ mentOwns e)] + +-- intended for parsing +ppModEntRel :: ModEntRel -> PP_Doc +ppModEntRel = ppCurlysAssocL pp ppModEnt . Rel.toList + + +{-# LINE 116 "src/ehc/Module/ImportExport.chs" #-} +instance PP ModEnt where + pp = ppModEnt + +instance PP ModEntRel where + pp = ppModEntRel + +{-# LINE 128 "src/ehc/Module/ImportExport.chs" #-} +-- | names used per category of identifier +type ModEntRelFilterMp = Map.Map IdOccKind HsNameS + +mentrelFilterMpUnion :: ModEntRelFilterMp -> ModEntRelFilterMp -> ModEntRelFilterMp +mentrelFilterMpUnion = Map.unionWith Set.union + +mentrelFilterMpUnions :: [ModEntRelFilterMp] -> ModEntRelFilterMp +mentrelFilterMpUnions [] = Map.empty +mentrelFilterMpUnions l = foldr mentrelFilterMpUnion Map.empty l + +-- | extract ModEntRelFilterMp from export relation +mentrelToFilterMp' :: Bool -> [HsName] -> ModEntRel -> ModEntRelFilterMp +mentrelToFilterMp' inclOwns exclModNmL r + = rget True $ Rel.rng r + where get (ModEnt {mentIdOcc=(IdOcc {ioccKind=k, ioccNm=n}), mentOwns=owns}) + = mentrelFilterMpUnion (mentrelFilterMpSingleton exclModNmL k n) (rget inclOwns owns) + rget True occs = mentrelFilterMpUnions [ get e | e <- Set.toList occs ] + rget _ _ = Map.empty + +-- | extract ModEntRelFilterMp from export relation +mentrelToFilterMp :: [HsName] -> ModEntRel -> ModEntRelFilterMp +mentrelToFilterMp = mentrelToFilterMp' True + +{-# LINE 153 "src/ehc/Module/ImportExport.chs" #-} +-- | extract used module names from ModEntRelFilterMp +mentrelFilterMpModuleNames :: ModEntRelFilterMp -> HsNameS +mentrelFilterMpModuleNames m = Set.unions [ Set.map fromJust $ Set.filter isJust $ Set.map hsnQualifier s | s <- Map.elems m ] + +{-# LINE 159 "src/ehc/Module/ImportExport.chs" #-} +-- | construct a singleton, only not of the current module +mentrelFilterMpSingleton :: [HsName] -> IdOccKind -> HsName -> ModEntRelFilterMp +mentrelFilterMpSingleton exclModNmL k n + = case hsnQualifier n of + Just m | not (m `elem` exclModNmL) + -> Map.singleton k (Set.singleton n) + where + _ -> Map.empty + +{-# LINE 174 "src/ehc/Module/ImportExport.chs" #-} +data ModExp + = ModExpEnt !ModEntSpec + | ModExpMod !HsName + deriving (Show) + +data ModEntSpec + = ModEntSpec !HsName !Range !(Maybe ModEntSubSpec) + deriving (Show) + +data ModEntSubSpec + = ModEntSubAll + | ModEntSubs ![HsName] + deriving (Show) + +data ModImp + = ModImp + { mimpQualified :: !Bool + , mimpSource :: !HsName + , mimpAs :: !HsName + , mimpHiding :: !Bool + , mimpImpL :: ![ModEntSpec] + , mimpRange :: !Range + } + deriving (Show) + +emptyModImp :: ModImp +emptyModImp = ModImp False hsnUnknown hsnUnknown True [] emptyRange + + +{-# LINE 205 "src/ehc/Module/ImportExport.chs" #-} +modImpBuiltin :: ModImp +modImpBuiltin + = emptyModImp + { mimpSource = hsnModBuiltin + , mimpAs = hsnModBuiltin + } + +{-# LINE 214 "src/ehc/Module/ImportExport.chs" #-} +modImpPrelude :: ModImp +modImpPrelude + = emptyModImp + { mimpSource = hsnModPrelude + , mimpAs = hsnModPrelude + } + +{-# LINE 223 "src/ehc/Module/ImportExport.chs" #-} +instance PP ModExp where + pp (ModExpEnt s) = pp s + pp (ModExpMod m) = "module" >#< m + +instance PP ModEntSpec where + pp (ModEntSpec n _ s) = n >|< maybe empty pp s + +instance PP ModEntSubSpec where + pp ModEntSubAll = pp "(..)" + pp (ModEntSubs ns) = ppParensCommas ns + +instance PP ModImp where + pp i = mimpSource i >|< ppParensCommas (mimpImpL i) + +{-# LINE 243 "src/ehc/Module/ImportExport.chs" #-} +data Mod + = Mod + { modName :: !HsName + , modNameInSrc :: !(Maybe HsName) + , modExpL :: !(Maybe [ModExp]) + , modImpL :: ![ModImp] + , modDefs :: !ModEntRel + , modHiddenExps :: !ModEntRel + , modInstNmL :: ![HsName] + } + deriving (Show) + +emptyMod' n = Mod n Nothing Nothing [] Rel.empty Rel.empty [] +emptyMod = emptyMod' hsnUnknown + +{-# LINE 260 "src/ehc/Module/ImportExport.chs" #-} +modBuiltin + = emptyMod + { modName = hsnModBuiltin + , modDefs = defs + } + where defs + = Rel.fromList [ (n,ModEnt IdOcc_Type (IdOcc n IdOcc_Type) Set.empty emptyRange) | (n,_) <- gamToAssocL initTyGam ] + `Rel.union` Rel.fromList [ (n,ModEnt IdOcc_Kind (IdOcc n IdOcc_Kind) Set.empty emptyRange) | (n,_) <- gamToAssocL initKiGam ] + +{-# LINE 271 "src/ehc/Module/ImportExport.chs" #-} +instance PP Mod where + pp m = modName m >|< "/" >|< modNameInSrc m + >-< indent 2 ( "IMP" >#< ppParensCommas (modImpL m) + >-< "EXP" >#< maybe empty ppParensCommas (modExpL m) + >-< "HID" >#< pp (modHiddenExps m) + >-< "DEF" >#< pp (modDefs m) + ) + +{-# LINE 285 "src/ehc/Module/ImportExport.chs" #-} +modEntSpec :: Bool -> ModEntRel -> ModEntSpec -> ModEntRel +modEntSpec isHiding rel (ModEntSpec x _ subspec) + | isHiding && isNothing subspec + = mSpec + | otherwise = Rel.unions [mSpec,mSub mSpec] + where mSpec = Rel.restrictDom (==x) rel + mSub spec = case subspec of + Nothing -> Rel.empty + Just ModEntSubAll -> subs + Just (ModEntSubs xs) -> Rel.restrictDom ((`elem` xs) . hsnQualified) subs + where allSubs = mentOwns `unionMapSet` Rel.rng spec + subs = Rel.restrictRng (`Set.member` allSubs) rel + +{-# LINE 304 "src/ehc/Module/ImportExport.chs" #-} +modExports :: Mod -> ModEntRel -> ModEntRel +modExports mod inscp + = case modExpL mod of + Nothing -> modDefs mod + Just es -> hsnQualified `Rel.mapDom` Rel.unions exps + where exps = modExpListEntry inscp `map` es + +{-# LINE 313 "src/ehc/Module/ImportExport.chs" #-} +modExpListEntry :: ModEntRel -> ModExp -> ModEntRel +modExpListEntry inscp (ModExpEnt it) + = modEntSpec False inscp it +modExpListEntry inscp (ModExpMod m) + = (hsnSetQual m `Rel.mapDom` unqs) `Rel.intersection` qs + where (qs,unqs) = Rel.partitionDom hsnIsQual inscp + +{-# LINE 326 "src/ehc/Module/ImportExport.chs" #-} +modInscope :: Mod -> (HsName -> ModEntRel) -> ModEntRel +modInscope m expsOf + = Rel.unions [imports,locals] + where defEnts = modDefs m + locals = Rel.unions + [ hsnQualified `Rel.mapDom` defEnts + , hsnSetQual (modName m) `Rel.mapDom` defEnts + ] + imports = Rel.unions $ map (impOf expsOf) impL + impL = -- (\v -> tr "modInscope.impL: " (modName m >#< v) v) $ + modImpL m + impOf e n + = -- (\v -> tr "modInscope.impOf: " (modName m >#< n >#< v) v) $ + modImp e n + +{-# LINE 343 "src/ehc/Module/ImportExport.chs" #-} +modImp :: (HsName -> ModEntRel) -> ModImp -> ModEntRel +modImp expsOf imp + | mimpQualified imp = qs + | otherwise = Rel.unions [unqs,qs] + where qs = hsnSetQual (mimpAs imp) `Rel.mapDom` incoming + unqs = hsnQualified `Rel.mapDom` incoming + listed = Rel.unions $ map (modEntSpec isHiding exps) (mimpImpL imp) + isHiding = mimpHiding imp + exps = expsOf (mimpSource imp) + incoming + | isHiding = exps `Rel.difference` listed + | otherwise = listed + +{-# LINE 362 "src/ehc/Module/ImportExport.chs" #-} +modInsOuts :: (HsName -> ModEntRel) -> [Mod] -> [(ModEntRel,ModEntRel)] +modInsOuts otherExps mods + = inscps `zip` exps + where inscps = computeIs exps + exps = lfpAfter nextExps $ replicate (length mods) Rel.empty + nextExps = computeEs . computeIs + computeEs is = zipWith modExports mods is + computeIs es = map (`modInscope` toFun es) mods + toFun es m = maybe (otherExps m) (es !!) (lookup m modIxs) + modIxs = map modName mods `zip` [0..] + +{-# LINE 375 "src/ehc/Module/ImportExport.chs" #-} +lfpAfter :: Eq x => (x -> x) -> x -> x +lfpAfter f x + = if fx == x then fx else lfpAfter f fx + where fx = f x + +{-# LINE 386 "src/ehc/Module/ImportExport.chs" #-} +checkMod :: (HsName -> Maybe ModEntRel) -> ModEntRel -> Mod -> [Err] +checkMod expsOf inscp mod + = checkAmbigExps modExports + ++ if null missingModules + then checkExpSpec inscp mod + ++ [ err | (imp,Just exps) <- impSources, err <- checkImp exps imp ] + else [rngLift emptyRange mkErr_NamesNotIntrod' "module" missingModules] + where Just modExports = expsOf (modName mod) + impSources = [ (imp,expsOf (mimpSource imp)) | imp <- modImpL mod ] + missingModules = nubOn fst [ mkThingAnd1Range (mimpRange imp) (mimpSource imp) | (imp,Nothing) <- impSources ] + +{-# LINE 399 "src/ehc/Module/ImportExport.chs" #-} +checkAmbigExps :: ModEntRel -> [Err] +checkAmbigExps exps + = concatMap isAmbig (Set.toList (Rel.dom exps)) + where isAmbig n = ambig n cons ++ ambig n other + where (cons,other) = partition mentIsCon (Rel.apply exps n) + ambig n ents@(_:_:_) | not (null a) + = [rngLift emptyRange Err_AmbiguousExport n (map mkn $ concat $ a)] + where a = [ l | l@(_:_:_) <- groupSortOn (ioccKind . mentIdOcc) ents ] + mkn o = (ioccNm $ mentIdOcc o, Just [(mentRange o,Nothing)]) + ambig n _ = [] + +{-# LINE 416 "src/ehc/Module/ImportExport.chs" #-} +checkEntSpec :: Bool -> (HsName -> Range -> Err) -> (HsName -> HsName -> Err) -> ModEntSpec -> ModEntRel -> [Err] +checkEntSpec isHiding errUndef errUndefSub (ModEntSpec x xrange subspec) rel + | isHiding && isNothing subspec + = case xents of + [] -> [errUndef x xrange] + _ -> [] + | otherwise = case xents of + [] -> [errUndef x xrange] + ents -> concatMap chk $ filter mentIsCon $ ents + where xents = Rel.apply rel x + chk ent = case subspec of + Just (ModEntSubs subs) + -> map (errUndefSub x) (filter (not . (`Set.member` subsInScope)) subs) + where subsInScope + = Set.map hsnQualified + $ Rel.dom + $ Rel.restrictRng (`Set.member` mentOwns ent) rel + _ -> [] + +{-# LINE 437 "src/ehc/Module/ImportExport.chs" #-} +checkExpSpec :: ModEntRel -> Mod -> [Err] +checkExpSpec inscp mod + = case modExpL mod of + Nothing -> [] + Just exps -> concatMap chk exps + where aliases = modName mod : mimpAs `map` modImpL mod + chk (ModExpMod x) + | x `elem` aliases = [] + | otherwise = [rngLift emptyRange mkErr_NamesNotIntrod "module alias" [x]] + chk (ModExpEnt spec) = checkEntSpec False err1 err2 spec inscp + err1 x r = rngLift emptyRange mkErr_NamesNotIntrod' ("export") [mkThingAnd1Range r x] + err2 e x = rngLift emptyRange mkErr_NamesNotIntrod ("subexport of export " ++ show e) [x] + +{-# LINE 452 "src/ehc/Module/ImportExport.chs" #-} +checkImp :: ModEntRel -> ModImp -> [Err] +checkImp exps imp + = concatMap chk (mimpImpL imp) + where src = mimpSource imp + chk spec = checkEntSpec (mimpHiding imp) err1 err2 spec exps + err1 x r = rngLift emptyRange mkErr_NamesNotIntrod' ("module " ++ show src ++ " import") [mkThingAnd1Range r x] + err2 i x = rngLift emptyRange mkErr_NamesNotIntrod ("module " ++ show src ++ " subimport of import " ++ show i) [x] + +{-# LINE 466 "src/ehc/Module/ImportExport.chs" #-} +data ModMpInfo + = ModMpInfo + { mmiInscps :: !ModEntRel + , mmiExps :: !ModEntRel + , mmiHiddenExps :: !ModEntRel + , mmiNmOffMp :: !HsName2FldMp -- cached mapping of names to offsets, for all that is exported, visible or hidden + } + +instance Show ModMpInfo where + show _ = "ModMpInfo" + +instance PP ModMpInfo where + pp i = "In scp :" >#< (ppAssocL $ Rel.toList $ mmiInscps i) + >-< "Exps :" >#< (ppAssocL $ Rel.toList $ mmiExps i) + >-< "Hidden Exps:" >#< (ppAssocL $ Rel.toList $ mmiHiddenExps i) + +emptyModMpInfo :: ModMpInfo +emptyModMpInfo = mkModMpInfo hsnUnknown Rel.empty Rel.empty Rel.empty + +mkModMpInfo :: HsName -> ModEntRel -> ModEntRel -> ModEntRel -> ModMpInfo +mkModMpInfo modNm i e he + = -- (\v -> tr "mkModMpInfo" (modNm >-< i) v) $ + resetModMpInfo modNm + $ ModMpInfo + { mmiInscps = i + , mmiExps = e + , mmiHiddenExps = he + , mmiNmOffMp = Map.empty + } + +resetModMpInfo :: HsName -> ModMpInfo -> ModMpInfo +resetModMpInfo modNm i = i {mmiNmOffMp = expsNmOffMp modNm $ mmiExps i `Rel.union` mmiHiddenExps i} + +{-# LINE 509 "src/ehc/Module/ImportExport.chs" #-} +type ModMp = Map.Map HsName ModMpInfo + +ppModMp :: ModMp -> PP_Doc +ppModMp = vlist . map (\(n,i) -> n >#< pp i) . Map.toList + +{-# LINE 516 "src/ehc/Module/ImportExport.chs" #-} +modMpAddHiddenExps :: HsName -> [(HsName,IdOccKind)] -> ModMp -> ModMp +modMpAddHiddenExps modNm newExpNms mm + = Map.update (\i@(ModMpInfo {mmiHiddenExps=he}) + -> Just $ resetModMpInfo modNm + $ i { mmiHiddenExps + = Rel.fromList [ (n, ModEnt occk (IdOcc n occk) Set.empty emptyRange) | (n,occk) <- newExpNms ] + `Rel.union` he + } + ) modNm mm + +{-# LINE 530 "src/ehc/Module/ImportExport.chs" #-} +expsNmOffMp :: HsName -> ModEntRel -> HsName2FldMp +expsNmOffMp modNm exps + = Map.fromList + $ refGen 0 1 + $ sortBy cmpHsNameOnNm + $ nub + $ [ nm + | e <- Set.toList $ Rel.rng exps + , mentKind e == IdOcc_Val + , let nm = ioccNm (mentIdOcc e) + mbqual = hsnQualifier nm + , isJust mbqual -- unqualified names cannot be exported, but they should not intro'd in the 1st place!! TBD 20100303 AD + , panicJust ("Module.expsNmOffMp: " ++ show nm) mbqual == modNm + ] + +{-# LINE 547 "src/ehc/Module/ImportExport.chs" #-} +modMpCombine' :: (HsName -> ModMpInfo) -> [Mod] -> ModMp -> (ModMp,[Err]) +modMpCombine' dfltMod ms mp + = (newMp,concat errs) + where expsOf mp n = mmiExps $ Map.findWithDefault (dfltMod n) n mp + -- expsOf mp n = mmiExps $ Map.findWithDefault emptyModMpInfo n mp + rels = modInsOuts (expsOf mp) ms + (inscps,exps) = unzip rels + newMp = (Map.fromList $ zipWith4 (\n i o ho -> (n,mkModMpInfo n i o ho)) (map modName ms) inscps exps (map modHiddenExps ms)) + `Map.union` mp + errs = zipWith (checkMod (fmap mmiExps . (`Map.lookup` newMp))) inscps ms + +modMpCombine :: [Mod] -> ModMp -> (ModMp,[Err]) +modMpCombine = modMpCombine' (const emptyModMpInfo) + +{-# LINE 576 "src/ehc/Module/ImportExport.chs" #-} +instance Serialize ModEnt where + sput (ModEnt a b c d) = sput a >> sput b >> sput c >> sput d + sget = liftM4 ModEnt sget sget sget sget + diff --git a/src/UHC/Light/Compiler/Module/Merge.hs b/src/UHC/Light/Compiler/Module/Merge.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Module/Merge.hs @@ -0,0 +1,130 @@ +module UHC.Light.Compiler.Module.Merge +( ModDbBindLetInfo'' +, ModDbBindArray' +, ModPuller (..) +, modMergeByPullingInM +, modMergeByPullingIn ) +where +import UHC.Light.Compiler.Base.Common +import Data.List +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Util.Utils +import Control.Monad.Identity +import Control.Monad.State +import Data.Array +import qualified UHC.Util.FastSeq as Seq + +{-# LINE 31 "src/ehc/Module/Merge.chs" #-} +-- | the binding info required for let bind +type ModDbBindLetInfo'' f cat bind = (cat,f bind) +type ModDbBindLetInfo'2 cat bind = ModDbBindLetInfo'' [] cat bind + +{-# LINE 37 "src/ehc/Module/Merge.chs" #-} +-- | actual bindings stored in separate array to allow for sharing +type ModDbBindArray' cat bind = Array Int (ModDbBindLetInfo'' (Array Int) cat bind) + +{-# LINE 46 "src/ehc/Module/Merge.chs" #-} +-- | Abstraction of how pulling from a module to something else is done +class ModPuller modFr modsDb modsRem modTo expr cat bind +{- 20140928 TBD: not properly refactored yet, in particular the functional dpds are too restrictive... +-} + | modFr -> expr cat bind modsRem modsDb modTo + , expr -> modFr + , cat -> modFr + , bind -> modFr + , modsRem -> modFr + , modsDb -> modFr + , modTo -> modFr + where + -- | Split main + imported into (1) root expr, (2) root bindings also visible and to be included, (3) part on which merging takes place and (4) a remainder + mpullSplit :: modFr -> [modFr] -> (expr, Maybe (cat,[(bind,HsNameS)]), modsDb, modsRem) + + -- | Extract bindings for a name, consisting of a category, set of bindings, and the bound names (including the one asked for) pulled in. + mpullUsedBindings :: Monad m => HsName -> modsDb -> m (Maybe (cat, [bind], HsNameS)) + + -- | Extract expr's relevant for inducing further pullins + mpullRelevantExprs :: bind -> [expr] + + -- | Extract free names/vars from expr + mpullFreeVars :: expr -> HsNameS + + -- | Combine bindings + root expr into result module + mpullBindingsAddToMod :: modsRem -> expr -> [(cat,[bind])] -> modTo -> modTo + +{-# LINE 79 "src/ehc/Module/Merge.chs" #-} +data PullState cat bind + = PullState + { pullstBinds :: Seq.Seq (ModDbBindLetInfo'2 cat bind) -- ^ pulled in bindings + , pullstPulledNmS :: !HsNameS -- ^ pulled in names + , pullstToDo :: ![HsName] -- ^ names todo + } + +emptyPullState :: PullState cat bind +emptyPullState = PullState Seq.empty Set.empty [] + +{-# LINE 91 "src/ehc/Module/Merge.chs" #-} +type ModMergeT cat bind m a = StateT (PullState cat bind) m a + +{-# LINE 95 "src/ehc/Module/Merge.chs" #-} +-- | merge by pulling in that which is required only, monadically +modMergeByPullingInM + :: ( ModPuller modFr modsDb modsRem modTo expr cat bind + , Monad m + ) + => (modFr, [modFr]) -- ^ main and imported + -> ModMergeT cat bind m + ( (modTo -> modTo) -- conversion of resulting module + , HsNameS -- modules from which something was taken + ) +modMergeByPullingInM (modMain,modImpL) = do + let (rootExpr,mbExports,modDb,modRem) = mpullSplit modMain modImpL + put $ emptyPullState {pullstToDo = Set.toList $ Set.unions $ mpullFreeVars rootExpr : (maybe [] (map snd . snd) mbExports)} + pull modDb + when (isJust mbExports) $ + let (Just (exportCateg,rootExports)) = mbExports + in modify $ \st -> st {pullstBinds = pullstBinds st `Seq.union` Seq.fromList [ (exportCateg,[b]) | (b,_) <- rootExports ]} + final <- get + return + ( mpullBindingsAddToMod modRem rootExpr (Seq.toList $ pullstBinds final) + , Set.map (panicJust "modMergeByPullingInM" . hsnQualifier) $ pullstPulledNmS final + ) + where + pull modDb = do + s <- get + case pullstToDo s of + (nm:nmRest) + | nm `Set.notMember` pullstPulledNmS s {- && isJust mbPull -} -> do + mbPull@(~(Just (cat,binds,pulled))) <- lift $ mpullUsedBindings nm modDb + if isJust mbPull + then do + let pulledNms = pullstPulledNmS s `Set.union` pulled + newNms + = (Set.unions $ map (Set.unions . map mpullFreeVars . mpullRelevantExprs) binds) + `Set.difference` pulledNms + put $ + s { pullstToDo = Set.toList newNms ++ nmRest + , pullstBinds = Seq.singleton (cat,binds) `Seq.union` pullstBinds s + , pullstPulledNmS = pulledNms + } + pull modDb + else + dfltContinue + | otherwise -> dfltContinue + where -- mbPull@(~(Just (cat,binds,pulled))) = pullIn nm + dfltContinue = do + put $ s { pullstToDo = nmRest } + pull modDb + _ -> return () + +{-# LINE 147 "src/ehc/Module/Merge.chs" #-} +-- | merge by pulling in that which is required only +modMergeByPullingIn + :: ModPuller modFr modsDb modsRem modTo expr cat bind + => (modFr, [modFr]) -- ^ main and imported + -> ( (modTo -> modTo) -- conversion of resulting module + , HsNameS -- modules from which something was taken + ) +modMergeByPullingIn mods = flip evalState emptyPullState $ modMergeByPullingInM mods + diff --git a/src/UHC/Light/Compiler/NameAspect.hs b/src/UHC/Light/Compiler/NameAspect.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/NameAspect.hs @@ -0,0 +1,170 @@ +module UHC.Light.Compiler.NameAspect +( IdDefOcc (..), emptyIdDefOcc, mkIdDefOcc +, IdAspect (..) +, iaspIsFun, iaspIsPat, iaspIsValSig, iaspIsValVar, iaspIsValFix +, iaspIsTypeVar +, iaspIsValCon, iaspIsTypeDef, iaspIsValFld +, iaspIsTypeSig +, iaspIsValForeign +, iaspIsClassDef +, idDefOccLCmb +, doccStrip ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import qualified UHC.Light.Compiler.EH as EH +import UHC.Util.Pretty +import qualified Data.Set as Set +import UHC.Util.Utils + + + +{-# LINE 60 "src/ehc/NameAspect.chs" #-} +data IdAspect + = IdAsp_Val_Var + | IdAsp_Val_Pat {iaspDecl :: EH.Decl } + | IdAsp_Val_Fun {iaspPatL :: [EH.PatExpr], iaspBody :: EH.Expr, iaspUniq :: !UID} + | IdAsp_Val_Sig {iaspDecl :: EH.Decl } + | IdAsp_Val_Fix + | IdAsp_Val_Con + | IdAsp_Val_Fld {iaspDataNm :: !HsName, iaspConNm :: !HsName } + | IdAsp_Val_Fusion {iaspDecl :: EH.Decl } + | IdAsp_Fusion_Conv {iaspDecl :: EH.Decl } + | IdAsp_Type_Con + | IdAsp_Type_Var + | IdAsp_Type_Def {iaspDecl :: EH.Decl } + | IdAsp_Type_Sig {iaspDecl :: !EH.Decl } + | IdAsp_Kind_Con + | IdAsp_Kind_Var + | IdAsp_Val_Foreign {iaspDecl :: !EH.Decl } + | IdAsp_Class_Class + | IdAsp_Class_Def {iaspDecl :: EH.Decl, iaspDeclInst :: EH.Decl} + | IdAsp_Inst_Inst + | IdAsp_Inst_Def {iaspDecl :: EH.Decl, iaspClassNm :: !HsName} + | IdAsp_Dflt_Def -- for now defaults without explicit class name are ignored + {iaspDecl :: !EH.Decl, iaspIgnore :: !Bool } + | IdAsp_Any + +{-# LINE 101 "src/ehc/NameAspect.chs" #-} +iaspIsFun :: IdAspect -> Bool +iaspIsFun (IdAsp_Val_Fun _ _ _) = True +iaspIsFun _ = False + +iaspIsPat :: IdAspect -> Bool +iaspIsPat (IdAsp_Val_Pat _) = True +iaspIsPat _ = False + +iaspIsValSig :: IdAspect -> Bool +iaspIsValSig (IdAsp_Val_Sig _) = True +iaspIsValSig _ = False + +iaspIsValVar :: IdAspect -> Bool +iaspIsValVar IdAsp_Val_Var = True +iaspIsValVar _ = False + +iaspIsValFix :: IdAspect -> Bool +iaspIsValFix IdAsp_Val_Fix = True +iaspIsValFix _ = False + +{-# LINE 123 "src/ehc/NameAspect.chs" #-} +iaspIsTypeVar :: IdAspect -> Bool +iaspIsTypeVar IdAsp_Type_Var = True +iaspIsTypeVar _ = False + +{-# LINE 129 "src/ehc/NameAspect.chs" #-} +iaspIsValCon :: IdAspect -> Bool +iaspIsValCon IdAsp_Val_Con = True +iaspIsValCon _ = False + +iaspIsValFld :: IdAspect -> Bool +iaspIsValFld (IdAsp_Val_Fld _ _) = True +iaspIsValFld _ = False + +iaspIsTypeDef :: IdAspect -> Bool +iaspIsTypeDef (IdAsp_Type_Def _) = True +iaspIsTypeDef _ = False + +{-# LINE 143 "src/ehc/NameAspect.chs" #-} +iaspIsTypeSig :: IdAspect -> Bool +iaspIsTypeSig (IdAsp_Type_Sig _) = True +iaspIsTypeSig _ = False + +{-# LINE 149 "src/ehc/NameAspect.chs" #-} +iaspIsValForeign :: IdAspect -> Bool +iaspIsValForeign (IdAsp_Val_Foreign _) = True +iaspIsValForeign _ = False + +{-# LINE 155 "src/ehc/NameAspect.chs" #-} +iaspIsClassDef :: IdAspect -> Bool +iaspIsClassDef (IdAsp_Class_Def _ _) = True +iaspIsClassDef _ = False + +{-# LINE 161 "src/ehc/NameAspect.chs" #-} +instance Show IdAspect where + show _ = "IdAspect" + +{-# LINE 166 "src/ehc/NameAspect.chs" #-} +instance PP IdAspect where + pp IdAsp_Val_Var = pp "value" + pp (IdAsp_Val_Pat _ ) = pp "pattern" + pp (IdAsp_Val_Fun _ _ _) = pp "function" + pp (IdAsp_Val_Sig _ ) = pp "type signature" + pp IdAsp_Val_Fix = pp "fixity" + pp IdAsp_Val_Con = pp "data constructor" + pp (IdAsp_Val_Fld _ _ ) = pp "data field" + pp (IdAsp_Val_Fusion _) = pp "fuse" + pp (IdAsp_Fusion_Conv _) = pp "convert" + pp IdAsp_Type_Con = pp "type constructor" + pp IdAsp_Type_Var = pp "type variable" + pp (IdAsp_Type_Def _ ) = pp "type" + pp (IdAsp_Type_Sig _ ) = pp "kind signature" + pp IdAsp_Kind_Con = pp "kind constructor" + pp IdAsp_Kind_Var = pp "kind variable" + pp (IdAsp_Val_Foreign _) = pp "foreign" + pp IdAsp_Class_Class = pp "class" + pp (IdAsp_Class_Def _ _) = pp "class" + pp IdAsp_Inst_Inst = pp "instance" + pp (IdAsp_Inst_Def _ _) = pp "instance" + pp (IdAsp_Dflt_Def _ _) = pp "default" + pp IdAsp_Any = pp "ANY" + +{-# LINE 210 "src/ehc/NameAspect.chs" #-} +data IdDefOcc + = IdDefOcc + { doccOcc :: !IdOcc + , doccAsp :: !IdAspect + , doccLev :: !NmLev + , doccRange :: !Range + , doccNmAlts :: !(Set.Set HsName) -- !(Maybe [HsName]) + } + deriving (Show) + +emptyIdDefOcc :: IdDefOcc +emptyIdDefOcc = mkIdDefOcc (IdOcc hsnUnknown IdOcc_Any) IdAsp_Any nmLevAbsent emptyRange + +{-# LINE 232 "src/ehc/NameAspect.chs" #-} +mkIdDefOcc :: IdOcc -> IdAspect -> NmLev -> Range -> IdDefOcc +mkIdDefOcc o a l r = IdDefOcc o a l r Set.empty + +{-# LINE 237 "src/ehc/NameAspect.chs" #-} +instance PP IdDefOcc where + pp o = doccOcc o >|< "/" >|< doccAsp o >|< "/" >|< doccLev o + >|< (ppBracketsCommas $ Set.toList $ doccNmAlts o) + +{-# LINE 245 "src/ehc/NameAspect.chs" #-} +-- | Collapse multiple 'IdDefOcc', remembering duplicates in doccNmAlts +idDefOccLCmb :: IdDefOcc -> [IdDefOcc] -> [IdDefOcc] +idDefOccLCmb l1 l2 = + [ d {doccNmAlts = Set.unions [Set.insert (ioccNm o) a | (IdDefOcc {doccOcc = o, doccNmAlts = a}) <- g]} + | g@(d:_) <- groupSortOn (\d -> (ioccKind $ doccOcc d {-, doccLev d -})) $ l1 : l2 + ] + +{-# LINE 254 "src/ehc/NameAspect.chs" #-} +-- | Strip positional info +doccStrip :: IdDefOcc -> IdDefOcc +doccStrip o = o {doccRange = emptyRange} + +{-# LINE 311 "src/ehc/NameAspect.chs" #-} +instance PP IdOcc where + pp o = ppCurlysCommas [pp (ioccNm o),pp (ioccKind o)] + diff --git a/src/UHC/Light/Compiler/Opts.hs b/src/UHC/Light/Compiler/Opts.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Opts.hs @@ -0,0 +1,596 @@ +module UHC.Light.Compiler.Opts +( module UHC.Light.Compiler.Opts.Base +, optOptsIsYes, showStr2stMp +, defaultEHCOpts +, ehcCmdLineOpts +, ehcCmdLineOptsApply +, FIOpts (..) +, strongFIOpts +, instLFIOpts +, instLRFIOpts +, unifyFIOpts, instFIOpts +, fioSwapPolarity, fioSwapOpts +, fioMkStrong +, fioMkWeak +, fioMkUnify +, fioIsSubsume +, weakFIOpts +, Optimize (..), OptimizationLevel (..) +, module UHC.Light.Compiler.Base.FileSearchLocation +, ehcOptWholeProgHPTAnalysis +, ehcOptEmitCore +, ehcOptOptimizes +, fioMkFinal +, FIOBind (..) +, fioBindIsYes, fioBindNoSet +, predFIOpts, implFIOpts +, ehcOptWholeProgOptimizationScope +, ehcOptEarlyModMerge +, optsDiscrRecompileRepr +, ehcOptUpdateWithPragmas ) +where +import System.Console.GetOpt +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import UHC.Util.Utils +import Data.Maybe +import qualified Data.Map as Map +import Data.Char +import UHC.Util.Pretty +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import Data.List +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.FPath +import UHC.Light.Compiler.EHC.Environment +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.Base.FileSearchLocation +import UHC.Light.Compiler.Error +import qualified UHC.Light.Compiler.Config as Cfg +import UHC.Light.Compiler.Base.Pragma +import UHC.Light.Compiler.Opts.CommandLine +import UHC.Light.Compiler.Base.Parser +import UHC.Light.Compiler.Base.Parser2 +import UHC.Light.Compiler.Base.Debug + + + + + + + + + +{-# LINE 70 "src/ehc/Opts.chs" #-} +-- | possibly adapt with pragmas +ehcOptUpdateWithPragmas :: Set.Set Pragma -> EHCOpts -> (EHCOpts,Bool) +ehcOptUpdateWithPragmas pragmas opts + = foldr (\p om@(o,modf) -> maybe om (\o -> (o,True)) $ upd p o) (opts,False) (Set.toList pragmas) + where upd pragma opts + = case pragma of + Pragma_NoGenericDeriving -> Just $ opts { ehcOptGenGenerics = False } + Pragma_GenericDeriving -> Just $ opts { ehcOptGenGenerics = True } + Pragma_NoBangPatterns -> Just $ opts { ehcOptBangPatterns = False } + Pragma_BangPatterns -> Just $ opts { ehcOptBangPatterns = True } + Pragma_NoOverloadedStrings -> Just $ opts { ehcOptOverloadedStrings = False } + Pragma_OverloadedStrings -> Just $ opts { ehcOptOverloadedStrings = True } + Pragma_NoPolyKinds -> Just $ opts { ehcOptPolyKinds = False } + Pragma_PolyKinds -> Just $ opts { ehcOptPolyKinds = True } + Pragma_ExtensibleRecords -> Just $ opts { ehcOptExtensibleRecords = True } + Pragma_Fusion -> Just $ opts { ehcOptFusion = True } + Pragma_OptionsUHC o -> fmap (\o -> o {ehcOptCmdLineOptsDoneViaPragma = True}) mo + where (mo,_,_) = ehcCmdLineOptsApply [] (words o) opts + _ -> Nothing + +{-# LINE 96 "src/ehc/Opts.chs" #-} +mkStringPath :: String -> [String] +mkStringPath = wordsBy (`elem` ";,") + +mkFileLocPath :: String -> FileLocPath +mkFileLocPath = map mkDirFileLoc . mkStringPath + +{-# LINE 108 "src/ehc/Opts.chs" #-} +optOpts :: Map.Map String opt -> String -> [opt] +optOpts m s = catMaybes $ map (\os -> Map.lookup os m) $ wordsBy (==',') s + +optOptsIsYes :: Eq opt => Maybe [opt] -> opt -> Bool +optOptsIsYes mos o = maybe False (o `elem`) mos + + +{-# LINE 117 "src/ehc/Opts.chs" #-} +instance Show CoreOpt where + -- show CoreOpt_PPParseable = "pp-parseable" + show CoreOpt_Dump = "dump" + show CoreOpt_DumpBinary = "dump-binary" + show CoreOpt_DumpAlsoNonParseable = "whendump-alsononparseable" + show CoreOpt_Run = "run" + show CoreOpt_RunDump = "dump-run" + show CoreOpt_RunTrace = "run-trace" + show CoreOpt_RunPPNames = "run-ppnames" + show _ = "-" + +coreOptMp :: Map.Map String CoreOpt +coreOptMp = str2stMpWithOmit [CoreOpt_NONE] + +{-# LINE 178 "src/ehc/Opts.chs" #-} +instance Show PgmExec where + show PgmExec_CPP = "P" + show PgmExec_C = "c" + show PgmExec_Linker = "l" + +pgmExecMp :: Map.Map String PgmExec +pgmExecMp = str2stMp + +{-# LINE 194 "src/ehc/Opts.chs" #-} +-- do something with whole program +ehcOptWholeProgOptimizationScope :: EHCOpts -> Bool +ehcOptWholeProgOptimizationScope opts + = ehcOptOptimizationScope opts > OptimizationScope_PerModule + +{-# LINE 201 "src/ehc/Opts.chs" #-} +-- compatibility option +ehcOptEarlyModMerge :: EHCOpts -> Bool +ehcOptEarlyModMerge opts + = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore + +{-# LINE 208 "src/ehc/Opts.chs" #-} +-- do whole program analysis, with HPT +ehcOptWholeProgHPTAnalysis :: EHCOpts -> Bool +ehcOptWholeProgHPTAnalysis opts + = False + +{-# LINE 256 "src/ehc/Opts.chs" #-} +-- generate Core +ehcOptEmitCore :: EHCOpts -> Bool +ehcOptEmitCore opts + = ehcOptWholeProgHPTAnalysis opts || targetIsCore (ehcOptTarget opts) + +{-# LINE 274 "src/ehc/Opts.chs" #-} +-- | optimizes a particular option +ehcOptOptimizes :: Optimize -> EHCOpts -> Bool +ehcOptOptimizes o opts = o `Set.member` ehcOptOptimizations opts + +{-# LINE 284 "src/ehc/Opts.chs" #-} +defaultEHCOpts + = emptyEHCOpts + { ehcOptExecOptsMp = ehcOptExecOptsMp emptyEHCOpts `Map.union` Map.fromList + [ (Cfg.shellCmdCpp, [ExecOpt_Plain "traditional-cpp", ExecOpt_Plain "std=gnu99", ExecOpt_Plain "fno-show-column", ExecOpt_Plain "P"]) + ] + } + +{-# LINE 299 "src/ehc/Opts.chs" #-} +ehcCmdLineOpts + = [ Option "h" ["help"] (NoArg oHelp) "print this help (then stop)" + , Option "" ["version"] (NoArg oVersion) "print version info (then stop)" + , Option "" ["version-dotted"] (NoArg oNumVersion) ("print version in \"x.y.z\" style (then stop)") + , Option "" ["version-asnumber"] (NoArg oVersionAsNumber) ("print version in \"xyz\" style (then stop)") + , Option "" ["numeric-version"] (NoArg oNumVersion) "see --version-dotted (to become obsolete)" + , Option "v" ["verbose"] (OptArg oVerbose "0|1|2|3|4") ( "be verbose, 0=quiet, 4=debug, " + ++ "default=1" + ) + , Option "t" ["target"] (ReqArg oTarget (showSupportedTargets' "|")) + ("generate code for target, default=" ++ show defaultTarget) + , Option "" ["target-flavor"] (ReqArg oTargetFlavor (showAllTargetFlavors' "|")) + ("generate code for target flavor, default=" ++ show defaultTargetFlavor) + , Option "p" ["pretty"] (OptArg oPretty "hs|eh|ast|-") "show pretty printed source or EH abstract syntax tree, default=eh, -=off, (downstream only)" + + + , Option "O" ["optimise"] (OptArg oOptimization ("0|1|2|3|[=" ++ boolArgStr ++ "]")) + ("optimise with level or specific by optim name: " + ++ showStr2stMp allOptimizeMp + ++ ", or by scope name: " + ++ showStr2stMp allOptimScopeMp + ++ ", default=1") + , Option "" ["gen-trampoline"] (boolArg oSetGenTrampoline) "codegen: use trampoline mechanism (development/internal use only)" + , Option "" ["no-recomp"] (NoArg oNoRecomp) "turn off recompilation check (force recompile)" + , Option "" ["no-prelude"] (NoArg oNoPrelude) "do not assume presence of Prelude" + , Option "" ["no-hi-check"] (NoArg oNoHiCheck) "no check on .hi files not matching the compiler version" + , Option "c" ["compile-only"] (NoArg oCompileOnly) "compile only, do not link" + , Option "i" ["import-path"] (ReqArg oUsrFileLocPath "path") "search path for user files, separators=';', appended to previous" + , Option "L" ["lib-search-path"] (ReqArg oLibFileLocPath "path") "search path for library files, see also --import-path" + , Option "" ["cpp"] (NoArg oCPP) "preprocess source with CPP" + , Option "" ["limit-tysyn-expand"] (intArg oLimitTyBetaRed) "type synonym expansion limit" + , Option "" ["odir"] (ReqArg oOutputDir "dir") "base directory for generated files" + , Option "o" ["output"] (ReqArg oOutputFile "file") "file to generate executable to (implies --compile-only off)" + , Option "" ["keep-intermediate-files"] (NoArg oKeepIntermediateFiles) "keep intermediate files (default=off)" + , Option "" ["meta-variant"] (NoArg oVariant) "meta: print variant (then stop)" + , Option "" ["meta-target-default"] (NoArg oTargetDflt) "meta: print the default codegeneration target (then stop)" + , Option "" ["meta-targets"] (NoArg oTargets) "meta: print supported codegeneration targets (then stop)" + , Option "" ["meta-optimizations"] (NoArg oOptimizations) "meta: print optimization names (then stop)" + , Option "" ["meta-pkgdir-system"] (NoArg oMetaPkgdirSys) "meta: print system package dir (then stop)" + , Option "" ["meta-pkgdir-user"] (NoArg oMetaPkgdirUser) "meta: print user package dir (then stop)" + , Option "" ["package"] (ReqArg oExposePackage "package") "see --pkg-expose" + , Option "" ["hide-all-packages"] (NoArg oHideAllPackages) "see --pkg-hide-all" + , Option "" ["pkg-expose"] (ReqArg oExposePackage "package") "pkg: expose/use package" + , Option "" ["pkg-hide"] (ReqArg oHidePackage "package") "pkg: hide package" + , Option "" ["pkg-hide-all"] (NoArg oHideAllPackages) "pkg: hide all (implicitly) assumed/used packages" + , Option "" ["pkg-searchpath"] (ReqArg oPkgdirLocPath "path") "pkg: package search directories, each dir has ///" + , Option "" ["pkg-build"] (ReqArg oPkgBuild "package") "pkg build: build package from files. Implies --compile-only" + , Option "" ["pkg-build-exposed"] (ReqArg oPkgBuildExposedModules "modules") + "pkg build: for package building, exposed modules (blank separated)" + , Option "" ["pkg-build-depends"] (ReqArg oPkgBuildBuildDepends "packages") + "pkg build: for package building, depended on packages (blank separated)" + , Option "" ["cfg-install-root"] (ReqArg oCfgInstallRoot "dir") "cfg: installation root (to be used only by wrapper script)" + , Option "" ["cfg-install-variant"] (ReqArg oCfgInstallVariant "variant") "cfg: installation variant (to be used only by wrapper script)" + , Option "" ["optP"] (ReqArg (oCmdLineOpts Cmd_CPP_Preprocessing) "opt for cmd") + "opt: option for cmd used by compiler, currently only P (preprocessing)" + , Option "" ["pgmP"] (ReqArg (oPgmExec PgmExec_CPP) "alternate program for cmd") + "pgm: alternate executable used by compiler, currently only P (preprocessing)" + , Option "" ["coreopt"] (ReqArg oOptCore "opt[,...]") ("opts (specific) for core: " ++ showStr2stMp coreOptMp) + ] +{-# LINE 476 "src/ehc/Opts.chs" #-} + where oPretty ms o = case ms of + Just "-" -> o { ehcOptShowEH = False } + Just "no" -> o { ehcOptShowEH = False } + Just "off" -> o { ehcOptShowEH = False } + Just "hs" -> o { ehcOptShowHS = True } + Just "eh" -> o { ehcOptShowEH = True } + Just "pp" -> o { ehcOptShowEH = True } + _ -> o + oShowTopTy ms o = case ms of + Just "yes" -> o { ehcOptShowTopTyPP = True } + _ -> o + oHelp o = o { ehcOptImmQuit = Just ImmediateQuitOption_Help } + oVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_Version } + oVariant o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Variant } + oDebug o = o { ehcOptDebug = True + } + oStopAt s o = o { ehcStopAtPoint = + case s of + "0" -> CompilePoint_Imports + "1" -> CompilePoint_Parse + "2" -> CompilePoint_AnalHS + "3" -> CompilePoint_AnalEH + "4" -> CompilePoint_Core + _ -> CompilePoint_All + } + oOptCore s o = o { ehcOptCoreOpts = optOpts coreOptMp s ++ ehcOptCoreOpts o} + oTarget s o = o { ehcOptMbTarget = mbtarget + , ehcOptOptimizationScope = if isJustOk mbtarget && targetDoesHPTAnalysis (fromJustOk mbtarget) + then max oscope (maxBound :: OptimizationScope) + else oscope + } + where mbtarget = maybe (NotOk s) JustOk $ Map.lookup s supportedTargetMp + oscope = ehcOptOptimizationScope o + oTargetFlavor s o = o { ehcOptMbTargetFlavor = maybe (NotOk s) JustOk $ Map.lookup s allTargetFlavorMp } + oOptimizations o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Optimizations } + oTargets o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Targets } + oTargetDflt o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_TargetDefault } + + oCode ms o = case ms of + Just "hs" -> o { ehcOptEmitHS = True } + Just "eh" -> o { ehcOptEmitEH = True } + Just "-" -> o -- { ehcOptEmitCore = False } + Just "core" -> o { ehcOptMbTarget = JustOk Target_None_Core_AsIs + } + Just "tycore"-> o { ehcOptMbTarget = JustOk Target_None_TyCore_None + } + _ -> o + + oVerbose ms o = case ms of + Just "0" -> o { ehcOptVerbosity = VerboseQuiet } + Just "1" -> o { ehcOptVerbosity = VerboseMinimal } + Just "2" -> o { ehcOptVerbosity = VerboseNormal } + Just "3" -> o { ehcOptVerbosity = VerboseALot } + Just "4" -> o { ehcOptVerbosity = VerboseDebug } + Nothing -> o { ehcOptVerbosity = succ (ehcOptVerbosity o)} + _ -> o + oOptimization ms o + = o' {ehcOptOptimizations = optimizeRequiresClosure os} + where (o',doSetOpts) + = case ms of + Just (clevel:',':cscope:_) + | isJust mbO -> (fromJust mbO o, True) + where mbO = mbLevelScope (Just clevel) (Just cscope) + Just (',':cscope:_) + | isJust mbO -> (fromJust mbO o, True) + where mbO = mbLevelScope Nothing (Just cscope) + Just olevel@(clevel:_) + | isDigit clevel && l >= 0 && l < (maxscp * maxlev) + -> ( o { ehcOptOptimizationLevel = toEnum lev, ehcOptOptimizationScope = toEnum sc } + , True + ) + where l = read olevel :: Int + (sc,lev) = quotRem l maxlev + Just scpname@(_:_) + | isJust mbScp + -> ( o { ehcOptOptimizationScope = sc } + , True + ) + where mbScp@(~(Just sc)) = Map.lookup scpname allOptimScopeMp + Just optname@(_:_) + -> case break (== '=') optname of + (nm, yesno) + -> ( o { ehcOptOptimizations = os + , ehcOptOptimizeOptionMp = osmp `Map.union` ehcOptOptimizeOptionMp o + } + , False + ) + where set True opt = Set.insert opt $ ehcOptOptimizations o + set False opt = Set.delete opt $ ehcOptOptimizations o + (os,osmp) + = -- lookup name, and attempt to extract boolean of assumedly '=' prefixed string, or if not a boolean try to extract specific config whilst also assuming True for the boolean + case (Map.lookup nm allOptimizeMp, optArgTake optArgAllAllow $ drop 1 yesno) of + (Just opt, Just (OptArg_Bool b,_ )) -> (set b opt , Map.empty) + (Just opt, Just (OptArg_Int i,_ )) -> (set True opt , optimizeOptionMpSingleton opt optopt v) + where (optopt,optdflt) = allOptimizeOptionMpAnyOption opt + v = maybe optdflt (\(_,(lo,_)) -> toEnum $ fromEnum lo + i) + $ mapLookup2 opt optopt allOptimizeOptionMp + (Just opt, _ ) -> (set True opt , Map.empty) + _ -> (ehcOptOptimizations o , Map.empty) + Nothing + -> (o { ehcOptOptimizationLevel = OptimizationLevel_Much }, True) + _ -> (o, False) + os | doSetOpts = Map.findWithDefault Set.empty (ehcOptOptimizationLevel o') optimizationLevelMp + | otherwise = ehcOptOptimizations o' + maxlev = fromEnum (maxBound :: OptimizationLevel) + 1 + maxscp = fromEnum (maxBound :: OptimizationScope) + 1 + mbLevelScope ml ms + | isJust l && isJust s = Just (\o -> o { ehcOptOptimizationLevel = toEnum (fromJust l), ehcOptOptimizationScope = toEnum (fromJust s) }) + | otherwise = Nothing + where l = r ehcOptOptimizationLevel maxlev ml + s = r ehcOptOptimizationScope maxscp ms + r dflt mx m + | x >= 0 && x < mx = Just x + | otherwise = Nothing + where x = (maybe (fromEnum $ dflt o) (\c -> read [c]) m) :: Int + oNoRecomp o = o { ehcOptCheckRecompile = False } + oCompileOnly o = o { ehcOptLinkingStyle = LinkingStyle_None } + oNoHiCheck o = o { ehcOptHiValidityCheck = False } + oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted } + oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber } + oUsrFileLocPath s o = o { ehcOptImportFileLocPath = ehcOptImportFileLocPath o ++ mkFileLocPath s } + oLibFileLocPath s o = o { ehcOptLibFileLocPath = ehcOptLibFileLocPath o ++ mkFileLocPath s } + oPkgdirLocPath s o = o { ehcOptPkgdirLocPath = ehcOptPkgdirLocPath o ++ mkStringPath s } + oNoPrelude o = o { ehcOptUseAssumePrelude = False } + oCPP o = o { ehcOptCPP = True } + oLimitTyBetaRed o l = o { ehcOptTyBetaRedCutOffAt = l } + oLimitCtxtRed o l = o { ehcOptPrfCutOffAt = l } + oMetaPkgdirSys o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Pkgdir_System } + oMetaPkgdirUser o = o { ehcOptImmQuit = Just ImmediateQuitOption_Meta_Pkgdir_User } + oExposePackage s o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ pkgSearchFilter parsePkgKey PackageSearchFilter_ExposePkg [s] + -- , ehcOptLibPackages = ehcOptLibPackages o ++ [s] + } + oHidePackage s o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ pkgSearchFilter parsePkgKey PackageSearchFilter_HidePkg [s] + } + oHideAllPackages o = o { ehcOptPackageSearchFilter = ehcOptPackageSearchFilter o ++ [PackageSearchFilter_HideAll] + -- , ehcOptHideAllPackages = True + } + oOutputDir s o = o { ehcOptOutputDir = Just s + -- no linking when no output file is generated. This is not failsafe, requires better solution as now no executable is generated when no --output is specified. Should depend on existence of main. + -- , ehcOptDoExecLinking = isJust (ehcOptMbOutputFile o) + } + oOutputFile s o = o { ehcOptMbOutputFile = Just (mkFPath s) + , ehcOptLinkingStyle = LinkingStyle_Exec + } + oKeepIntermediateFiles o = o { ehcOptKeepIntermediateFiles = True } + oPkgBuild s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptName=s}) + , ehcOptLinkingStyle = LinkingStyle_Pkg + } + oPkgBuildExposedModules + s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptExposedModules = words s}) + } + oPkgBuildBuildDepends + s o = o { ehcOptPkgOpt = Just ((maybe emptyPkgOption id $ ehcOptPkgOpt o) {pkgoptBuildDepends = words s}) + } + oCfgInstallRoot s o = o { ehcOptCfgInstallRoot = Just s } + oCfgInstallVariant s o = o { ehcOptCfgInstallVariant = Just s } + oCmdLineOpts cmd s o = o { ehcOptCmdLineOpts = -- (\v -> tr "XX" (pp s >#< show v) v) $ + nub $ ehcOptCmdLineOpts o ++ fst (parseCmdLineOpts cmd s) } + oPgmExec cmd s o = o { ehcOptPgmExecMp = Map.insert cmd s $ ehcOptPgmExecMp o } + +{-# LINE 773 "src/ehc/Opts.chs" #-} +intArg tr = ReqArg (optInt tr) "" + +optInt :: (EHCOpts -> Int -> EHCOpts) -> String -> EHCOpts -> EHCOpts +optInt tr s o + = tr o $ read s + +{-# LINE 781 "src/ehc/Opts.chs" #-} +-- | What kind of optional args are allowed +data OptArgAllow + = OptArgAllow_Bool + | OptArgAllow_Int + deriving (Eq,Enum,Bounded) + +optArgAllAllow :: [OptArgAllow] +optArgAllAllow = [minBound .. maxBound] + +{-# LINE 792 "src/ehc/Opts.chs" #-} +-- | An optional arg, universal type for all occurring variants +data OptArg + = OptArg_Bool Bool + | OptArg_Int Int + +{-# LINE 799 "src/ehc/Opts.chs" #-} +optArgTake :: [OptArgAllow] -> String -> Maybe (OptArg,String) +optArgTake allow s + = case s of + ('-':r) -> Just (OptArg_Bool False,r) + ('n':'o':r) -> Just (OptArg_Bool False,r) + ('n':r) -> Just (OptArg_Bool False,r) + ('o':'f':'f':r) -> Just (OptArg_Bool False,r) + ('0':r) | noInt -> Just (OptArg_Bool False,r) + ('+':r) -> Just (OptArg_Bool True ,r) + ('y':'e':'s':r) -> Just (OptArg_Bool True ,r) + ('y':r) -> Just (OptArg_Bool True ,r) + ('o':'n':r) -> Just (OptArg_Bool True ,r) + ('1':r) | noInt -> Just (OptArg_Bool True ,r) + ( c :_) | yesInt && isDigit c + -> Just (OptArg_Int (read d) ,r) + where (d,r) = span isDigit s + _ -> Nothing + where yesInt = OptArgAllow_Int `elem` allow + noInt = not yesInt + +{-# LINE 821 "src/ehc/Opts.chs" #-} +optBooleanTake :: String -> Maybe (Bool,String) +optBooleanTake s + = case optArgTake [OptArgAllow_Bool] s of + Just (OptArg_Bool b, r) -> Just (b,r) + _ -> Nothing + +optBoolean :: (EHCOpts -> Bool -> EHCOpts) -> Maybe String -> EHCOpts -> EHCOpts +optBoolean tr ms o + = case ms of + Just s -> maybe o (tr o . fst) (optBooleanTake s) + _ -> o + +boolArgStr = "Bool" +boolArg tr = OptArg (optBoolean tr) boolArgStr + +{-# LINE 842 "src/ehc/Opts.chs" #-} +oPriv o b = o { ehcOptPriv = b } + +{-# LINE 846 "src/ehc/Opts.chs" #-} +optDumpCoreStages o b = o { ehcOptDumpCoreStages = b } + +{-# LINE 854 "src/ehc/Opts.chs" #-} +oSetGenTrampoline o b = o { ehcOptGenTrampoline_ = b } + +{-# LINE 874 "src/ehc/Opts.chs" #-} +oStopAtCoreError o b = o { ehcDebugStopAtCoreError = b } + +{-# LINE 878 "src/ehc/Opts.chs" #-} +oStopAtHIError o b = o { ehcDebugStopAtHIError = b } + +{-# LINE 886 "src/ehc/Opts.chs" #-} +-- | Apply the cmdline opts description to a EHCOpts, returning Nothing when there were no options +ehcCmdLineOptsApply :: [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) +ehcCmdLineOptsApply postopts args opts + = (if null o' then Nothing else Just (foldl (flip ($)) opts o'),n,errs) + where oo@(o,n,errs) = getOpt Permute ehcCmdLineOpts args + o' = o ++ postopts + +{-# LINE 899 "src/ehc/Opts.chs" #-} +optsDiscrRecompileRepr :: EHCOpts -> String +optsDiscrRecompileRepr opts + = concat + $ intersperse " " + $ [ show (ehcOptAspects opts) + , o "clsrec" (ehcCfgClassViaRec opts) + -- , o "exec" (ehcOptEmitExecC opts) + -- , o "bexec" (ehcOptEmitExecBytecode opts) + , show (ehcOptTarget opts) + , show (ehcOptOptimizationLevel opts) + ] + where o m v = if v then m else "" + +{-# LINE 920 "src/ehc/Opts.chs" #-} +data FIOBind + = FIOBindYes | FIOBindNoBut TyVarIdS + deriving (Show) + +{-# LINE 926 "src/ehc/Opts.chs" #-} +data FIOpts = FIOpts { fioLeaveRInst :: !Bool , fioBindRFirst :: !Bool + , fioBindLFirst :: !Bool , fioBindLBeforeR :: !Bool + , fioMode :: !FIMode , fioUniq :: !UID + , fioBindCategs :: ![TyVarCateg] + , fioNoRLabElimFor :: ![HsName] , fioNoLLabElimFor :: ![HsName] + , fioDontBind :: !TyVarIdS + , fioExpandEqTyVar :: !Bool -- expand tyvars also when equal. Required for Sys F translation. + , fioPredAsTy :: !Bool , fioAllowRPredElim :: !Bool + , fioBindLVars :: !FIOBind , fioBindRVars :: !FIOBind + , fiMbMkErrClash :: Maybe (Ty -> Ty -> Err) -- alternate error construction for type clash + } + +{-# LINE 960 "src/ehc/Opts.chs" #-} +fioBindNoSet :: FIOBind -> TyVarIdS +fioBindNoSet (FIOBindNoBut s) = s +fioBindNoSet _ = Set.empty + +fioBindIsYes :: FIOBind -> Bool +fioBindIsYes FIOBindYes = True +fioBindIsYes _ = False + +{-# LINE 970 "src/ehc/Opts.chs" #-} +strongFIOpts :: FIOpts +strongFIOpts = FIOpts { fioLeaveRInst = False , fioBindRFirst = True + , fioBindLFirst = True , fioBindLBeforeR = True + , fioMode = FitSubLR , fioUniq = uidStart + , fioBindCategs = [TyVarCateg_Plain] + , fioNoRLabElimFor = [] , fioNoLLabElimFor = [] + , fioDontBind = Set.empty + , fioExpandEqTyVar = False + , fioPredAsTy = False , fioAllowRPredElim = True + , fioBindLVars = FIOBindYes , fioBindRVars = FIOBindYes + , fiMbMkErrClash = Nothing + } + +{-# LINE 1000 "src/ehc/Opts.chs" #-} +instance Show FIOpts where + show o = "FIOpts" + +{-# LINE 1005 "src/ehc/Opts.chs" #-} +instance PP FIOpts where + pp o = "FIOpts{" + >#< "leaveRInst=" >|< pp (fioLeaveRInst o) + >#< "bindLFirst=" >|< pp (fioBindLFirst o) + >#< "bindRFirst=" >|< pp (fioBindRFirst o) + >#< "fioNoLLabElimFor=" >|< pp (show $ fioNoLLabElimFor o) + >#< "fioNoRLabElimFor=" >|< pp (show $ fioNoRLabElimFor o) + >#< "allowRPredElim=" >|< pp (fioAllowRPredElim o) + >#< "}" + +{-# LINE 1021 "src/ehc/Opts.chs" #-} +instLFIOpts :: FIOpts +instLFIOpts = strongFIOpts {fioBindRFirst = False} + +{-# LINE 1026 "src/ehc/Opts.chs" #-} +instLRFIOpts :: FIOpts +instLRFIOpts = strongFIOpts {fioBindRFirst = False, fioBindLFirst = False} + +{-# LINE 1031 "src/ehc/Opts.chs" #-} +unifyFIOpts :: FIOpts +unifyFIOpts = strongFIOpts {fioMode = FitUnify} + +instFIOpts :: FIOpts +instFIOpts = instLFIOpts {fioLeaveRInst = True, fioBindLFirst = False} + +{-# LINE 1050 "src/ehc/Opts.chs" #-} +weakFIOpts :: FIOpts +weakFIOpts = fioMkWeak strongFIOpts + +{-# LINE 1055 "src/ehc/Opts.chs" #-} +predFIOpts :: FIOpts +predFIOpts = strongFIOpts {fioPredAsTy = True, fioLeaveRInst = True} + +implFIOpts :: FIOpts +implFIOpts = strongFIOpts {fioAllowRPredElim = False} + +{-# LINE 1063 "src/ehc/Opts.chs" #-} +fioSwapOpts :: FIOpts -> FIOpts +fioSwapOpts fio + = fio + { fioBindRFirst = fioBindLFirst fio + , fioBindLFirst = fioBindRFirst fio + , fioBindLBeforeR = not (fioBindLBeforeR fio) + , fioBindLVars = fioBindRVars fio + , fioBindRVars = fioBindLVars fio + } + +fioSwapPolarity :: Polarity -> FIOpts -> FIOpts +fioSwapPolarity pol fio = fio {fioMode = fimSwapPol pol (fioMode fio)} + +{-# LINE 1080 "src/ehc/Opts.chs" #-} +fioMkStrong :: FIOpts -> FIOpts +fioMkStrong fi = fi {fioLeaveRInst = False, fioBindRFirst = True, fioBindLFirst = True} + +{-# LINE 1085 "src/ehc/Opts.chs" #-} +fioMkWeak :: FIOpts -> FIOpts +fioMkWeak fi = fi {fioLeaveRInst = True, fioBindRFirst = False} + +{-# LINE 1090 "src/ehc/Opts.chs" #-} +-- | Adapt options for extracting final ty +fioMkFinal :: FIOpts -> FIOpts +fioMkFinal fi = fi {fioBindLFirst = False, fioBindRFirst = False, fioExpandEqTyVar = True} + +{-# LINE 1096 "src/ehc/Opts.chs" #-} +fioMkUnify :: FIOpts -> FIOpts +fioMkUnify fi = fi {fioMode = FitUnify} + +{-# LINE 1105 "src/ehc/Opts.chs" #-} +fioIsSubsume :: FIOpts -> Bool +fioIsSubsume fio = case fioMode fio of {FitSubLR -> True ; _ -> False} + diff --git a/src/UHC/Light/Compiler/Opts/Base.hs b/src/UHC/Light/Compiler/Opts/Base.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Opts/Base.hs @@ -0,0 +1,342 @@ +module UHC.Light.Compiler.Opts.Base +( ImmediateQuitOption (..) +, EHCOpts (..) +, emptyEHCOpts +, ehcOptFromJust +, InOrOutputFor (..) +, CoreOpt (..) +, ehcOptTarget, ehcOptTargetFlavor +, ehcOptCoreSysF, ehcOptCoreSysFCheck, ehcOptCoreSysFGen, ehcOptCoreSysFCheckOnlyVal +, ehcOptEmitExecBytecode, ehcOptEmitBytecode +, ehcOptCmmCheck +, ehcOptIsViaGrinCmmJavaScript, ehcOptIsViaCoreJavaScript +, ehcOptIsViaCmm +, ehcOptIsViaGrin +, ehcOptBuiltin, ehcOptBuiltin2 +, ehcOptDoExecLinking +, PkgOption (..), emptyPkgOption +, PgmExec (..) +, ExecOpt (..), execOptsPlain ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Util.Utils +import Data.Maybe +import qualified Data.Map as Map +import UHC.Util.Pretty +import qualified Data.Set as Set +import Data.List +import Data.Char +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Util.FPath +import UHC.Light.Compiler.EHC.Environment +import UHC.Light.Compiler.Base.Target +import UHC.Light.Compiler.Base.Optimize +import UHC.Light.Compiler.Base.FileSearchLocation +import qualified UHC.Light.Compiler.ConfigInstall as Cfg +import UHC.Light.Compiler.Base.Pragma +import UHC.Light.Compiler.Opts.CommandLine + + + + + + +{-# LINE 55 "src/ehc/Opts/Base.chs" #-} +data ImmediateQuitOption + = ImmediateQuitOption_Help -- print help + | ImmediateQuitOption_Version -- print version info + | ImmediateQuitOption_Meta_Variant -- print variant number + | ImmediateQuitOption_Meta_Targets -- print all codegeneration targets (empty if no codegen) + | ImmediateQuitOption_Meta_TargetDefault -- print the default codegeneration target (dummy if no codegen) + | ImmediateQuitOption_Meta_Optimizations -- print all optimizations + | ImmediateQuitOption_Meta_Pkgdir_System -- print system package dir + | ImmediateQuitOption_Meta_Pkgdir_User -- print user package dir + | ImmediateQuitOption_VersionDotted -- print version in dotted style, for external version comparison + | ImmediateQuitOption_VersionAsNumber -- print version as number, for external version comparison + -- -| ImmediateQuitOption_Meta_ExportEnv (Maybe String) -- export (write) environmental info of installation + -- -| ImmediateQuitOption_Meta_DirEnv -- print dir of environmental info of installation + +{-# LINE 79 "src/ehc/Opts/Base.chs" #-} +data InOrOutputFor + = OutputFor_Module + | OutputFor_Pkg + | InputFrom_Loc FileLoc + +{-# LINE 92 "src/ehc/Opts/Base.chs" #-} +-- | Build pkg options, all (except obligatory name) wrapped in Maybe/[] because of possible absence. +-- 20140829 AD: will be used to construct config file +data PkgOption + = PkgOption + { pkgoptName :: PkgName -- ^ build a package with name + , pkgoptExposedModules :: [String] -- ^ 20140829 AD not yet used: exposed modules + , pkgoptBuildDepends :: [PkgName] -- ^ 20140829 AD not yet used: depends on pkgs + } + +emptyPkgOption :: PkgOption +emptyPkgOption = PkgOption emptyPkgName [] [] + +{-# LINE 110 "src/ehc/Opts/Base.chs" #-} +-- | Core options +data CoreOpt + = CoreOpt_NONE -- no-op option +-- | CoreOpt_PPParseable -- pretty print parseable, negation means just make it readable + | CoreOpt_Dump -- dump textual core output + | CoreOpt_DumpBinary -- dump binary core output + | CoreOpt_DumpAlsoNonParseable-- dump also the parts which are not parseable + | CoreOpt_Run -- run after compilation + | CoreOpt_RunDump -- dump CoreRun + | CoreOpt_RunTrace -- trace during running CoreRun + | CoreOpt_RunPPNames -- when dump/run CoreRun print names instead of + deriving (Eq,Enum,Bounded) + +{-# LINE 170 "src/ehc/Opts/Base.chs" #-} +-- | Pgm (internal program used) options, in particular alternate internal shell commands +data PgmExec + = PgmExec_CPP -- alternate CPP + | PgmExec_C -- alternate C compiler + | PgmExec_Linker -- alternate linker + deriving (Eq,Ord,Enum,Bounded) + +{-# LINE 179 "src/ehc/Opts/Base.chs" #-} +-- | Wrapper around options, adding semantics for adapting cmd specific behavior +data ExecOpt + = ExecOpt_Plain String -- ^ plain option + | ExecOpt_Output (String -> String) -- ^ output file + +execOptsPlain :: [ExecOpt] -> [String] +execOptsPlain o = [ s | ExecOpt_Plain s <- o ] + +{-# LINE 195 "src/ehc/Opts/Base.chs" #-} +data EHCOpts + = EHCOpts + { ehcOptTrace :: forall a . String -> a -> a -- tracing + , ehcOptAspects :: String -- which aspects are included in this compiler + , ehcOptShowHS :: Bool -- show HS pretty print on stdout + , ehcOptShowEH :: Bool -- show EH pretty print on stdout + , ehcOptPriv :: Bool -- privately used (in general during switch between 2 impls of 1 feature) + , ehcOptHsChecksInEH :: Bool -- do checks in EH which already have been done in HS (usually related to name absence/duplication). This is used for EH compilation only. + , ehcOptShowTopTyPP :: Bool -- show EH type of expression + , ehcOptImmQuit :: Maybe ImmediateQuitOption + , ehcOptDebug :: Bool -- debug info + , ehcStopAtPoint :: CompilePoint -- stop at (after) compile phase + , ehcOptPolyKinds :: Bool -- allow kind polymorphism + , ehcOptExtensibleRecords + :: Bool + , ehcOptMbTarget :: MaybeOk Target -- code generation target + , ehcOptMbTargetFlavor :: MaybeOk TargetFlavor -- code generation target flavor + , ehcOptBangPatterns :: Bool -- allow bang patterns + , ehcOptOptimizationLevel + :: OptimizationLevel -- optimisation level + , ehcOptOptimizationScope + :: OptimizationScope -- optimisation scope + , ehcOptOptimizations :: OptimizeS -- individual optimizations to be done, derived from level + scope + , ehcOptOptimizeOptionMp + :: OptimizeOptionMp -- optimization specific configuration + , ehcOptDumpCoreStages :: Bool -- dump intermediate Core transformation stages + , ehcOptCoreOpts :: [CoreOpt] -- Core options + , ehcOptGenTrampoline_ :: Bool -- gen trampoline with (tail) calls + , ehcOptGenTrace :: Bool + , ehcOptEmitHS :: Bool + , ehcOptEmitEH :: Bool + , ehcOptImportFileLocPath + :: FileLocPath + , ehcOptVerbosity :: Verbosity -- verbosity level + + , ehcOptBuiltinNames :: EHBuiltinNames + , ehcOptEnvironment :: EHCEnvironment -- runtime environment + + , ehcCfgInstFldHaveSelf:: Bool -- functions/fields of instance get as arg the dictionary as well + , ehcOptPrfCutOffAt :: Int -- cut off limit for context reduction + , ehcCfgClassViaRec :: Bool -- instance representation via record instead of data + -- , ehcCfgCHRScoped :: CHRScoped -- how to gen scoped CHR's (option is used only for paper writing + experimenting) + , ehcOptTyBetaRedCutOffAt -- cut off for type lambda expansion + :: Int + , ehcDebugStopAtCoreError + :: Bool -- stop when Core parse error occurs (otherwise errors are ignored, repaired .core is used) + , ehcOptCheckRecompile :: Bool + , ehcDebugStopAtHIError:: Bool -- stop when HI parse error occurs (otherwise it is ignored, .hi thrown away) + -- , ehcOptDoExecLinking :: Bool -- do link, if False compile only + , ehcOptLinkingStyle :: LinkingStyle -- how to link, possibly no linking (e.g. when compile only) + , ehcOptGenGenerics :: Bool -- generate for use of generics + , ehcOptFusion :: Bool -- allow fusion syntax, the optimization itself is triggered by optimize flags + , ehcOptHiValidityCheck:: Bool -- when .hi and compiler are out of sync w.r.t. timestamp and checksum, recompile + , ehcOptLibFileLocPath :: FileLocPath + , ehcOptPkgdirLocPath :: StringPath + , ehcOptPkgDb :: PackageDatabase -- package database to be used for searching packages + , ehcProgName :: FPath -- name of this program + , ehcCurDir :: String -- current dir (not an option, but set initially) + , ehcOptUserDir :: String -- user dir for storing user specific stuff + , ehcOptMbOutputFile :: Maybe FPath -- in which file to put generated output/executable + , ehcOptCPP :: Bool -- do preprocess with C preprecessor CPP + , ehcOptUseAssumePrelude -- use & assume presence of prelude + :: Bool + , ehcOptPackageSearchFilter + :: [PackageSearchFilter] -- description of what to expose from package database + , ehcOptOutputDir :: Maybe String -- where to put output, instead of same dir as input file + , ehcOptKeepIntermediateFiles + :: Bool -- keep intermediate files + , ehcOptPkgOpt :: Maybe PkgOption -- package building (etc) option + , ehcOptCfgInstallRoot :: Maybe String -- the directory where the installation resides; overrides ehcenvInstallRoot + , ehcOptCfgInstallVariant :: Maybe String -- the installation variant; overrides ehcenvVariant + , ehcOptCmdLineOpts :: CmdLineOpts -- options from the commandline and pragma for such options + , ehcOptCmdLineOptsDoneViaPragma + :: Bool -- options via OPTIONS_UHC pragma have been set + , ehcOptOverloadedStrings + :: Bool -- allow overloaded strings + , ehcOptPgmExecMp :: Map.Map PgmExec FilePath + -- alternate executables for program + , ehcOptExecOptsMp :: Map.Map FilePath [ExecOpt] + -- default options for commands + } + +{-# LINE 359 "src/ehc/Opts/Base.chs" #-} +emptyEHCOpts + = EHCOpts + { ehcOptTrace = \_ x -> x + , ehcOptAspects = "base codegen core corebackend corein coreout corerun hmtyinfer noHmTyRuler" + , ehcOptShowHS = False + , ehcOptPriv = False + , ehcOptHsChecksInEH = False + , ehcOptShowEH = False + , ehcOptShowTopTyPP = False + , ehcOptImmQuit = Nothing + , ehcOptDebug = False + , ehcStopAtPoint = CompilePoint_All + , ehcOptPolyKinds = False + , ehcOptExtensibleRecords= False + , ehcOptMbTarget = JustOk defaultTarget + , ehcOptMbTargetFlavor = JustOk defaultTargetFlavor + , ehcOptBangPatterns = True + , ehcOptOptimizationLevel= OptimizationLevel_Normal + , ehcOptOptimizationScope= OptimizationScope_PerModule + , ehcOptDumpCoreStages = False + , ehcOptOptimizations = optimizeRequiresClosure $ Map.findWithDefault Set.empty OptimizationLevel_Normal optimizationLevelMp + , ehcOptOptimizeOptionMp = Map.empty + , ehcOptCoreOpts = [] + , ehcOptGenTrampoline_ = False + , ehcOptGenTrace = False + , ehcOptVerbosity = VerboseMinimal + , ehcOptEmitHS = False + , ehcOptEmitEH = False + + , ehcOptImportFileLocPath= [] + , ehcOptBuiltinNames = mkEHBuiltinNames (const id) + , ehcOptEnvironment = undefined -- filled in at toplevel + + , ehcCfgInstFldHaveSelf = False + , ehcOptPrfCutOffAt = 20 + , ehcCfgClassViaRec = False -- True + -- , ehcCfgCHRScoped = CHRScopedAll + , ehcOptTyBetaRedCutOffAt + = 10 + , ehcDebugStopAtCoreError= False + , ehcOptCheckRecompile = True + , ehcDebugStopAtHIError = False + -- , ehcOptDoExecLinking = True + , ehcOptLinkingStyle = LinkingStyle_Exec -- how to link, possibly no linking (e.g. when compile only) + , ehcOptGenGenerics = True + , ehcOptFusion = False + , ehcOptHiValidityCheck = True + , ehcOptLibFileLocPath = [] + , ehcOptPkgdirLocPath = [] + , ehcOptPkgDb = emptyPackageDatabase + , ehcProgName = emptyFPath + , ehcCurDir = "" + , ehcOptUserDir = "" + , ehcOptMbOutputFile = Nothing + , ehcOptCPP = False + , ehcOptUseAssumePrelude = True + , ehcOptPackageSearchFilter + = [] -- pkgSearchFilter parsePkgKey PackageSearchFilter_ExposePkg Cfg.ehcAssumedPackages + , ehcOptOutputDir = Nothing + , ehcOptKeepIntermediateFiles + = False + , ehcOptPkgOpt = Nothing + , ehcOptCfgInstallRoot = Nothing + , ehcOptCfgInstallVariant= Nothing + , ehcOptCmdLineOpts = [] + , ehcOptCmdLineOptsDoneViaPragma + = False + , ehcOptOverloadedStrings= False + , ehcOptPgmExecMp = Map.empty + , ehcOptExecOptsMp = Map.empty + } + +{-# LINE 530 "src/ehc/Opts/Base.chs" #-} +ehcOptTarget :: EHCOpts -> Target +ehcOptTarget = maybeOk (\s -> panic ("ehcOptTarget: " ++ s)) id . ehcOptMbTarget + +ehcOptTargetFlavor :: EHCOpts -> TargetFlavor +ehcOptTargetFlavor = maybeOk (\s -> panic ("ehcOptTargetFlavor: " ++ s)) id . ehcOptMbTargetFlavor + +{-# LINE 538 "src/ehc/Opts/Base.chs" #-} +-- | Generate system F (20120421 AD: very much under construction) +ehcOptCoreSysF :: EHCOpts -> Bool +ehcOptCoreSysF _ = False + +-- | Typecheck system F (20120421 AD: very much under construction) +ehcOptCoreSysFCheck :: EHCOpts -> Bool +ehcOptCoreSysFCheck _ = False + +-- | Typecheck system F (20120421 AD: very much under construction) +ehcOptCoreSysFGen :: EHCOpts -> Bool +ehcOptCoreSysFGen opts = ehcOptCoreSysF opts + +-- | Typecheck system F (20120421 AD: very much under construction) +ehcOptCoreSysFCheckOnlyVal :: EHCOpts -> Bool +ehcOptCoreSysFCheckOnlyVal opts = ehcOptCoreSysFCheck opts + +{-# LINE 572 "src/ehc/Opts/Base.chs" #-} +-- generate bytecode +ehcOptEmitExecBytecode :: EHCOpts -> Bool +ehcOptEmitExecBytecode _ = False + +ehcOptEmitBytecode :: EHCOpts -> Bool +ehcOptEmitBytecode _ = False + +{-# LINE 629 "src/ehc/Opts/Base.chs" #-} +-- | Check Cmm +ehcOptCmmCheck :: EHCOpts -> Bool +ehcOptCmmCheck _ = False + +{-# LINE 639 "src/ehc/Opts/Base.chs" #-} +-- | Via Core -> Grin -> CMM -> JS ? +ehcOptIsViaGrinCmmJavaScript :: EHCOpts -> Bool +ehcOptIsViaGrinCmmJavaScript opts + = False + +-- | Via Core -> JS ? +ehcOptIsViaCoreJavaScript :: EHCOpts -> Bool +ehcOptIsViaCoreJavaScript opts + = targetIsViaCoreJavaScript t + where t = ehcOptTarget opts + +{-# LINE 660 "src/ehc/Opts/Base.chs" #-} +ehcOptIsViaCmm :: EHCOpts -> Bool +ehcOptIsViaCmm opts = ehcOptIsViaGrinCmmJavaScript opts +{-# INLINE ehcOptIsViaCmm #-} + +{-# LINE 666 "src/ehc/Opts/Base.chs" #-} +ehcOptIsViaGrin :: EHCOpts -> Bool +ehcOptIsViaGrin opts = ehcOptIsViaGrinCmmJavaScript opts || targetIsGrinBytecode t || targetDoesHPTAnalysis t + where t = ehcOptTarget opts + +{-# LINE 676 "src/ehc/Opts/Base.chs" #-} +ehcOptBuiltin :: EHCOpts -> (EHBuiltinNames -> x) -> x +ehcOptBuiltin o f = f $ ehcOptBuiltinNames o + +ehcOptBuiltin2 :: EHCOpts -> (EHBuiltinNames -> Int -> HsName) -> Int -> HsName +ehcOptBuiltin2 o f i = f (ehcOptBuiltinNames o) i + +{-# LINE 688 "src/ehc/Opts/Base.chs" #-} +-- | Either fromJust with a possible panic, or with a default value (when debugging) +ehcOptFromJust :: EHCOpts -> String -> a -> Maybe a -> a +ehcOptFromJust opts panicMsg n m + | ehcOptDebug opts = maybe n id m + | otherwise = panicJust panicMsg m + +{-# LINE 700 "src/ehc/Opts/Base.chs" #-} +-- | Do linking into executable? +ehcOptDoExecLinking :: EHCOpts -> Bool +ehcOptDoExecLinking opts = ehcOptLinkingStyle opts == LinkingStyle_Exec + diff --git a/src/UHC/Light/Compiler/Opts/CommandLine.hs b/src/UHC/Light/Compiler/Opts/CommandLine.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Opts/CommandLine.hs @@ -0,0 +1,121 @@ +module UHC.Light.Compiler.Opts.CommandLine +( CmdFlag (..), Cmd (..), CmdLineOpt (..), CmdLineOpts +, cppOpt, cppOptF, cppOptI, cppArg +, gccOpt, gccArg, gccOptF, gccOptOutput, gccOptLib +, showCmdLineOpts, showCmdLineOpts' +, parseCmdLineOpts ) +where +import Data.List +import Data.Typeable +import Data.Generics (Data) +import UHC.Util.Binary +import UHC.Util.Serialize +import Control.Monad + + +{-# LINE 26 "src/ehc/Opts/CommandLine.chs" #-} +data CmdFlag + = CmdFlag_Define String (Maybe String) + | CmdFlag_Undefine String + | CmdFlag_Flag String + | CmdFlag_KeyEqualsVal String String + | CmdFlag_KeyWithVal String String + | CmdFlag_IncludeDir String + | CmdFlag_Lib String + + -- (plain) args + | CmdFlag_Arg String + + -- modifiers + | CmdFlag_ModfMin CmdFlag -- double '-' + deriving (Eq,Typeable,Data) + +data Cmd + = Cmd_CPP_Preprocessing + | Cmd_CPP + | Cmd_C + deriving (Eq,Ord,Enum,Bounded,Typeable,Data) + +data CmdLineOpt + = CmdLineOpt + { cloptForCmd :: Cmd + , cloptFlag :: CmdFlag + } + deriving (Eq,Typeable,Data) + +type CmdLineOpts = [CmdLineOpt] + +{-# LINE 63 "src/ehc/Opts/CommandLine.chs" #-} +cppOpt :: CmdFlag -> CmdLineOpt +cppOpt = CmdLineOpt Cmd_CPP + +cppArg :: String -> CmdLineOpt +cppArg = cppOpt . CmdFlag_Arg + +cppOptF :: String -> CmdLineOpt +cppOptF = cppOpt . CmdFlag_Flag + +cppOptI :: String -> CmdLineOpt +cppOptI = cppOpt . CmdFlag_IncludeDir + +{-# LINE 77 "src/ehc/Opts/CommandLine.chs" #-} +gccOpt :: CmdFlag -> CmdLineOpt +gccOpt = CmdLineOpt Cmd_C + +gccArg :: String -> CmdLineOpt +gccArg = gccOpt . CmdFlag_Arg + +gccOptF :: String -> CmdLineOpt +gccOptF = gccOpt . CmdFlag_Flag + +gccOptOutput :: String -> CmdLineOpt +gccOptOutput = gccOpt . CmdFlag_KeyWithVal "o" + +gccOptLib :: String -> CmdLineOpt +gccOptLib = gccOpt . CmdFlag_Lib + +{-# LINE 98 "src/ehc/Opts/CommandLine.chs" #-} +showCmdLineOpts' :: [Cmd] -> CmdLineOpts -> [String] +showCmdLineOpts' forCmds opts = map show $ filter (\o -> cloptForCmd o `elem` forCmds) opts + +showCmdLineOpts :: CmdLineOpts -> String +showCmdLineOpts = concat . intersperse " " . showCmdLineOpts' [minBound::Cmd .. maxBound] + +-- | Show key + value +kv :: String -> String -> Maybe String -> String +kv k sep mv = k ++ maybe "" (\v -> sep ++ v) mv + +instance Show CmdFlag where + show (CmdFlag_Define k mv) = "-D" ++ kv k "=" mv + show (CmdFlag_Undefine k ) = "-U" ++ k + show (CmdFlag_Flag f ) = "-" ++ f + show (CmdFlag_KeyEqualsVal k v) = "-" ++ kv k "=" (Just v) + show (CmdFlag_KeyWithVal k v) = "-" ++ kv k " " (Just v) + show (CmdFlag_IncludeDir d ) = "-I" ++ d + show (CmdFlag_Lib l ) = "-l" ++ l + show (CmdFlag_Arg a ) = a + show (CmdFlag_ModfMin f ) = "-" ++ show f + +instance Show CmdLineOpt where + show = show . cloptFlag + +{-# LINE 128 "src/ehc/Opts/CommandLine.chs" #-} +-- | Parse commandline options into CmdLineOpts +parseCmdLineOpts :: Cmd -> String -> (CmdLineOpts,[String]) +parseCmdLineOpts cmd s + = ([ CmdLineOpt cmd $ pOpt o | ('-':o) <- opts ],rest) + where (opts,rest) = partition isOpt $ words s + isOpt ('-':_) = True + isOpt _ = False + pOpt ('-':opt) = CmdFlag_ModfMin $ pOpt opt + pOpt ('D':def) = uncurry CmdFlag_Define $ pDef def + pOpt ('I':dir) = CmdFlag_IncludeDir dir + pOpt ('l':lib) = CmdFlag_Lib lib + pOpt s = case pDef s of + (k, Just v) -> CmdFlag_KeyEqualsVal k v + (k, _ ) -> CmdFlag_Flag k + pDef s = + case break (== '=') s of + (k,'=':v) -> (k, Just v) + _ -> (s, Nothing) + diff --git a/src/UHC/Light/Compiler/Pred.hs b/src/UHC/Light/Compiler/Pred.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred.hs @@ -0,0 +1,18 @@ +module UHC.Light.Compiler.Pred +( ClsFuncDep (..) ) +where +import UHC.Util.Pretty +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize +{-# LINE 11 "src/ehc/Pred.chs" #-} +-- Force generation of module header + + + +{-# LINE 49 "src/ehc/Pred.chs" #-} +data ClsFuncDep = ClsFuncDep [Int] [Int] deriving Show + +instance PP ClsFuncDep where + pp (ClsFuncDep f t) = ppBracketsCommas f >|< "->" >|< ppBracketsCommas t + diff --git a/src/UHC/Light/Compiler/Pred/CHR.hs b/src/UHC/Light/Compiler/Pred/CHR.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/CHR.hs @@ -0,0 +1,252 @@ +module UHC.Light.Compiler.Pred.CHR +( module UHC.Light.Compiler.Pred.CommonCHR +, Guard (..) +, PartialOrdering (..), toOrdering, toPartialOrdering +, isLetProveCandidate, isLetProveFailure ) +where +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.CommonCHR +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import UHC.Util.Pretty +import UHC.Util.AGraph +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.FitsIn +import UHC.Light.Compiler.Ty.TreeTrieKey +import UHC.Light.Compiler.Base.HsName.Builtin +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + +{-# LINE 42 "src/ehc/Pred/CHR.chs" #-} +data Guard + = HasStrictCommonScope PredScope PredScope PredScope -- have strict/proper common scope? + | IsVisibleInScope PredScope PredScope -- is visible in 2nd scope? + | NotEqualScope PredScope PredScope -- scopes are unequal + | EqualScope PredScope PredScope -- scopes are equal + | IsStrictParentScope PredScope PredScope PredScope -- parent scope of each other? + | NonEmptyRowLacksLabel Ty LabelOffset Ty Label -- non empty row does not have label?, yielding its position + rest + deriving (Typeable, Data) + +{-# LINE 63 "src/ehc/Pred/CHR.chs" #-} +ppGuard :: Guard -> PP_Doc +ppGuard (HasStrictCommonScope sc1 sc2 sc3) = ppParensCommas' [sc1 >#< "<" >#< sc2,sc1 >#< "<=" >#< sc3] +ppGuard (IsStrictParentScope sc1 sc2 sc3) = ppParens (sc1 >#< "==" >#< sc2 >#< "/\\" >#< sc2 >#< "/=" >#< sc3) +ppGuard (IsVisibleInScope sc1 sc2 ) = sc1 >#< "`visibleIn`" >#< sc2 +ppGuard (NotEqualScope sc1 sc2 ) = sc1 >#< "/=" >#< sc2 +ppGuard (EqualScope sc1 sc2 ) = sc1 >#< "==" >#< sc2 +ppGuard (NonEmptyRowLacksLabel r o t l ) = ppParens (t >#< "==" >#< ppParens (r >#< "| ...")) >#< "\\" >#< l >|< "@" >|< o + +{-# LINE 82 "src/ehc/Pred/CHR.chs" #-} +instance Show Guard where + show _ = "CHR Guard" + +instance PP Guard where + pp = ppGuard + +{-# LINE 94 "src/ehc/Pred/CHR.chs" #-} +instance VarExtractable CHRPredOccCnstrMp TyVarId where + varFreeSet x = Set.unions [ varFreeSet k | k <- Map.keys x ] + +instance VarUpdatable CHRPredOccCnstrMp VarMp where + varUpd s x = Map.mapKeysWith (++) (varUpd s) x + +instance VarExtractable Guard TyVarId where + varFreeSet (HasStrictCommonScope p1 p2 p3) = Set.unions $ map varFreeSet [p1,p2,p3] + varFreeSet (IsStrictParentScope p1 p2 p3) = Set.unions $ map varFreeSet [p1,p2,p3] + varFreeSet (IsVisibleInScope p1 p2 ) = Set.unions $ map varFreeSet [p1,p2] + varFreeSet (NotEqualScope p1 p2 ) = Set.unions $ map varFreeSet [p1,p2] + varFreeSet (EqualScope p1 p2 ) = Set.unions $ map varFreeSet [p1,p2] + varFreeSet (NonEmptyRowLacksLabel r o t l ) = Set.unions [varFreeSet r,varFreeSet o,varFreeSet t,varFreeSet l] + +instance VarUpdatable Guard VarMp where + varUpd s (HasStrictCommonScope p1 p2 p3) = HasStrictCommonScope (s `varUpd` p1) (s `varUpd` p2) (s `varUpd` p3) + varUpd s (IsStrictParentScope p1 p2 p3) = IsStrictParentScope (s `varUpd` p1) (s `varUpd` p2) (s `varUpd` p3) + varUpd s (IsVisibleInScope p1 p2 ) = IsVisibleInScope (s `varUpd` p1) (s `varUpd` p2) + varUpd s (NotEqualScope p1 p2 ) = NotEqualScope (s `varUpd` p1) (s `varUpd` p2) + varUpd s (EqualScope p1 p2 ) = EqualScope (s `varUpd` p1) (s `varUpd` p2) + varUpd s (NonEmptyRowLacksLabel r o t l ) = NonEmptyRowLacksLabel (s `varUpd` r) (s `varUpd` o) (s `varUpd` t) (s `varUpd` l) + +{-# LINE 133 "src/ehc/Pred/CHR.chs" #-} +instance VarExtractable VarUIDHsName TyVarId where + varFreeSet (VarUIDHs_Var i) = Set.singleton i + varFreeSet _ = Set.empty + +-- instance VarUpdatable VarUIDHsName VarMp where +instance VarLookup m ImplsVarId VarMpInfo => VarUpdatable VarUIDHsName m where + varUpd s a = maybe a id $ varmpAssNmLookupAssNmCyc a s + +{-# LINE 143 "src/ehc/Pred/CHR.chs" #-} +instance VarExtractable RedHowAnnotation TyVarId where + varFreeSet (RedHow_Assumption vun sc) = Set.unions [varFreeSet vun,varFreeSet sc] + varFreeSet (RedHow_ByLabel l o sc) = Set.unions [varFreeSet l,varFreeSet o,varFreeSet sc] + varFreeSet _ = Set.empty + +instance VarUpdatable RedHowAnnotation VarMp where + varUpd s (RedHow_Assumption vun sc) = RedHow_Assumption (varUpd s vun) (varUpd s sc) + varUpd s (RedHow_ByLabel l o sc) = RedHow_ByLabel (varUpd s l) (varUpd s o) (varUpd s sc) + varUpd _ x = x + +{-# LINE 166 "src/ehc/Pred/CHR.chs" #-} +instance CHREmptySubstitution VarMp where + chrEmptySubst = emptyVarMp + + +{-# LINE 176 "src/ehc/Pred/CHR.chs" #-} +instance CHRCheckable FIIn Guard VarMp where + chrCheck env subst x + = chk x + where subst' = subst |+> fiVarMp env + chk (HasStrictCommonScope (PredScope_Var vDst) sc1 sc2) + = do { let sc1' = varUpd subst' sc1 + sc2' = varUpd subst' sc2 + ; scDst <- pscpCommon sc1' sc2' + ; if scDst == sc1' + then Nothing + else return $ vDst `varmpScopeUnit` scDst + } + chk (IsStrictParentScope (PredScope_Var vDst) sc1 sc2) + = do { let sc1' = varUpd subst' sc1 + sc2' = varUpd subst' sc2 + ; scDst <- pscpCommon sc1' sc2' + ; if scDst == sc1' && sc1' /= sc2' + then return $ vDst `varmpScopeUnit` scDst + else Nothing + } + chk (NotEqualScope sc1 sc2) | isJust c + = if fromJust c /= EQ then return emptyVarMp else Nothing + where c = pscpCmp (varUpd subst' sc1) (varUpd subst' sc2) + chk (EqualScope sc1 sc2) | isJust c + = if fromJust c == EQ then return emptyVarMp else Nothing + where c = pscpCmp (varUpd subst' sc1) (varUpd subst' sc2) + chk (IsVisibleInScope scDst@(PredScope_Var vDst) sc1) | isJust mbSc + = chk (IsVisibleInScope (fromJust mbSc) sc1) + where mbSc = varmpScopeLookupScopeCyc scDst subst' + chk (IsVisibleInScope (PredScope_Var vDst) sc1) + = return $ vDst `varmpScopeUnit` sc1 + chk (IsVisibleInScope scDst sc1) | pscpIsVisibleIn (varUpd subst' scDst) (varUpd subst' sc1) + = return emptyVarMp + chk (NonEmptyRowLacksLabel r1@(Ty_Var tv _) (LabelOffset_Var vDst) ty lab) + | fiAllowTyVarBind env r1 + && not (null exts) && presence == Absent -- tyIsEmptyRow row + = return $ (vDst `varmpOffsetUnit` LabelOffset_Off offset) + `varUpd` (tv `varmpTyUnit` row) + where (row,exts) = tyRowExtsWithLkup (varmpTyLookupCyc2 subst') ty + ((offset,presence),_) = tyExtsOffset lab' $ rowCanonOrder exts + (Label_Lab lab') = varUpd subst' lab + chk _ + = Nothing + +{-# LINE 286 "src/ehc/Pred/CHR.chs" #-} +instance CHRMatchable FIIn Pred VarMp where + chrMatchTo fi subst pr1 pr2 + = do { (_,subst') <- fitPredIntoPred (fi {fiVarMp = subst |+> fiVarMp fi}) pr1 pr2 + ; return subst' + } + +{-# LINE 294 "src/ehc/Pred/CHR.chs" #-} +instance CHRMatchable FIIn CHRPredOccCxt VarMp where + chrMatchTo e subst (CHRPredOccCxt_Scope1 sc1) (CHRPredOccCxt_Scope1 sc2) = chrMatchTo e subst sc1 sc2 + +instance CHRMatchable FIIn PredScope VarMp where + chrMatchTo _ subst (PredScope_Var v1) sc2@(PredScope_Var v2) | v1 == v2 = Just emptyVarMp + chrMatchTo e subst (PredScope_Var v1) sc2 | isJust mbSc = chrMatchTo e subst (fromJust mbSc) sc2 + where mbSc = varmpScopeLookup v1 subst + chrMatchTo e subst sc1 (PredScope_Var v2) | isJust mbSc = chrMatchTo e subst sc1 (fromJust mbSc) + where mbSc = varmpScopeLookup v2 subst + chrMatchTo _ subst _ (PredScope_Var v2) = Nothing + chrMatchTo _ subst (PredScope_Var v1) sc2 = Just $ v1 `varmpScopeUnit` sc2 + chrMatchTo _ subst (PredScope_Lev l1) (PredScope_Lev l2) | l1 == l2 = Just emptyVarMp + chrMatchTo _ subst _ _ = Nothing + +{-# LINE 310 "src/ehc/Pred/CHR.chs" #-} +instance CHRMatchable FIIn CHRPredOcc VarMp where + chrMatchTo fi subst po1 po2 + = do { subst1 <- chrMatchTo fi subst (cpoPr po1) (cpoPr po2) + ; subst2 <- chrMatchTo fi subst (cpoCxt po1) (cpoCxt po2) + ; return $ subst2 |+> subst1 + } + +{-# LINE 319 "src/ehc/Pred/CHR.chs" #-} +instance CHRMatchable FIIn Label VarMp where + chrMatchTo _ subst (Label_Var v1) lb2@(Label_Var v2) | v1 == v2 = Just emptyVarMp + chrMatchTo e subst (Label_Var v1) lb2 | isJust mbLb = chrMatchTo e subst (fromJust mbLb) lb2 + where mbLb = varmpLabelLookup v1 subst + chrMatchTo e subst lb1 (Label_Var v2) | isJust mbLb = chrMatchTo e subst lb1 (fromJust mbLb) + where mbLb = varmpLabelLookup v2 subst + chrMatchTo _ subst _ (Label_Var v2) = Nothing + chrMatchTo _ subst (Label_Var v1) lb2 = Just $ v1 `varmpLabelUnit` lb2 + chrMatchTo _ subst (Label_Lab l1) (Label_Lab l2) | l1 == l2 = Just emptyVarMp + chrMatchTo _ subst _ _ = Nothing + +{-# LINE 332 "src/ehc/Pred/CHR.chs" #-} +instance CHRMatchable FIIn LabelOffset VarMp where + chrMatchTo _ subst (LabelOffset_Var v1) of2@(LabelOffset_Var v2) | v1 == v2 = Just emptyVarMp + chrMatchTo s subst (LabelOffset_Var v1) of2 | isJust mbOf = chrMatchTo s subst (fromJust mbOf) of2 + where mbOf = varmpOffsetLookup v1 subst + chrMatchTo s subst of1 (LabelOffset_Var v2) | isJust mbOf = chrMatchTo s subst of1 (fromJust mbOf) + where mbOf = varmpOffsetLookup v2 subst + chrMatchTo _ subst _ (LabelOffset_Var v2) = Nothing + chrMatchTo _ subst (LabelOffset_Var v1) of2 = Just $ v1 `varmpOffsetUnit` of2 + chrMatchTo _ subst (LabelOffset_Off l1) (LabelOffset_Off l2) | l1 == l2 = Just emptyVarMp + chrMatchTo _ subst _ _ = Nothing + +{-# LINE 351 "src/ehc/Pred/CHR.chs" #-} +data PartialOrdering + = P_LT | P_EQ | P_GT | P_NE + deriving (Eq,Show) + +toPartialOrdering :: Ordering -> PartialOrdering +toPartialOrdering o + = case o of + EQ -> P_EQ + LT -> P_LT + GT -> P_GT + +toOrdering :: PartialOrdering -> Maybe Ordering +toOrdering o + = case o of + P_EQ -> Just EQ + P_LT -> Just LT + P_GT -> Just GT + _ -> Nothing + +{-# LINE 376 "src/ehc/Pred/CHR.chs" #-} +-- | Consider a pred for proving if: no free tvars, or its free tvars do not coincide with those globally used +isLetProveCandidate :: (VarExtractable x v) => Set.Set v -> x -> Bool +isLetProveCandidate glob x + = Set.null fv || Set.null (fv `Set.intersection` glob) + where fv = varFreeSet x + +isLetProveFailure :: (VarExtractable x v) => Set.Set v -> x -> Bool +isLetProveFailure glob x + = Set.null fv + where fv = varFreeSet x + +{-# LINE 393 "src/ehc/Pred/CHR.chs" #-} +instance Serialize Guard where + sput (HasStrictCommonScope a b c ) = sputWord8 0 >> sput a >> sput b >> sput c + sput (IsVisibleInScope a b ) = sputWord8 1 >> sput a >> sput b + sput (NotEqualScope a b ) = sputWord8 2 >> sput a >> sput b + sput (EqualScope a b ) = sputWord8 3 >> sput a >> sput b + sput (IsStrictParentScope a b c ) = sputWord8 4 >> sput a >> sput b >> sput c + sput (NonEmptyRowLacksLabel a b c d) = sputWord8 5 >> sput a >> sput b >> sput c >> sput d + sget = do t <- sgetWord8 + case t of + 0 -> liftM3 HasStrictCommonScope sget sget sget + 1 -> liftM2 IsVisibleInScope sget sget + 2 -> liftM2 NotEqualScope sget sget + 3 -> liftM2 EqualScope sget sget + 4 -> liftM3 IsStrictParentScope sget sget sget + 5 -> liftM4 NonEmptyRowLacksLabel sget sget sget sget + diff --git a/src/UHC/Light/Compiler/Pred/CommonCHR.hs b/src/UHC/Light/Compiler/Pred/CommonCHR.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/CommonCHR.hs @@ -0,0 +1,166 @@ +module UHC.Light.Compiler.Pred.CommonCHR +( module UHC.Light.Compiler.CHR, module UHC.Light.Compiler.CHR.Constraint +, RedHowAnnotation (..) +, CHRConstraint, CHRIntermediateUntilAssume +, ByScopeRedHow (..) +, patchToAssumeConstraint +, CHRPredOccCnstrTraceMp, CHRPredOccCnstrMp +, gathPredLToProveCnstrMp, gathPredLToAssumeCnstrMp +, predOccCnstrMpLiftScope +, rhaMbId +, mkProveConstraint, mkAssumeConstraint, mkAssumeConstraint' ) +where +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 37 "src/ehc/Pred/CommonCHR.chs" #-} +data RedHowAnnotation + = RedHow_ByInstance !HsName !Pred !PredScope -- inst name, for pred, in scope + | RedHow_BySuperClass !HsName !Int !CTag -- field name, offset, tag info of dict + | RedHow_ProveObl !UID !PredScope + | RedHow_Assumption !VarUIDHsName !PredScope + | RedHow_ByScope !ByScopeRedHow -- variant, for distinguishing during debugging + | RedHow_ByLabel !Label !LabelOffset !PredScope + | RedHow_Lambda !UID !PredScope + deriving + ( Eq, Ord + , Typeable, Data + ) + +{-# LINE 67 "src/ehc/Pred/CommonCHR.chs" #-} +rhaMbId :: RedHowAnnotation -> Maybe UID +rhaMbId (RedHow_ProveObl i _) = Just i +rhaMbId _ = Nothing + +{-# LINE 73 "src/ehc/Pred/CommonCHR.chs" #-} +instance Show RedHowAnnotation where + show = showPP . pp + +{-# LINE 78 "src/ehc/Pred/CommonCHR.chs" #-} +instance PP RedHowAnnotation where + pp (RedHow_ByInstance s p sc) = "inst" >#< {- ppParens (vm >#< "`varUpd`") >#< -} ppParensCommas [pp p, pp s, pp sc] + pp (RedHow_BySuperClass s _ _ ) = "super" >#< s + pp (RedHow_ProveObl i sc) = "prove" >#< i >#< sc + pp (RedHow_Assumption vun sc) = "assume" >#< ppParensCommas [pp vun, pp sc] + pp (RedHow_ByScope v ) = "scope" >|< ppParens v + pp (RedHow_ByLabel l o sc) = "label" >#< l >|< "@" >|< o >|< sc + pp (RedHow_Lambda i sc) = "lambda" >#< i >#< sc + +{-# LINE 106 "src/ehc/Pred/CommonCHR.chs" #-} +-- | Constraint specialized to scoped predicates with reduction info +type CHRConstraint = Constraint CHRPredOcc RedHowAnnotation + +-- | intermediate structure for holding constraint and related info until it can safely be assumed +type CHRIntermediateUntilAssume = (CHRPredOcc,(PredScope,CHRPredOccCnstrTraceMp)) + +{-# LINE 118 "src/ehc/Pred/CommonCHR.chs" #-} +data ByScopeRedHow + = ByScopeRedHow_Prove -- scope reduction based on Prove + | ByScopeRedHow_Assume -- scope reduction based on Assume + | ByScopeRedHow_Other (AlwaysEq String) -- other reason + deriving + ( Eq, Ord + , Typeable, Data + ) + +-- equality plays no role ?? +{- +instance Eq ByScopeRedHow where + _ == _ = True + +instance Ord ByScopeRedHow where + _ `compare` _ = EQ +-} + +instance Show ByScopeRedHow where + show ByScopeRedHow_Prove = "prv" + show ByScopeRedHow_Assume = "ass" + show (ByScopeRedHow_Other s) = show s + +instance PP ByScopeRedHow where + pp = pp . show + +{-# LINE 166 "src/ehc/Pred/CommonCHR.chs" #-} +mkProveConstraint :: Range -> Pred -> UID -> PredScope -> (CHRConstraint,RedHowAnnotation) +mkProveConstraint r pr i sc = (Prove (mkCHRPredOccRng r pr sc),RedHow_ProveObl i sc) + +mkAssumeConstraint'' :: Range -> Pred -> VarUIDHsName -> PredScope -> (CHRConstraint,RedHowAnnotation) +mkAssumeConstraint'' r pr vun sc = (Assume (mkCHRPredOccRng r pr sc),RedHow_Assumption vun sc) + +mkAssumeConstraint' :: Range -> Pred -> UID -> HsName -> PredScope -> (CHRConstraint,RedHowAnnotation) +mkAssumeConstraint' r pr i n sc = mkAssumeConstraint'' r pr (VarUIDHs_Name i n) sc + +mkAssumeConstraint :: Range -> Pred -> UID -> PredScope -> (CHRConstraint,RedHowAnnotation) +mkAssumeConstraint r pr i sc = mkAssumeConstraint'' r pr (VarUIDHs_UID i) sc + +{-# LINE 180 "src/ehc/Pred/CommonCHR.chs" #-} +patchToAssumeConstraint :: UID -> PredScope -> (PredScope -> RedHowAnnotation -> x -> x) -> (CHRConstraint,x) -> (CHRConstraint,x) +patchToAssumeConstraint i sc set (c,x) + = (Assume (pr {cpoCxt = cx {cpocxScope = sc}}), set sc (RedHow_Assumption (VarUIDHs_UID i) sc) x) + where pr = cnstrPred c + cx = cpoCxt pr + +{-# LINE 192 "src/ehc/Pred/CommonCHR.chs" #-} +type CHRPredOccCnstrTraceMp = ConstraintToInfoTraceMp CHRPredOcc RedHowAnnotation +type CHRPredOccCnstrMp = ConstraintToInfoMap CHRPredOcc RedHowAnnotation + +{-# LINE 197 "src/ehc/Pred/CommonCHR.chs" #-} +gathPredLToProveCnstrMp :: [PredOcc] -> CHRPredOccCnstrMp +gathPredLToProveCnstrMp l = cnstrMpFromList [ rngLift (poRange po) mkProveConstraint (poPr po) (poId po) (poScope po) | po <- l ] + +gathPredLToAssumeCnstrMp :: [PredOcc] -> CHRPredOccCnstrMp +gathPredLToAssumeCnstrMp l = cnstrMpFromList [ rngLift (poRange po) mkAssumeConstraint (poPr po) (poId po) (poScope po) | po <- l ] + +{-# LINE 205 "src/ehc/Pred/CommonCHR.chs" #-} +-- | Lift predicate occurrences to new scope, used to lift unproven predicates to an outer scope. +predOccCnstrMpLiftScope :: PredScope -> CHRPredOccCnstrMp -> CHRPredOccCnstrMp +predOccCnstrMpLiftScope sc + = Map.mapKeysWith (++) c . Map.map (map i) + where c (Prove o@(CHRPredOcc {cpoCxt=cx})) + = Prove (o {cpoCxt = cx {cpocxScope = sc}}) + c x = x + i (RedHow_ProveObl id _) + = RedHow_ProveObl id sc + i x = x + +{-# LINE 222 "src/ehc/Pred/CommonCHR.chs" #-} +instance Serialize ByScopeRedHow where + sput (ByScopeRedHow_Prove ) = sputWord8 0 + sput (ByScopeRedHow_Assume ) = sputWord8 1 + sput (ByScopeRedHow_Other a ) = sputWord8 2 >> sput a + sget = do + t <- sgetWord8 + case t of + 0 -> return ByScopeRedHow_Prove + 1 -> return ByScopeRedHow_Assume + 2 -> liftM ByScopeRedHow_Other sget + +instance Serialize RedHowAnnotation where + sput (RedHow_ByInstance a b c ) = sputWord8 0 >> sput a >> sput b >> sput c -- >> sput d + sput (RedHow_BySuperClass a b c ) = sputWord8 1 >> sput a >> sput b >> sput c + sput (RedHow_ProveObl a b ) = sputWord8 2 >> sput a >> sput b + sput (RedHow_Assumption a b ) = sputWord8 3 >> sput a >> sput b + sput (RedHow_ByScope a ) = sputWord8 4 >> sput a + sput (RedHow_ByLabel a b c ) = sputWord8 5 >> sput a >> sput b >> sput c + sput (RedHow_Lambda a b ) = sputWord8 6 >> sput a >> sput b + sget = do t <- sgetWord8 + case t of + 0 -> liftM3 RedHow_ByInstance sget sget sget -- sget + 1 -> liftM3 RedHow_BySuperClass sget sget sget + 2 -> liftM2 RedHow_ProveObl sget sget + 3 -> liftM2 RedHow_Assumption sget sget + 4 -> liftM RedHow_ByScope sget + 5 -> liftM3 RedHow_ByLabel sget sget sget + 6 -> liftM2 RedHow_Lambda sget sget + diff --git a/src/UHC/Light/Compiler/Pred/Evidence.hs b/src/UHC/Light/Compiler/Pred/Evidence.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/Evidence.hs @@ -0,0 +1,113 @@ +module UHC.Light.Compiler.Pred.Evidence +( Evidence (..) +, evidUnresolved +, evidUpdateUnresolved +, InfoToEvidenceMap, evidMpInsert, evidMpUnion, evidMpSubst ) +where +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Base.Common +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import UHC.Util.Pretty +import UHC.Util.Utils + +{-# LINE 36 "src/ehc/Pred/Evidence.chs" #-} +data Evidence p info + = Evid_Unresolved { evidPred :: !p , evidTrace :: ![UnresolvedTrace p info] } + -- = Evid_Unresolved { evidPred :: !p , evidAttempts :: ![Evidence p info] } + | Evid_Proof { evidPred :: !p , evidInfo :: !info , evidProofSubs :: ![Evidence p info] } + | Evid_Recurse { evidPred :: !p } + | Evid_Ambig { evidPred :: !p , evidAmbigSubs :: ![(info,[Evidence p info])] } + +{-# LINE 45 "src/ehc/Pred/Evidence.chs" #-} +instance (Show info, Show p) => Show (Evidence p info) where + show _ = "Evidence" + +instance (Eq p, Eq info) => Eq (Evidence p info) where + (Evid_Proof _ i1 evs1) == (Evid_Proof _ i2 evs2) = i1 == i2 && evs1 == evs2 + (Evid_Recurse p1 ) == (Evid_Recurse p2 ) = p1 == p2 + _ == _ = False + +instance (Ord p, Ord info) => Ord (Evidence p info) where + Evid_Unresolved _ _ `compare` _ = LT + _ `compare` Evid_Unresolved _ _ = GT + Evid_Proof _ i1 evs1 `compare` Evid_Proof _ i2 evs2 = orderingLexic (i1 `compare` i2 : zipWith compare evs1 evs2) + Evid_Proof _ _ _ `compare` _ = LT + _ `compare` Evid_Proof _ _ _ = GT + Evid_Recurse p1 `compare` Evid_Recurse p2 = p1 `compare` p2 + Evid_Recurse _ `compare` _ = LT + _ `compare` Evid_Recurse _ = GT + +{-# LINE 65 "src/ehc/Pred/Evidence.chs" #-} +instance (PP info, PP p) => PP (Evidence p info) where + pp (Evid_Proof _ info []) = "Ev:" >#< info + pp (Evid_Proof _ info es) = "Ev:" >#< info >#< ppBracketsCommas' es + pp (Evid_Recurse p ) = "Ev: recurse:" >#< p + pp (Evid_Ambig _ ess) = "Ev: ambiguous:" >#< ppBracketsCommas' (map (ppBracketsCommas . snd) ess) + pp (Evid_Unresolved p _) = "Ev: unresolved:" >#< p + +{-# LINE 74 "src/ehc/Pred/Evidence.chs" #-} +instance VarExtractable p v => VarExtractable (Evidence p info) v where + varFreeSet (Evid_Unresolved p _ ) = varFreeSet p + varFreeSet (Evid_Proof p _ es) = Set.unions $ varFreeSet p : map varFreeSet es + varFreeSet (Evid_Recurse p ) = varFreeSet p + varFreeSet (Evid_Ambig p ess) = Set.unions $ varFreeSet p : map (Set.unions . map varFreeSet . snd) ess + +instance VarUpdatable p s => VarUpdatable (Evidence p info) s where + varUpd s (Evid_Unresolved p u ) = Evid_Unresolved (varUpd s p) u + varUpd s (Evid_Proof p i es) = Evid_Proof (varUpd s p) i (map (varUpd s) es) + varUpd s (Evid_Recurse p ) = Evid_Recurse (varUpd s p) + varUpd s (Evid_Ambig p ess) = Evid_Ambig (varUpd s p) (assocLMapElt (map (varUpd s)) ess) + +{-# LINE 92 "src/ehc/Pred/Evidence.chs" #-} +-- | Get unresolved trace from evidence from which is known is belongs to unresolved predicate +evidUnresolved :: Eq p => Evidence p info -> [UnresolvedTrace p info] +evidUnresolved (Evid_Unresolved p us) = -- concatMap evidUnresolved us + us +evidUnresolved (Evid_Proof p i ps) + | null us = [] + | otherwise = [UnresolvedTrace_Red p i us] + where us = {- nub $ -} concatMap evidUnresolved ps +evidUnresolved (Evid_Ambig p pss) + | null us = [] + | otherwise = [UnresolvedTrace_Overlap p us] + where us = {- nub $ concatMap -} map (\(i,ps) -> (i,concatMap evidUnresolved ps)) pss +evidUnresolved _ = [] + +{-# LINE 108 "src/ehc/Pred/Evidence.chs" #-} +-- | Choose proof over unresolved, to be used when patching evidence with newfound proofs +evidUpdateUnresolved :: Eq p => Evidence p info -> Evidence p info -> Evidence p info +evidUpdateUnresolved e (Evid_Unresolved _ _)= e +evidUpdateUnresolved (Evid_Proof p i qs) e = Evid_Proof p i [evidUpdateUnresolved q e | q <- qs] +evidUpdateUnresolved (Evid_Recurse p ) e = Evid_Recurse p +evidUpdateUnresolved u@(Evid_Unresolved q _) e | q == evidPred e = e + | otherwise = u + +{-# LINE 118 "src/ehc/Pred/Evidence.chs" #-} +evidSubstUnresolved :: (p -> Maybe (Evidence p info)) -> Evidence p info -> Evidence p info +evidSubstUnresolved lkup ev + = s ev + where s ev = case ev of + Evid_Unresolved p _ + | isJust mbev -> fromJust mbev + where mbev = lkup p + Evid_Proof p i es -> Evid_Proof p i $ map s es + Evid_Ambig p ess -> Evid_Ambig p $ assocLMapElt (map s) ess + _ -> ev + +{-# LINE 135 "src/ehc/Pred/Evidence.chs" #-} +type InfoToEvidenceMap p info = Map.Map info (Evidence p info) + +evidMpInsert :: (Eq p, Ord info) => info -> Evidence p info -> InfoToEvidenceMap p info -> InfoToEvidenceMap p info +evidMpInsert = Map.insertWith evidUpdateUnresolved + +evidMpUnion :: (Eq p, Ord info) => InfoToEvidenceMap p info -> InfoToEvidenceMap p info -> InfoToEvidenceMap p info +evidMpUnion = Map.unionWith evidUpdateUnresolved + +evidMpSubst :: (p -> Maybe (Evidence p info)) -> InfoToEvidenceMap p info -> InfoToEvidenceMap p info +evidMpSubst lkup = Map.map (evidSubstUnresolved lkup) + diff --git a/src/UHC/Light/Compiler/Pred/EvidenceToCore.hs b/src/UHC/Light/Compiler/Pred/EvidenceToCore.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/EvidenceToCore.hs @@ -0,0 +1,530 @@ +module UHC.Light.Compiler.Pred.EvidenceToCore +( EvidKeyToCBindMap, PredScopeToCBindMap, EvidKeyToCExprMap +, OverlapEvid (..) +, evidKeyToBindMapUnion, predScopeToBindMapUnion +, evidMpToCore +, evidKeyCoreMpToBinds +, EvidCBindL, evidKeyCoreMpToBinds2 +, evidKeyBindMpToCSubst ) +where +import UHC.Light.Compiler.Pred.Evidence +import UHC.Light.Compiler.Pred.CommonCHR +import Data.List +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Maybe +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Core.Subst +import UHC.Light.Compiler.AbstractCore +import qualified UHC.Light.Compiler.Core.SysF.AsTy as SysF +import UHC.Util.Pretty +import UHC.Util.Utils +import Control.Monad.State +import UHC.Light.Compiler.Base.Debug as Debug +import Debug.Trace + + + +{-# LINE 53 "src/ehc/Pred/EvidenceToCore.chs" #-} +type EvidKeyToExprMap' e t = Map.Map UID (ToCoreRes e t) -- (e,t,Set.Set SubEvid,PredScope) +type EvidKeyToBindMap' b = Map.Map UID [b] +type PredScopeToBindMap' b = Map.Map PredScope [b] + +type EvidKeyToCExprMap = EvidKeyToExprMap' CExpr Ty +type EvidKeyToCBindMap = EvidKeyToBindMap' CBind +type PredScopeToCBindMap = PredScopeToBindMap' CBind + +{-# LINE 66 "src/ehc/Pred/EvidenceToCore.chs" #-} +data OverlapEvid p info + = OverlapEvid + { overlapevidPredOcc :: !p + , overlapevidInfos :: ![info] + } + +{-# LINE 74 "src/ehc/Pred/EvidenceToCore.chs" #-} +evidKeyToBindMapUnion :: EvidKeyToBindMap' e -> EvidKeyToBindMap' e -> EvidKeyToBindMap' e +evidKeyToBindMapUnion = Map.unionWith (++) + +predScopeToBindMapUnion :: PredScopeToBindMap' b -> PredScopeToBindMap' b -> PredScopeToBindMap' b +predScopeToBindMapUnion = Map.unionWith (++) + +{-# LINE 86 "src/ehc/Pred/EvidenceToCore.chs" #-} +-- | Translate evidence to actual core, taking into account the need to share (i.e. do CSE, by state accumulating maps). +-- Cleanup dd 20120209, rewrite to State version. +evidMpToCore2 :: FIIn' gm -> InfoToEvidenceMap CHRPredOcc RedHowAnnotation -> (EvidKeyToCExprMap,[OverlapEvid CHRPredOcc RedHowAnnotation]) +evidMpToCore2 env evidMp + = ( -- Map.map (\r -> (tcrCExpr r,tcrTy r,tcrUsed r,tcrScope r)) $ + tcsMp + $ execState (mapM (\(RedHow_ProveObl i _,ev) -> mk1 (Just i) ev) evidMp') + (ToCoreState Map.empty Map.empty Map.empty (fiUniq env)) + , concat overlaps + ) + where -- | Split off overlapping instances (i.e. ambiguous evidence) + (evidMp',overlaps) + = unzip [ ((i,ev3),as) + | (i,ev) <- Map.toList evidMp, not (ignore ev) + , let (ev2,as) = splitOverlap ev ; ev3 = stripScope ev2 + ] + + -- | Make Core for a single Evidence, recursing for subevidence + mk1 :: Maybe UID -- an UID already may have been assigned, it then should be used (the case for start evidence of this fun) + -> Evidence CHRPredOcc RedHowAnnotation -- the evidence + -> State (ToCoreState CHRPredOcc RedHowAnnotation CExpr Ty) (ToCoreRes CExpr Ty) + mk1 mbevk ev + = case ev of + Evid_Proof p info evs + -> do { st@(ToCoreState {tcsUniq=u}) <- get + ; let (u',evk,insk,evnm,uses) + = case info of + RedHow_ProveObl i _ -> (u,choosek i,True,choosen $ mkHNm i,Set.empty) + RedHow_Assumption vun s -> (u,choosek i,False,choosen (vunmNm vun),Set.singleton (SubEvid_Assume i s)) + where i = vunmId vun + _ -> (u1,choosek u2,True,choosen $ mkHNm u2,Set.empty) + where (u1,u2) = mkNewUID u + ; modify (\st -> st {tcsUniq = u', tcsPrMp = Map.insert p evnm $ tcsPrMp st}) + ; rs <- mapM (mk1 Nothing) evs + ; let (c,sc) = ann info rs + ; ins (insk || isJust mbevk) + evk evnm ev c (pred2DataTy $ cpoPr p) sc + (Set.unions (uses : map tcrUsed rs)) + } + where choosek k = maybe k id mbevk + choosen n = maybe n mkHNm mbevk + Evid_Recurse p + -> do { st@(ToCoreState {tcsUniq=u}) <- get + ; let (u1,u2) = mkNewUID u + recnm = panicJust "evidMpToCore.Evid_Recurse" $ Map.lookup p $ tcsPrMp st + ; modify (\st -> st {tcsUniq = u1}) + ; ins True + u2 (mkHNm u2) ev (mknm recnm) (pred2DataTy $ cpoPr p) (cpoScope p) + Set.empty + } + ev + -> return (ToCoreRes (acoreBuiltinUndefined $ feEHCOpts $ fiEnv env) + (pred2DataTy $ cpoPr $ evidPred ev) + Set.empty initPredScope + ) + + -- | Update state (insert given required ingredients) & compute actual result + ins :: Bool -- insert in UID map? + -> UID -- the UID for this evidence + -> HsName -- the name as used in Core for this evidence + -> Evidence CHRPredOcc RedHowAnnotation -- the evidence + -> CExpr -- its Core expr + -> Ty -- its type + -> PredScope -- its scope + -> Set.Set SubEvid -- its sub evidence + -> State (ToCoreState CHRPredOcc RedHowAnnotation CExpr Ty) (ToCoreRes CExpr Ty) + ins insk k evnm ev c ty sc uses + = do { st <- get + ; case Map.lookup ev $ tcsEvMp st of + Just r + -- Is already in map, update UID/key map + | insk + -> do { modify (mkk k r) + ; return (vr evnm r) + } + + -- No map update required + | otherwise + -> return (vr evnm r) + + -- Insert in both maps, i.e. UID and Evidence map + _ | insk + -> do { let r1 = ToCoreRes c ty uses sc + r2 = ToCoreRes (vc c (mknm evnm)) ty uses sc + ; modify (mkk k r1 . mkc ev r2) + ; return r2 + } + + -- Update only Evidence map + | otherwise + -> do { let r2 = ToCoreRes (vc c (mknm evnm)) ty uses sc + ; modify (mkc ev r2) + ; return r2 + } + } + where mkk k r st = st {tcsMp = Map.insert k r $ tcsMp st} + mkc ev r st = st {tcsEvMp = Map.insert ev r $ tcsEvMp st} + vr evnm r = case acoreExprMbVar $ tcrCExpr r of + Just _ -> r + _ -> r {tcrCExpr = mknm evnm} + vc c c' = case acoreExprMbVar c of + Just _ -> c + _ -> c' + mknm = acoreVar + ann (RedHow_Assumption vun sc) _ = ( mknm $ vunmNm vun, sc ) + ann (RedHow_ByInstance n _ sc) ctxt= ( acoreApp (mknm n) (map (\c -> (tcrCExpr c)) ctxt), maximumBy pscpCmpByLen $ sc : map tcrScope ctxt ) + ann (RedHow_BySuperClass n o t ) [sub] = let res = acoreSatSelsCaseMetaTy + (emptyRCEEnv $ feEHCOpts $ fiEnv env) + (Just (hsnUniqifyEval n,acoreTyErr "evidMpToCore2.ann.RedHow_BySuperClass")) + acoreMetavalDfltDict + (tcrCExpr sub) + t + [(n,acoreTyErr $ "evidMpToCore2.ann.RedHow_BySuperClass.sub: " ++ show n,{-n,-}o)] + Nothing + (acoreVar n) + in ( res + , tcrScope sub + ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [] = ( acoreInt opts o, sc ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [roff] = ( acoreBuiltinAddInt opts (tcrCExpr roff) o, sc ) + ann (RedHow_Lambda i sc) [body] = ( acoreTyErrLift "RedHow_Lambda" [mkHNm i] `acoreLamTy` tcrCExpr body, sc ) + + -- | Ignore proofs without real evidence + ignore _ = False + + -- | Strip off scope related reductions, no longer required + stripScope (Evid_Proof _ (RedHow_ByScope _) [ev]) = stripScope ev + stripScope (Evid_Proof p i evs ) = Evid_Proof p i (map stripScope evs) + stripScope ev = ev + + -- | Split off overlapping instances + splitOverlap (Evid_Proof p i es ) = let (es',as) = splitOverlaps es in (Evid_Proof p i es',as) + splitOverlap (Evid_Ambig p ess@((i,es):_)) = let (es',_ ) = splitOverlaps es in (Evid_Proof p i es',[OverlapEvid p (map fst ess)]) + splitOverlap ev = (ev,[]) + splitOverlaps es = let (es',as) = unzip $ map splitOverlap es in (es',concat as) + + -- | ehc options + opts = feEHCOpts $ fiEnv env + +{-# LINE 242 "src/ehc/Pred/EvidenceToCore.chs" #-} +-- | Translate evidence to actual core, taking into account the need to share (i.e. do CSE, by state accumulating maps). +-- Cleanup dd 20120209, rewrite to State version, plus abstraction over Core variant +{- +-- For now: breaks on pred2DataTy, which is not (yet) abstracted over +evidMpToCore3 + :: forall gm p e m b basp bcat mbind t pat pr pf a . + (AbstractCore e m b basp bcat mbind t pat pr pf a) + => FIIn' gm + -> InfoToEvidenceMap p RedHowAnnotation + -> ( EvidKeyToExprMap' e t + , [OverlapEvid p RedHowAnnotation] + ) +evidMpToCore3 env evidMp + = ( Map.map (\r -> (tcrCExpr r,tcrTy r,tcrUsed r,tcrScope r)) $ tcsMp $ snd + $ runState (mapM (\(RedHow_ProveObl i _,ev) -> mk1 (Just i) ev) evidMp') + (ToCoreState Map.empty Map.empty Map.empty (fiUniq env)) + , concat overlaps + ) + where -- | Split off overlapping instances (i.e. ambiguous evidence) + (evidMp',overlaps) + = unzip [ ((i,ev3),as) + | (i,ev) <- Map.toList evidMp, not (ignore ev) + , let (ev2,as) = splitOverlap ev ; ev3 = stripScope ev2 + ] + + -- | Make Core for a single Evidence, recursing for subevidence + mk1 :: Maybe UID -- an UID already may have been assigned, it then should be used (the case for start evidence of this fun) + -> Evidence p RedHowAnnotation -- the evidence + -> State (ToCoreState p RedHowAnnotation e t) (ToCoreRes e t) + mk1 mbevk ev + = case ev of + Evid_Proof p info evs + -> do { st@(ToCoreState {tcsUniq=u}) <- get + ; let (u',evk,insk,evnm,uses) + = case info of + RedHow_ProveObl i _ -> (u,choosek i,True,choosen $ mkHNm i,Set.empty) + RedHow_Assumption vun s -> (u,choosek i,False,choosen (vunmNm vun),Set.singleton (SubEvid_Assume i s)) + where i = vunmId vun + _ -> (u1,choosek u2,True,choosen $ mkHNm u2,Set.empty) + where (u1,u2) = mkNewUID u + ; modify (\st -> st {tcsUniq = u', tcsPrMp = Map.insert p evnm $ tcsPrMp st}) + ; rs <- mapM (mk1 Nothing) evs + ; let (c,sc) = ann info rs + ; ins (insk || isJust mbevk) + evk evnm ev c (pred2DataTy $ cpoPr p) sc + (Set.unions (uses : map tcrUsed rs)) + } + where choosek k = maybe k id mbevk + choosen n = maybe n mkHNm mbevk + Evid_Recurse p + -> do { st@(ToCoreState {tcsUniq=u}) <- get + ; let (u1,u2) = mkNewUID u + recnm = panicJust "evidMpToCore.Evid_Recurse" $ Map.lookup p $ tcsPrMp st + ; modify (\st -> st {tcsUniq = u1}) + ; ins True + u2 (mkHNm u2) ev (mknm recnm) (pred2DataTy $ cpoPr p) (cpoScope p) + Set.empty + } + ev + -> return (ToCoreRes (acoreBuiltinUndefined $ feEHCOpts $ fiEnv env) + undefined -- (pred2DataTy $ cpoPr $ evidPred ev) + Set.empty initPredScope + ) + + -- | Update state (insert given required ingredients) & compute actual result + ins :: Bool -- insert in UID map? + -> UID -- the UID for this evidence + -> HsName -- the name as used in Core for this evidence + -> Evidence p RedHowAnnotation -- the evidence + -> e -- its Core expr + -> t -- its type + -> PredScope -- its scope + -> Set.Set SubEvid -- its sub evidence + -> State (ToCoreState p RedHowAnnotation e t) (ToCoreRes e t) + ins insk k evnm ev c ty sc uses + = do { st <- get + ; case Map.lookup ev $ tcsEvMp st of + Just r + -- Is already in map, update UID/key map + | insk + -> do { modify (mkk k r) + ; return (vr evnm r) + } + + -- No map update required + | otherwise + -> return (vr evnm r) + + -- Insert in both maps, i.e. UID and Evidence map + _ | insk + -> do { let r1 = ToCoreRes c ty uses sc + r2 = ToCoreRes (vc c (mknm evnm)) ty uses sc + ; modify (mkk k r1 . mkc ev r2) + ; return r2 + } + + -- Update only Evidence map + | otherwise + -> do { let r2 = ToCoreRes (vc c (mknm evnm)) ty uses sc + ; modify (mkc ev r2) + ; return r2 + } + } + where mkk k r st = st {tcsMp = Map.insert k r $ tcsMp st} + mkc ev r st = st {tcsEvMp = Map.insert ev r $ tcsEvMp st} + vr evnm r = case acoreExprMbVar $ tcrCExpr r of + Just _ -> r + _ -> r {tcrCExpr = mknm evnm} + vc c c' = case acoreExprMbVar c of + Just _ -> c + _ -> c' + mknm = acoreVar + ann (RedHow_Assumption vun sc) _ = ( mknm $ vunmNm vun, sc ) + ann (RedHow_ByInstance n _ sc) ctxt= ( acoreApp (mknm n) (map (\c -> (tcrCExpr c)) ctxt), maximumBy pscpCmpByLen $ sc : map tcrScope ctxt ) + ann (RedHow_BySuperClass n o t ) [sub] = let res = acoreSatSelsCaseMetaTy + (emptyRCEEnv $ feEHCOpts $ fiEnv env) + (Just (hsnUniqifyEval n,Ty_Any)) + acoreMetavalDfltDict + (tcrCExpr sub) + t + [(n,{-n,-}o)] + Nothing + (acoreVar n) + in ( res + , tcrScope sub + ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [] = ( acoreInt o, sc ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [roff] = ( acoreBuiltinAddInt (feEHCOpts $ fiEnv env) (tcrCExpr roff) o, sc ) + ann (RedHow_Lambda i sc) [body] = ( acoreTyErrLift "RedHow_Lambda" [mkHNm i] `acoreLamTy` tcrCExpr body, sc ) + + -- | Ignore proofs without real evidence + ignore _ = False + + -- | Strip off scope related reductions, no longer required + stripScope (Evid_Proof _ (RedHow_ByScope _) [ev]) = stripScope ev + stripScope (Evid_Proof p i evs ) = Evid_Proof p i (map stripScope evs) + stripScope ev = ev + + -- | Split off overlapping instances + splitOverlap (Evid_Proof p i es ) = let (es',as) = splitOverlaps es in (Evid_Proof p i es',as) + splitOverlap (Evid_Ambig p ess@((i,es):_)) = let (es',_ ) = splitOverlaps es in (Evid_Proof p i es',[OverlapEvid p (map fst ess)]) + splitOverlap ev = (ev,[]) + splitOverlaps es = let (es',as) = unzip $ map splitOverlap es in (es',concat as) +-} + +{-# LINE 404 "src/ehc/Pred/EvidenceToCore.chs" #-} +-- | State maintained during evid -> core +data ToCoreState p info e t + = ToCoreState + { tcsMp :: !(Map.Map UID (ToCoreRes e t)) -- accumulating map: uid -> Core (+additional info) + , tcsEvMp :: !(Map.Map (Evidence p info) (ToCoreRes e t)) -- accumulating map: evidence -> Core (+additional info) + , tcsPrMp :: !(Map.Map p HsName) -- accumulating map: for recursive proof, names for predicates to be introduced + , tcsUniq :: !UID -- threaded unique id + } + +-- | The core expression, plus additional info +data ToCoreRes e t + = ToCoreRes + { tcrCExpr :: !e -- evidence Core expr + , tcrTy :: !t -- its type + , tcrUsed :: !(Set.Set SubEvid) -- which subevidence has been used to construct this evidence + , tcrScope :: !PredScope -- its scope + } + +instance Show (ToCoreRes e t) where + show _ = "ToCoreRes" + +instance (PP e, PP t) => PP (ToCoreRes e t) where + pp r = "TCR" >#< tcrCExpr r >#< "::" >#< tcrTy r + +{-# LINE 430 "src/ehc/Pred/EvidenceToCore.chs" #-} +-- | Sub evidence encodes the evidence needed to construct other evidence, as in Eq Int required for Eq [Int]. +-- The subevidence is identified/introduced by a UID and defined in scope. +-- Subevidence can be an assumption (encoded below) or an already known instance (dealt with otherwise, but must be here too. 20090416) +data SubEvid + = SubEvid_Assume + { subevdId :: UID + , subevdScope :: PredScope + } + deriving (Eq,Ord,Show) + +instance PP SubEvid where + pp (SubEvid_Assume i s) = "SubEvd" >#< i >#< s + +{-# LINE 447 "src/ehc/Pred/EvidenceToCore.chs" #-} +-- | Translate evidence to actual core, taking into account the need to share (i.e. do CSE) +evidMpToCore :: FIIn' gm -> InfoToEvidenceMap CHRPredOcc RedHowAnnotation -> (EvidKeyToCExprMap,[OverlapEvid CHRPredOcc RedHowAnnotation]) +evidMpToCore = evidMpToCore2 +{- +evidMpToCore env evidMp + = ( Map.map (\r -> (tcrCExpr r,tcrTy r,tcrUsed r,tcrScope r)) $ tcsMp + $ foldr mke (ToCoreState Map.empty Map.empty Map.empty (fiUniq env)) + $ evidMp' + , concat ambigs + ) + where (evidMp',ambigs) + = dbg "evidMpToCore.mk1.evidMp'" $ + unzip [ ((i,ev3),as) + | (i,ev) <- Map.toList evidMp, not (ignore ev) + , let (ev2,as) = splitOverlap ev ; ev3 = stripScope ev2 + ] + mke (RedHow_ProveObl i _,ev) st = fst $ mk1 st (Just i) ev + mk1 st mbevk ev@(Evid_Proof p info evs) + = dbg "evidMpToCore.mk1.a" $ + ins (insk || isJust mbevk) + evk evnm ev c (pred2DataTy $ cpoPr p) sc + (Set.unions (uses : map tcrUsed rs)) + (st' {tcsUniq=u'}) + where (st'@(ToCoreState {tcsUniq=u}),rs) = mkn (st {tcsPrMp = Map.insert p evnm $ tcsPrMp st}) evs + (c,sc) = ann info rs + (u',evk,insk,evnm,uses) + = case info of + RedHow_ProveObl i _ -> (u,choosek i,True,choosen $ mkHNm i,Set.empty) + RedHow_Assumption vun s -> (u,choosek i,False,choosen (vunmNm vun),Set.singleton (SubEvid_Assume i s)) + where i = vunmId vun + _ -> (u1,choosek u2,True,choosen $ mkHNm u2,Set.empty) + where (u1,u2) = mkNewUID u + choosek k = maybe k id mbevk + choosen n = maybe n mkHNm mbevk + mk1 st@(ToCoreState {tcsUniq=u}) mbevk ev@(Evid_Recurse p) + = ins True + u2 (mkHNm u2) ev (mknm recnm) (pred2DataTy $ cpoPr p) (cpoScope p) + Set.empty + (st {tcsUniq=u1}) + where (u1,u2) = mkNewUID u + recnm = panicJust "evidMpToCore.Evid_Recurse" $ Map.lookup p $ tcsPrMp st + mk1 st _ ev = dbg "evidMpToCore.mk1.b" $ (st,ToCoreRes (acoreBuiltinUndefined $ feEHCOpts $ fiEnv env) (pred2DataTy $ cpoPr $ evidPred ev) Set.empty initPredScope) + mkn st = dbg "evidMpToCore.mkn" $ foldr (\ev (st,rs) -> let (st',r) = mk1 st Nothing ev in (st',r:rs)) (st,[]) + mkv x = mknm $ mkHNm x + mknm = acoreVar + ins insk k evnm ev c ty sc uses st + = {- trp "XX" ((ppAssocLV $ Map.toList $ tcsMp st') >-< (ppAssocLV $ Map.toList $ tcsEvMp st')) $ -} res + where res@(st',_) + = case Map.lookup ev $ tcsEvMp st of + Just r -> ( mkk r st,vr r) + _ -> (mkc r $ mkk (ToCoreRes c ty uses sc) st, r) + mkk r st = if insk then st {tcsMp = Map.insert k r $ tcsMp st} else st + mkc v st = st {tcsEvMp = Map.insert ev v $ tcsEvMp st} + v = mknm evnm + r = ToCoreRes (vc c v) ty uses sc + vr r = case acoreExprMbVar $ tcrCExpr r of + Just _ -> r + _ -> r {tcrCExpr = v} + vc c c' = case acoreExprMbVar c of + Just _ -> c + _ -> c' + ann (RedHow_Assumption vun sc) _ = ( mknm $ vunmNm vun, sc ) + ann (RedHow_ByInstance n _ sc) ctxt= ( acoreApp (mknm n) (map (\c -> (tcrCExpr c)) ctxt), maximumBy pscpCmpByLen $ sc : map tcrScope ctxt ) + ann (RedHow_BySuperClass n o t ) [sub] = let res = acoreSatSelsCaseMetaTy + (emptyRCEEnv $ feEHCOpts $ fiEnv env) + (Just (hsnUniqifyEval n,Ty_Any)) + CMetaVal_Dict + (tcrCExpr sub) + t + [(n,{-n,-}o)] + Nothing + (acoreVar n) + in ( res + , tcrScope sub + ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [] = ( acoreInt o, sc ) + ann (RedHow_ByLabel _ (LabelOffset_Off o) sc) [roff] = ( acoreBuiltinAddInt (feEHCOpts $ fiEnv env) (tcrCExpr roff) o, sc ) + ann (RedHow_Lambda i sc) [body] = ( acoreTyErrLift "RedHow_Lambda" [mkHNm i] `acoreLamTy` tcrCExpr body, sc ) + ignore _ = False + + stripScope (Evid_Proof _ (RedHow_ByScope _) [ev]) = stripScope ev + stripScope (Evid_Proof p i evs ) = Evid_Proof p i (map stripScope evs) + stripScope ev = ev + + splitOverlap (Evid_Proof p i es ) = let (es',as) = splitOverlaps es in (Evid_Proof p i es',as) + splitOverlap (Evid_Ambig p ess@((i,es):_)) = let (es',_ ) = splitOverlaps es in (Evid_Proof p i es',[OverlapEvid p (map fst ess)]) + splitOverlap ev = (ev,[]) + splitOverlaps es = let (es',as) = unzip $ map splitOverlap es in (es',concat as) + + dbg m = id -- Debug.tr m empty +-} + +{-# LINE 555 "src/ehc/Pred/EvidenceToCore.chs" #-} +evidKeyCoreMpToBinds :: FIIn' gm -> EvidKeyToCExprMap -> (EvidKeyToCBindMap,PredScopeToCBindMap) +evidKeyCoreMpToBinds env m + = dbg "evidKeyCoreMpToBinds.res" + $! + ( dbg "evidKeyCoreMpToBinds.res1" + $! Map.unionsWith (++) + $ map (\(b,uses) + -> let deepestScope = subevdId . maximumBy (\evd1 evd2 -> subevdScope evd1 `pscpCmpByLen` subevdScope evd2) . Set.toList + in Map.singleton (deepestScope uses) [b] + ) + $ [ (acoreBind1MetaTy (mkHNm i) CMetaVal_Dict (SysF.ty2TyCforFFI opts $ tcrTy r) (tcrCExpr r),tcrUsed r) + | (i,r) <- dbg "evidKeyCoreMpToBinds.dependentOnAssumes" $! Map.toList dependentOnAssumes + ] + , dbg "evidKeyCoreMpToBinds.res2" + $! Map.fromListWith (++) + $ [ (tcrScope r,[acoreBind1MetaTy (mkHNm i) CMetaVal_Dict (SysF.ty2TyCforFFI opts $ tcrTy r) (tcrCExpr r)]) + | (i,r) <- dbg "evidKeyCoreMpToBinds.independentOfAssumes" $! Map.toList independentOfAssumes + ] + ) + where (independentOfAssumes, dependentOnAssumes) + = dbg "evidKeyCoreMpToBinds.partition" + $! Map.partition (\r -> Set.null (tcrUsed r)) + $ dbg "evidKeyCoreMpToBinds.m" + $! m + dbg m = id -- Debug.tr m (pp m) + opts = feEHCOpts $ fiEnv env + +{-# LINE 595 "src/ehc/Pred/EvidenceToCore.chs" #-} +type EvidCBindL = [CBind] + +evidKeyCoreMpToBinds2 :: FIIn' gm -> EvidKeyToCExprMap -> (EvidCBindL,EvidKeyToCBindMap,PredScopeToCBindMap) +evidKeyCoreMpToBinds2 env m + = ( [ mkd i (tcrCExpr r) (SysF.ty2TyCforFFI opts $ tcrTy r) + | (i,r) <- Map.toList independentOfAssumes + ] + , Map.unionsWith (++) + $ [ Map.singleton (subevdId $ head $ Set.toList $ tcrUsed r) [mkd i (tcrCExpr r) (SysF.ty2TyCforFFI opts $ tcrTy r)] + | (i,r) <- Map.toList dependentOn1Assume + ] + , Map.unionsWith (++) + $ [ Map.singleton (deepestScope (tcrScope r) (tcrUsed r)) [mkd i (tcrCExpr r) (SysF.ty2TyCforFFI opts $ tcrTy r)] + | (i,r) <- Map.toList dependentOnNAssumes + ] + ) + where (independentOfAssumes, dependentOnAssumes) + = Map.partition (\r -> Set.null $ tcrUsed r) m + (dependentOn1Assume, dependentOnNAssumes) + = Map.partition (\r -> Set.size (tcrUsed r) == 1) m + mkd i e t = acoreBind1MetaTy (mkHNm i) CMetaVal_Dict t e + deepestScope sc u = maximumBy pscpCmpByLen $ sc : (map subevdScope $ Set.toList u) + opts = feEHCOpts $ fiEnv env + +{-# LINE 622 "src/ehc/Pred/EvidenceToCore.chs" #-} +evidKeyBindMpToCSubst :: EvidKeyToCBindMap -> CSubst +evidKeyBindMpToCSubst + = acoreCSubstFromUidBindLL . Map.toList + diff --git a/src/UHC/Light/Compiler/Pred/Heuristics.hs b/src/UHC/Light/Compiler/Pred/Heuristics.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/Heuristics.hs @@ -0,0 +1,212 @@ +module UHC.Light.Compiler.Pred.Heuristics +( Heuristic, SHeuristic +, HeurAlts (..), HeurRed (..) +, toHeuristic +, heurTry +, localChoice +, binChoice +, solvable +, heurScopedEHC ) +where +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.Evidence +import UHC.Light.Compiler.CHR.Constraint +import Data.List (nub,partition) +import Data.Maybe +import UHC.Util.Pretty +import UHC.Util.AGraph +import UHC.Util.Utils + +{-# LINE 17 "src/ehc/Pred/Heuristics.chs" #-} +type Heuristic p info = [info] -> HeurAlts p info -> [(info, Evidence p info)] + +type SHeuristic p info = HeurAlts p info -> Evidence p info + +{-# LINE 45 "src/ehc/Pred/Heuristics.chs" #-} +data HeurAlts p info + = HeurAlts + { redaltsPredicate :: p + , redaltsAlts :: [HeurRed p info] + } + +data HeurRed p info + = HeurRed + { redInfo :: info + , redContext :: [HeurAlts p info] + } + | HeurRed_Rec + { redRecPred :: p + } + +{-# LINE 62 "src/ehc/Pred/Heuristics.chs" #-} +instance Show (HeurAlts p info) where + show _ = "HeurAlts" + +instance Show (HeurRed p info) where + show _ = "HeurRed" + +{-# LINE 70 "src/ehc/Pred/Heuristics.chs" #-} +instance (PP p, PP info) => PP (HeurAlts p info) where + pp x = "HeurAlts" >#< redaltsPredicate x >#< ppBracketsCommasBlock (redaltsAlts x) + +instance (PP p, PP info) => PP (HeurRed p info) where + pp (HeurRed i subs) = "HeurRed" >#< i >#< ppBracketsCommasBlock subs + pp (HeurRed_Rec p ) = "HeurRec" >#< p + +{-# LINE 83 "src/ehc/Pred/Heuristics.chs" #-} +toHeuristic :: SHeuristic p info -> Heuristic p info +toHeuristic h infos alts + = zip infos (repeat ev) + where ev = h alts + +{-# LINE 94 "src/ehc/Pred/Heuristics.chs" #-} +heurTry :: Eq p => SHeuristic p info -> SHeuristic p info -> SHeuristic p info +heurTry f g a | null (evidUnresolved ev) = ev + | otherwise = g a + where ev = f a + +{-# LINE 105 "src/ehc/Pred/Heuristics.chs" #-} +localChoice :: (Eq p, Eq info) => (p -> [info] -> [info]) -> SHeuristic p info +localChoice choose (HeurAlts p reds) = + case filter ((`elem` redinfos) . redInfo) reds of + [] -> Evid_Unresolved p (concatMap evidUnresolved [ Evid_Proof p i evs | (i,evs) <- chs reds]) + [r@(HeurRed_Rec p)] -> Evid_Recurse p + [r@(HeurRed i _)] -> Evid_Proof p i (snd $ ch r) + rs -> reallyOverlapEvid p (chs rs) + where redinfos = choose p (map redInfo reds) + ch (HeurRed i rs) = (i,map (localChoice choose) rs) + chs rs = map ch rs + +{-# LINE 118 "src/ehc/Pred/Heuristics.chs" #-} +binChoice :: (Eq p, Eq info) => (info -> info -> PartialOrdering) -> SHeuristic p info +binChoice order = localChoice (const local) + where local [] = [] + local is = [mx] + where (mx,eqPairs) = heurMaximumBy order is + +{-# LINE 126 "src/ehc/Pred/Heuristics.chs" #-} +-- | Choose maximum, also giving list of equals of there are more maximum x-es +heurChoose :: (x -> x -> PartialOrdering) -> (x,[x]) -> x -> (x,[x]) +heurChoose cmp (x,eqPairs) y + = case cmp x y of + P_LT -> (y,[]) + P_GT -> (x,eqPairs) + P_EQ -> (x,if null eqPairs then [x,y] else y:eqPairs) + +heurMaximumBy :: (x -> x -> PartialOrdering) -> [x] -> (x,[x]) +heurMaximumBy cmp (x:xs) + = foldl (heurChoose cmp) (x,[]) xs + +{-# LINE 144 "src/ehc/Pred/Heuristics.chs" #-} +contextChoice :: Eq p => (p -> [HeurRed p info] -> [HeurRed p info]) -> SHeuristic p info +contextChoice choose (HeurAlts p reds) = + case choose p reds of + [] -> Evid_Unresolved p [UnresolvedTrace_Fail p []] + [r@(HeurRed_Rec p)] -> Evid_Recurse p + [r@(HeurRed i _)] -> Evid_Proof p i (snd $ ch r) + rs -> reallyOverlapEvid p (chs rs) + where ch (HeurRed i rs) = (i,map (contextChoice choose) rs) + chs rs = map ch rs + +contextBinChoice :: Eq p => (HeurRed p info -> HeurRed p info -> PartialOrdering) -> SHeuristic p info +contextBinChoice order = contextChoice (const local) + where local [] = [] + local is | null eqPairs = [mx] + | otherwise = eqPairs + where (mx,eqPairs) = heurMaximumBy order is -- do something with equal pairs, construct Evid_Ambig perhaps? + +{-# LINE 169 "src/ehc/Pred/Heuristics.chs" #-} +reallyOverlapEvid :: p -> [(info,[Evidence p info])] -> Evidence p info +reallyOverlapEvid p evs + = case filter (not . null . snd) evs of + [] -> Evid_Ambig p evs + [(i,ev)] -> Evid_Proof p i ev + _ -> Evid_Ambig p evs + +{-# LINE 188 "src/ehc/Pred/Heuristics.chs" #-} +solvable :: HeurAlts p info -> HeurAlts p info +solvable (HeurAlts p rs) = HeurAlts p (catMaybes (map heu rs)) + where heu h@(HeurRed info reds) | all hasAlts reds' = Just (HeurRed info reds') + | otherwise = Nothing + where reds' = map solvable reds + heu h@(HeurRed_Rec p ) = Just h + +hasAlts :: HeurAlts p info -> Bool +hasAlts (HeurAlts _ []) = False +hasAlts _ = True + +{-# LINE 207 "src/ehc/Pred/Heuristics.chs" #-} +cmpSpecificness :: CHRMatchable (FIIn' gm) Pred VarMp => FIIn' gm -> Pred -> Pred -> PartialOrdering +cmpSpecificness env p q = + case chrMatchTo env (emptyVarMp :: VarMp) p q of + Nothing -> P_GT + Just _ -> case chrMatchTo env (emptyVarMp :: VarMp) q p of + Nothing -> P_LT + Just _ -> P_EQ + +{-# LINE 284 "src/ehc/Pred/Heuristics.chs" #-} +cmpEqReds :: RedHowAnnotation -> RedHowAnnotation -> PartialOrdering +cmpEqReds r1 r2 = panic ("cmpEqReds: don't know how to deal with: " ++ show (pp r1) ++ " and " ++ show (pp r2)) + +{-# LINE 307 "src/ehc/Pred/Heuristics.chs" #-} +anncmpEHCScoped :: CHRMatchable (FIIn' gm) Pred VarMp => Bool -> FIIn' gm -> HeurRed CHRPredOcc RedHowAnnotation -> HeurRed CHRPredOcc RedHowAnnotation -> PartialOrdering +anncmpEHCScoped preferInst env ann1 ann2 + = case (ann1,ann2) of + (HeurRed (RedHow_Assumption _ _) _ , _ ) -> P_GT + (_ , HeurRed (RedHow_Assumption _ _) _ ) -> P_LT + (HeurRed (RedHow_ByScope ByScopeRedHow_Assume) _ + , _ ) -> P_GT + (_ , HeurRed (RedHow_ByScope ByScopeRedHow_Assume) _) -> P_LT + (HeurRed_Rec _ , _ ) -> P_GT + (_ , HeurRed_Rec _ ) -> P_LT + (HeurRed (RedHow_ByInstance _ p s) _ , HeurRed (RedHow_ByInstance _ q t) _ ) -> case pscpCmpByLen s t of + EQ -> cmpSpecificness env p q + ord -> toPartialOrdering ord + (HeurRed (RedHow_ByInstance _ _ s) _ , HeurRed (RedHow_ByScope _) [HeurAlts q _]) -> toPartialOrdering $ pscpCmpByLen s (cpoScope q) + (HeurRed (RedHow_ByScope _) [HeurAlts p _], HeurRed (RedHow_ByInstance _ _ t) _ ) -> toPartialOrdering $ pscpCmpByLen (cpoScope p) t + (HeurRed (RedHow_ByInstance _ _ _) _ , _ ) | preferInst -> P_GT + (_ , HeurRed (RedHow_ByInstance _ _ _) _ ) | preferInst -> P_LT + (HeurRed (RedHow_ByLabel _ _ s) _ , HeurRed (RedHow_ByLabel _ _ t) _ ) -> toPartialOrdering $ pscpCmpByLen s t + (HeurRed (RedHow_ByLabel _ _ _) _ , _ ) -> P_GT + (_ , HeurRed (RedHow_ByLabel _ _ _) _ ) -> P_LT + (HeurRed (RedHow_BySuperClass _ _ _) _ , _ ) -> P_GT + (_ , HeurRed (RedHow_BySuperClass _ _ _) _ ) -> P_LT + (HeurRed (RedHow_ByScope _) [HeurAlts p _], HeurRed (RedHow_ByScope _) [HeurAlts q _]) -> toPartialOrdering $ pscpCmpByLen (cpoScope p) (cpoScope q) + (HeurRed (RedHow_ByScope _) _ , _ ) -> P_GT + (_ , HeurRed (RedHow_ByScope _) _ ) -> P_LT + (HeurRed (RedHow_ByInstance _ _ _) _ , _ ) -> P_GT + (_ , HeurRed (RedHow_ByInstance _ _ _) _ ) -> P_LT + _ -> panic ("anncmpEHCScoped: don't know how to deal with:\n " ++ show (pp ann1) ++ "\n " ++ show (pp ann2)) + +{-# LINE 353 "src/ehc/Pred/Heuristics.chs" #-} +heurScopedEHC :: CHRMatchable (FIIn' gm) Pred VarMp => FIIn' gm -> Heuristic CHRPredOcc RedHowAnnotation +heurScopedEHC env + = toHeuristic + $ ifthenelseSHeuristic isEqHeuristic + eqHeuristic +{- + defaultHeuristic +-} +{- + $ heurTry (contextBinChoice (anncmpEHCScoped True env)) + -- (contextBinChoice (anncmpEHCScoped False env)) + (contextChoice ehcOnlySuperReduce) +-} + $ contextBinChoice (anncmpEHCScoped True env) + where + isEqHeuristic _ = False + eqHeuristic = binChoice cmpEqReds . solvable +{- + defaultHeuristic + = contextBinChoice (anncmpEHCScoped env) +-} + +ifthenelseSHeuristic :: (p -> Bool) -> SHeuristic p info -> SHeuristic p info -> SHeuristic p info +ifthenelseSHeuristic g t e alts + | g (redaltsPredicate alts) = t alts + | otherwise = e alts + diff --git a/src/UHC/Light/Compiler/Pred/RedGraph.hs b/src/UHC/Light/Compiler/Pred/RedGraph.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/RedGraph.hs @@ -0,0 +1,117 @@ +module UHC.Light.Compiler.Pred.RedGraph +( module UHC.Util.AGraph +, RedNode (..) +, RedGraph, emptyRedGraph +, mkRedGraphFromReductions, addToRedGraphFromReductions +, addToRedGraphFromAssumes, mkRedGraphFromAssumes +, ppRedGraph +, addAssumption +, addReduction +, redPruneReductionsUntil +, redAlternatives ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import Data.Maybe +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.Pred.Heuristics +import qualified Data.Map as Map +import qualified Data.Set as Set +import UHC.Util.AGraph +import UHC.Util.Pretty +import Data.Graph.Inductive.Graph +import UHC.Util.Utils + +{-# LINE 34 "src/ehc/Pred/RedGraph.chs" #-} +data RedNode p + = Red_Pred { rednodePred :: !p } + | Red_And { rednodePreds :: ![p] } + deriving (Eq, Ord) + +mkRedNode :: [p] -> RedNode p +mkRedNode [p] = Red_Pred p +mkRedNode ps = Red_And ps + +redNodePreds :: RedNode p -> [p] +redNodePreds (Red_Pred q) = [q] +redNodePreds (Red_And qs) = qs + +true :: RedNode p +true = mkRedNode [] + +{-# LINE 52 "src/ehc/Pred/RedGraph.chs" #-} +type RedGraph p info = AGraph (RedNode p) info + +emptyRedGraph :: Ord p => RedGraph p i +emptyRedGraph = emptyAGraph + +{-# LINE 59 "src/ehc/Pred/RedGraph.chs" #-} +addToRedGraphFromReductions :: Ord p => [Constraint p info] -> RedGraph p info -> RedGraph p info +addToRedGraphFromReductions cs g = foldr addReduction g cs + +mkRedGraphFromReductions :: Ord p => [Constraint p info] -> RedGraph p info +mkRedGraphFromReductions cs = addToRedGraphFromReductions cs emptyRedGraph + +{-# LINE 67 "src/ehc/Pred/RedGraph.chs" #-} +addToRedGraphFromAssumes :: Ord p => ConstraintToInfoMap p info -> RedGraph p info -> RedGraph p info +addToRedGraphFromAssumes cm g = Map.foldrWithKey addAssumption g cm + +mkRedGraphFromAssumes :: Ord p => ConstraintToInfoMap p info -> RedGraph p info +mkRedGraphFromAssumes cm = addToRedGraphFromAssumes cm emptyRedGraph + +{-# LINE 75 "src/ehc/Pred/RedGraph.chs" #-} +instance PP p => Show (RedNode p) where + show = showPP . pp + +instance PP p => PP (RedNode p) where + pp (Red_Pred p) = pp p + pp (Red_And []) = pp "True" + pp (Red_And _ ) = pp "And" + +{-# LINE 85 "src/ehc/Pred/RedGraph.chs" #-} +ppRedGraph :: (PP p, PP i) => RedGraph p i -> PP_Doc +ppRedGraph ag = "RedGraph" >-< indent 2 ((ppBracketsCommasBlock $ nodes g) >-< (ppBracketsCommasBlock $ edges g) >-< pp (show g)) + where g = agraphGraph ag + +{-# LINE 95 "src/ehc/Pred/RedGraph.chs" #-} +addAssumption :: Ord p => Constraint p info -> [info] -> RedGraph p info -> RedGraph p info +addAssumption (Assume p) is = insertEdges (zip3 (repeat (Red_Pred p)) (repeat true) is) +addAssumption _ _ = id + +{-# LINE 101 "src/ehc/Pred/RedGraph.chs" #-} +addReduction :: Ord p => Constraint p info -> RedGraph p info -> RedGraph p info +addReduction (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=[q]}) + = insertEdge (Red_Pred p, Red_Pred q , i) +addReduction (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps}) + = let andNd = Red_And ps + edges = map (\q -> (andNd, Red_Pred q, i)) ps + in insertEdges ((Red_Pred p, andNd, i) : edges) +addReduction _ = id + +{-# LINE 119 "src/ehc/Pred/RedGraph.chs" #-} +redPruneReductionsUntil :: (Ord p) => [p] -> (p -> Bool) -> RedGraph p info -> RedGraph p info +redPruneReductionsUntil leaves stop gr + = dels (map Red_Pred leaves) gr + where dels leaves g = foldr del g leaves + del leaf g | all (not . stop) + $ redNodePreds leaf = dels (map snd pres) + $ deleteNode leaf + $ foldr (\(_,from) g -> deleteEdge (from,leaf) g) g pres + | otherwise = g + where pres = predecessors g leaf + +{-# LINE 136 "src/ehc/Pred/RedGraph.chs" #-} +redAlternatives :: (Ord p {-, PP p, PP info debug -}) => RedGraph p info -> p -> HeurAlts p info +redAlternatives gr + = recOr Set.empty + where recOr visited p = HeurAlts p (map (recAnd visited') (successors gr (Red_Pred p))) + where visited' = Set.insert p visited + + recAnd visited (i, n) + = HeurRed i (map mk qs) + where qs = redNodePreds n + mk q | Set.member q visited = HeurAlts q [HeurRed_Rec q] + | otherwise = recOr visited q + diff --git a/src/UHC/Light/Compiler/Pred/ToCHR.hs b/src/UHC/Light/Compiler/Pred/ToCHR.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Pred/ToCHR.hs @@ -0,0 +1,353 @@ +module UHC.Light.Compiler.Pred.ToCHR +( ScopedPredStore, ScopedPredCHR, ScopedPredStoreL +, CHRRedGraph +, CHRClassDecl, CHRScopedInstanceDecl +, CHRPredOccEvidMp +, initScopedPredStore +, mkScopedCHR2 +, SimplifyResult (..), emptySimplifyResult +, simplifyResultResetForAdditionalWork +, partitionUnresolved2AssumableAndOthers +, patchUnresolvedWithAssumption +, chrSimplifySolveToRedGraph +, chrSimplifyRedGraphToEvidence ) +where +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Ftv +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.CHR +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence +import UHC.Light.Compiler.Pred.RedGraph +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty.Trf.Canonic +import UHC.Util.Pretty +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName.Builtin + + +{-# LINE 36 "src/ehc/Pred/ToCHR.chs" #-} +type PredStore p g s info = CHRStore p info g s +type PredStoreL p g s info = [CHR (Constraint p info) g s] +type ScopedPredStore = PredStore CHRPredOcc Guard VarMp RedHowAnnotation +type ScopedPredStoreL = PredStoreL CHRPredOcc Guard VarMp RedHowAnnotation +type ScopedPredCHR = CHR CHRConstraint Guard VarMp + +{-# LINE 48 "src/ehc/Pred/ToCHR.chs" #-} +type CHRRedGraph = RedGraph CHRPredOcc RedHowAnnotation + +{-# LINE 56 "src/ehc/Pred/ToCHR.chs" #-} +type CHRClassDecl a info = ([a], a, [info]) +type CHRInstanceDecl a info = ([a], a, info) +type CHRScopedInstanceDecl a info sc = ([a], a, info, sc) + +{-# LINE 66 "src/ehc/Pred/ToCHR.chs" #-} +type CHRPredOccEvidMp = InfoToEvidenceMap CHRPredOcc RedHowAnnotation + +{-# LINE 74 "src/ehc/Pred/ToCHR.chs" #-} +type MkRes1 = (ScopedPredStore, ([CHRPredOcc],CHRPredOcc) ) +type MkResN = (ScopedPredStore,[([CHRPredOcc],CHRPredOcc)]) + +{-# LINE 83 "src/ehc/Pred/ToCHR.chs" #-} +([sc1,sc2,sc3] + ,[pr1,pr2,pr3] + ,[ty1,ty2,ty3,ty4] + ,[lab1] + ,[off1] + ,[pr1v] + ,[pa1] + ) + = ( map PredScope_Var [u1,u2,u3] + , map Pred_Var [u7,u8,u9] + , map mkTyMetaVar {- mkTyVar -} [u10,u11,u14,u15] + , map Label_Var [u12] + , map LabelOffset_Var [u13] + , [u7] + , map PredSeq_Var [u4] + ) + where [u1,u2,u3,u4,u5,u6,u7,u8,u9,u10,u11,u12,u13,u14,u15] = mkNewLevUIDL 15 uidStart + +{-# LINE 128 "src/ehc/Pred/ToCHR.chs" #-} +-- | The basic initial set of CHRs +initScopedPredStore :: ScopedPredStore +initScopedPredStore + = chrStoreFromElems $ + [ scopeProve, {- scopeAssum1, -} scopeAssum2 ] + ++ [ labelProve1, labelProve2 ] + ++ [ instForall, predArrow, predSeq1, predSeq2 ] + where p1s1 = mkCHRPredOcc pr1 sc1 + p1s2 = mkCHRPredOcc pr1 sc2 + p1s3 = mkCHRPredOcc pr1 sc3 + scopeProve = [Prove p1s1, Prove p1s2] + ==> [mkReduction p1s2 (RedHow_ByScope (ByScopeRedHow_Other $ AlwaysEq "prv")) [p1s3]] + |> [IsStrictParentScope sc3 sc1 sc2] +{- + scopeAssum1 = [Prove p1s1, Assume p1s2] + ==> [mkReduction p1s1 (RedHow_Assumption sc2) []] + |> [EqualScope sc1 sc2] +-} + scopeAssum2 = [Prove p1s1, Assume p1s2] + ==> [mkReduction p1s1 (RedHow_ByScope ByScopeRedHow_Assume) [p1s2]] + |> [NotEqualScope sc1 sc2,IsVisibleInScope sc2 sc1] + l1s1 = mkCHRPredOcc (Pred_Lacks ty1 lab1) sc1 + l2s1 = mkCHRPredOcc (Pred_Lacks ty2 lab1) sc1 + l3s1 = mkCHRPredOcc (Pred_Lacks recRowEmp lab1) sc1 + labelProve1 = [Prove l1s1] + ==> [Prove l2s1, mkReduction l1s1 (RedHow_ByLabel lab1 off1 sc1) [l2s1]] + |> [NonEmptyRowLacksLabel ty2 off1 ty1 lab1] + labelProve2 = [Prove l3s1] + ==> [mkReduction l3s1 (RedHow_ByLabel lab1 (LabelOffset_Off 0) sc1) []] + f1s1 = mkCHRPredOcc (tyPred $ mkTyQu tyQu_Forall [(pr1v,kiStar)] $ mkTyPr pr1) sc1 -- TBD + f2s1 = mkCHRPredOcc pr1 sc1 + instForall = [Assume f1s1] + ==> [Assume f2s1] + a1s1 = mkCHRPredOcc (Pred_Arrow pa1 pr1) sc1 + a2s1 = mkCHRPredOcc pr1 sc1 + a3s1 = mkCHRPredOcc (Pred_Preds pa1) sc1 + predArrow = [Assume a1s1, Prove a2s1] + ==> [Prove a3s1, mkReduction a2s1 (RedHow_ByInstance hsnUnknown pr1 sc1) [a1s1,a3s1]] + s1s1 = mkCHRPredOcc (Pred_Preds (PredSeq_Cons pr1 pa1)) sc1 + s2s1 = mkCHRPredOcc pr1 sc1 + s3s1 = mkCHRPredOcc (Pred_Preds pa1) sc1 + predSeq1 = [Prove s1s1] + <==> [Prove s2s1, Prove s3s1] + predSeq2 = [Prove $ mkCHRPredOcc (Pred_Preds PredSeq_Nil) sc1] + <==> [] + -- inclSc = ehcCfgCHRInclScope $ feEHCOpts $ fiEnv env + +{-# LINE 217 "src/ehc/Pred/ToCHR.chs" #-} +-- | Construct CHRs from class and instance decls +mkScopedCHR2 + :: FIIn -> [CHRClassDecl Pred RedHowAnnotation] -> [CHRScopedInstanceDecl Pred RedHowAnnotation PredScope] + -> ScopedPredStore -> (ScopedPredStore,ScopedPredStore) +mkScopedCHR2 env clsDecls insts prevStore + = (chrStoreUnions [store2,instSimplStore], chrStoreUnions [assumeStore,instSimplStore]) + where ucls = mkNewLevUIDL (length clsDecls) $ fiUniq env + ((assumeStore,assumePredOccs), (instStore,_)) + = mkScopedChrs clsDecls canonInsts + store2 = chrStoreUnions [assumeStore,prevStore] + simplStores = zipWith (\u (cx,h,i) -> mkClassSimplChrs (env {fiUniq = u}) store2 (cx,h,i)) ucls clsDecls + instSimplStore + = chrStoreUnions $ instStore : simplStores + canonInsts = [ (map mkC cx, mkC hd, info, sc) | (cx,hd,info,sc) <- insts ] + where mkC = fst . predCanonic (emptyTyBetaRedEnv {tbredFI=env}) + +{-# LINE 235 "src/ehc/Pred/ToCHR.chs" #-} +-- | Construct simplification CHRs from class decls, building upon a given CHR store +mkClassSimplChrs :: FIIn -> ScopedPredStore -> CHRClassDecl Pred RedHowAnnotation -> ScopedPredStore +mkClassSimplChrs env rules (context, head, infos) + = simps + where simps = chrStoreFromElems $ mapTrans (Set.fromList [head1]) [] head1 (zip infos (map (\p -> Red_Pred $ mkCHRPredOcc p sc1) context)) + superClasses = chrSolve env rules (map (\p -> Assume $ mkCHRPredOcc p sc1) context) + graph = mkRedGraphFromReductions superClasses + head1 = mkCHRPredOcc head sc1 + head2 = mkCHRPredOcc head sc2 + head3 = mkCHRPredOcc head sc3 + + mapTrans done reds subClass + = concatMap (transClosure done reds subClass) + . filter (\(_,x) -> not (rednodePred x `Set.member` done)) + + transClosure done reds par (info, pr@(Red_Pred p@(CHRPredOcc {cpoPr = super}))) + = [superRule] ++ ({-if ehcCfgCHRScoped opts >= CHRScopedMutualSuper then -} [scopeRule1, scopeRule2] {- else [] -}) ++ rules + where super1 = mkCHRPredOcc super sc1 + super2 = mkCHRPredOcc super sc2 + super3 = mkCHRPredOcc super sc3 + superRule = [Prove head1, Prove p] ==> reds' + scopeRule1 = [Prove head1, Prove super2] + ==> [Prove head3, mkReduction head1 (RedHow_ByScope (ByScopeRedHow_Other $ AlwaysEq "sup1")) [head3]] + |> [HasStrictCommonScope sc3 sc1 sc2] + scopeRule2 = [Prove head2, Prove super1] + ==> [Prove super3, mkReduction super1 (RedHow_ByScope (ByScopeRedHow_Other $ AlwaysEq "sup2")) [super3]] + |> [HasStrictCommonScope sc3 sc1 sc2] + reds' = mkReduction p info [par] : reds + rules = mapTrans (Set.insert p done) reds' p (predecessors graph pr) + + opts = feEHCOpts $ fiEnv env + +mkScopedChrs :: [CHRClassDecl Pred RedHowAnnotation] -> [CHRScopedInstanceDecl Pred RedHowAnnotation PredScope] -> (MkResN,MkResN) +mkScopedChrs clsDecls insts + = ((chrStoreUnions assumeStores,assumePredOccs), instChrs) + where (assumeStores,assumePredOccs) = unzip $ mapMaybe mkAssumeChrs clsDecls + instChrs = mkInstanceChrs insts + +mkAssumeChrs :: CHRClassDecl Pred RedHowAnnotation -> Maybe MkRes1 +mkAssumeChrs ([] , _ , _ ) = Nothing +mkAssumeChrs (context, head, infos) = + let prThis = mkCHRPredOcc head sc1 + super prSuper info = [Assume prSuper, mkReduction prSuper info [prThis]] + prSuper = map (\c -> mkCHRPredOcc c sc1) context + in Just ( chrStoreSingletonElem $ [Assume prThis] ==> concat (zipWith super prSuper infos) + , (prSuper,prThis) + ) + +mkInstanceChrs :: [CHRScopedInstanceDecl Pred RedHowAnnotation PredScope] -> MkResN +mkInstanceChrs insts + = (chrStoreUnions instStores,instChrs) + where (instStores,instChrs) = unzip $ map mkInstanceChr insts + +mkInstanceChr :: CHRScopedInstanceDecl Pred RedHowAnnotation PredScope -> MkRes1 +mkInstanceChr (context, hd, i, s) + = ( chrStoreSingletonElem + $ [Prove constraint] + ==> mkReduction constraint i body : map Prove body + |> [s `IsVisibleInScope` sc1] + , (body,constraint) + ) + where constraint = mkCHRPredOcc hd sc1 + body = map (\p -> mkCHRPredOcc p sc1) context + +{-# LINE 307 "src/ehc/Pred/ToCHR.chs" #-} +data SimplifyResult p i g s + = SimplifyResult + { simpresSolveState :: SolveState p i g s + , simpresRedGraph :: RedGraph p i + + -- for debugging only: + , simpresRedAlts :: [HeurAlts p i] + , simpresRedTrees :: [[(i, Evidence p i)]] + , simpresRedGraphs :: [(String,RedGraph p i)] + , simpresRemPredL :: [p] -- remaining pred occurrences, which cannot be proven, as a list + } + +emptySimplifyResult :: Ord p => SimplifyResult p i g s +emptySimplifyResult + = SimplifyResult + emptySolveState emptyRedGraph + [] [] [] [] + +{-# LINE 327 "src/ehc/Pred/ToCHR.chs" #-} +simplifyResultResetForAdditionalWork :: Ord p => SimplifyResult p i g s -> SimplifyResult p i g s +simplifyResultResetForAdditionalWork r = r {simpresRedGraph = emptyRedGraph} + +{-# LINE 337 "src/ehc/Pred/ToCHR.chs" #-} +mkEvidence + :: ( Ord p, Ord i + ) => Heuristic p i -> ConstraintToInfoMap p i -> RedGraph p i + -> ( -- ConstraintToInfoMap p i -- remaining constraints + ConstraintToInfoTraceMp p i -- remaining constraints + , InfoToEvidenceMap p i -- mapping to evidence + , [Err] -- errors + ) +mkEvidence heur cnstrMp redGraph + = ( {- (cnstrMp `Map.intersection` remCnstrMp) `Map.union` -} + cnstrTraceMpFromList remCnstrMp + , evidMp + , err + ) + where (remCnstrMp,evidMp,err,dbg) + = foldl (\(cm,em,err,dbg) c -> let (cm',em',err',dbg') = mk c in (cm' ++ cm, evidMpUnion em' em, err' ++ err, dbg' ++ dbg)) + ([],Map.empty,[],[]) + $ Map.toList cnstrMp + mk (Prove p, infos) + = (remCnstrMp,evidMp,[],[(redAlts,redTrees)]) + where redAlts = redAlternatives redGraph p + redTrees = heur infos redAlts + evidMp = foldr (uncurry evidMpInsert) Map.empty redTrees + remCnstrMp = [ (Prove (utraceRedFrom u),(i,[u])) | (i,t) <- redTrees, u <- evidUnresolved t ] + mk (c, infos) + = ([ (c,(i,[])) | i <- infos],Map.empty,[],[]) + +{-# LINE 400 "src/ehc/Pred/ToCHR.chs" #-} +partitionUnresolved2AssumableAndOthers :: CHRPredOccCnstrTraceMp -> ([CHRIntermediateUntilAssume],CHRPredOccCnstrTraceMp) +partitionUnresolved2AssumableAndOthers unresCnstrMp + = (unres,cannotResCnstrMp) + where (unresCnstrMp',cannotResCnstrMp) + = Map.partitionWithKey canAssume unresCnstrMp + where -- if p only ranges over non-fixed tvars, we potentially can assume them (if not found ambiguous later) + canAssume (Prove p) _ = Map.null $ Map.filter (tvCatIsFixed . tvinfoCateg) $ tyFtvMp $ predTy $ cpoPr p + canAssume _ _ = True + unres = [ (p,x) | (Prove p,x) <- shareUnresolvedAssumptionsByScope (unresCnstrMp') ] + +{-# LINE 412 "src/ehc/Pred/ToCHR.chs" #-} +-- | Group unresolved constraints, reducing the various scopes to the outermost scope. +-- Find assume's wich have a common scope prefix, then share these. +-- Assumption: we will never share outer scopes because we only get passed inner scopes, because these will be abstracted over in bindings of a let expression. +shareUnresolvedAssumptionsByScope :: CHRPredOccCnstrTraceMp -> [(CHRConstraint,(PredScope,CHRPredOccCnstrTraceMp))] +shareUnresolvedAssumptionsByScope unres + = [ ( c + , ( -- the common prefix off all scopes, i.e. the most global scope + foldr1 (\s1 s2 -> panicJust "shareUnresolvedAssumptionsByScope" $ pscpCommon s1 s2) + [ cpoScope $ cnstrPred c | (c,_) <- cs ] + -- all original info for this predicate + , Map.fromList cs + ) + ) + | cs@((c,_):_) <- + -- sort, then group by predicate, so we get all scopes for each predicate + groupSortOn (cpoPr . cnstrPred . fst) $ Map.toList unres + ] + +{-# LINE 436 "src/ehc/Pred/ToCHR.chs" #-} +-- | Transform unresolved Prove constraints to Assume variants, used either for quantification over, or for error messages about unresolved predicates +patchUnresolvedWithAssumption :: FIIn -> [CHRIntermediateUntilAssume] -> CHRRedGraph -> CHRPredOccEvidMp -> (CHRPredOccCnstrTraceMp,CHRPredOccEvidMp) +patchUnresolvedWithAssumption env unres redGraph evidMp + = ( assumeCnstrs + , evidMpSubst (\p -> Map.lookup p assumeSubstMp) evidMp + ) + where us = mkNewLevUIDL (length unres) $ fiUniq env + assumeCnstrs + = cnstrMpUnions + [ cnstrTraceMpSingleton c i (concat [ us | es <- Map.elems trMap, (_,us) <- es ]) + | ((p,(sc,trMap)),u) <- zip unres us + , let (c,i) = rngLift emptyRange mkAssumeConstraint (cpoPr p) u sc + ] + assumeSubstMp + = Map.fromList [ (p,Evid_Proof p i []) | (Assume p,((i,_):_)) <- Map.toList assumeCnstrs ] + +{-# LINE 458 "src/ehc/Pred/ToCHR.chs" #-} +chrSimplifySolveToRedGraph + :: ( Ord p, Ord i + , CHRMatchable FIIn p s, CHRCheckable FIIn g s + , VarLookupCmb s s + , VarUpdatable s s, VarUpdatable g s, VarUpdatable i s, VarUpdatable p s + , CHREmptySubstitution s + , PP g, PP i, PP p -- for debugging + ) => FIIn -> CHRStore p i g s -> ConstraintToInfoMap p i -> ConstraintToInfoMap p i + -> SimplifyResult p i g s + -> ( ConstraintToInfoMap p i + , SimplifyResult p i g s + ) +chrSimplifySolveToRedGraph env chrStore cnstrInfoMpPrev cnstrInfoMp prevRes + = ( cnstrInfoMpAll + , emptySimplifyResult + { simpresSolveState = solveState + , simpresRedGraph = redGraph + , simpresRedGraphs = ("chrSimplifySolveToRedGraph",redGraph) : simpresRedGraphs prevRes + } + ) + where (_,u1,u2) = mkNewLevUID2 $ fiUniq env + solveState = chrSolve'' (env {fiUniq = u1}) chrStore (Map.keys $ cnstrInfoMp `Map.difference` cnstrInfoMpPrev) (simpresSolveState prevRes) + cnstrInfoMpAll = cnstrMpUnion cnstrInfoMp cnstrInfoMpPrev + redGraph + = addToRedGraphFromReductions (chrSolveStateDoneConstraints solveState) + $ addToRedGraphFromAssumes cnstrInfoMpAll + $ simpresRedGraph prevRes + +{-# LINE 492 "src/ehc/Pred/ToCHR.chs" #-} +chrSimplifyRedGraphToEvidence + :: ( Ord p, Ord i + ) => Heuristic p i -> ConstraintToInfoMap p i + -> SimplifyResult p i g s + -> ( ( ConstraintToInfoTraceMp p i, InfoToEvidenceMap p i, [Err] ) + , SimplifyResult p i g s + ) +chrSimplifyRedGraphToEvidence heur cnstrInfoMpAll simpRes + = ( (chrSolveRemCnstrMp,chrSolveEvidMp,chrSolveErrs) + , simpRes + ) + where ( chrSolveRemCnstrMp,chrSolveEvidMp,chrSolveErrs + ) + = mkEvidence heur cnstrInfoMpAll (simpresRedGraph simpRes) + diff --git a/src/UHC/Light/Compiler/Scanner/Common.hs b/src/UHC/Light/Compiler/Scanner/Common.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Scanner/Common.hs @@ -0,0 +1,740 @@ +module UHC.Light.Compiler.Scanner.Common +( module UHC.Light.Compiler.Scanner.Common +, module UHC.Light.Compiler.Scanner.Scanner ) +where +import System.IO +import UU.Parsing +import UU.Parsing.Offside +import UU.Scanner.Position +import UU.Scanner.GenToken +import UU.Scanner.GenTokenParser +import UHC.Util.ScanUtils () +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts.Base +import qualified Data.Set as Set +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Scanner +import UHC.Util.ParseUtils +import UHC.Light.Compiler.Base.Target +import Data.Ratio + + + + + +{-# LINE 49 "src/ehc/Scanner/Common.chs" #-} +ehScanOpts :: EHCOpts -> ScanOpts +ehScanOpts opts + = defaultScanOpts +{-# LINE 54 "src/ehc/Scanner/Common.chs" #-} + { scoKeywordsTxt = + Set.fromList $ + tokKeywStrsEH1 + ++ offsideTrigs +{-# LINE 60 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH4 +{-# LINE 63 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH5 +{-# LINE 66 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH6 +{-# LINE 69 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH8 +{-# LINE 72 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH9 +{-# LINE 75 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH11 +{-# LINE 78 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH12 +{-# LINE 81 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH90 +{-# LINE 84 "src/ehc/Scanner/Common.chs" #-} + ++ tokKeywStrsEH91 +{-# LINE 87 "src/ehc/Scanner/Common.chs" #-} + ++ (if ehcOptFusion opts then tokKeywStrsEH93 else []) +{-# LINE 90 "src/ehc/Scanner/Common.chs" #-} + , scoKeywordsOps = + Set.fromList $ + tokOpStrsEH1 +{-# LINE 95 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH2 +{-# LINE 98 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH3 +{-# LINE 101 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH4 +{-# LINE 104 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH5 +{-# LINE 107 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH6 +{-# LINE 110 "src/ehc/Scanner/Common.chs" #-} + ++ (if ehcOptExtensibleRecords opts then tokOpStrsEH7 else []) +{-# LINE 113 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH9 +{-# LINE 116 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH10 +{-# LINE 119 "src/ehc/Scanner/Common.chs" #-} + ++ tokOpStrsEH11 +{-# LINE 122 "src/ehc/Scanner/Common.chs" #-} + , scoSpecChars = Set.fromList $ + "();,[]{}`" + , scoOpChars = Set.fromList $ + "!#$%&*+/<=>?@\\^|-:.~" +{-# LINE 128 "src/ehc/Scanner/Common.chs" #-} + , scoSpecPairs = Set.fromList $ + [ show hsnORow, show hsnCRow + , show hsnOSum, show hsnCSum + , show hsnOImpl, show hsnCImpl + ] +{-# LINE 140 "src/ehc/Scanner/Common.chs" #-} + , scoOffsideTrigs = offsideTrigs + , scoOffsideTrigsGE = offsideTrigsGE + , scoOffsideModule = "let" + , scoOffsideOpen = "{" + , scoOffsideClose = "}" + } + where offsideTrigs = + [ "let", "where" + , "of" + , "letstrict" + ] + offsideTrigsGE = + [ "do" + ] + +{-# LINE 165 "src/ehc/Scanner/Common.chs" #-} +hsScanOpts :: EHCOpts -> ScanOpts +hsScanOpts opts + = ehScanOpts' +{-# LINE 170 "src/ehc/Scanner/Common.chs" #-} + { scoKeywordsTxt = + scoKeywordsTxt ehScanOpts' `Set.union` + (Set.fromList $ + offsideTrigs + ++ tokKeywStrsHS1 + ++ tokKeywStrsHS4 + ++ tokKeywStrsHS5 + ++ tokKeywStrsHS6 + ++ tokKeywStrsHS8 + ++ tokKeywStrsHS9 + ++ tokKeywStrsHS11 + ++ tokKeywStrsHS12 + ++ tokKeywStrsHS90 + ++ (if ehcOptFusion opts then tokKeywStrsHS93 else []) + ) +{-# LINE 205 "src/ehc/Scanner/Common.chs" #-} + , scoPragmasTxt = + (Set.fromList $ + tokPragmaStrsHS99 + ) +{-# LINE 211 "src/ehc/Scanner/Common.chs" #-} + , scoKeywordsOps = + scoKeywordsOps ehScanOpts' + `Set.union` + (Set.fromList $ + tokOpStrsHS1 + ++ tokOpStrsHS2 + ++ tokOpStrsHS3 + ++ tokOpStrsHS4 + ++ tokOpStrsHS5 + ++ tokOpStrsHS6 + ++ tokOpStrsHS7 + ++ tokOpStrsHS9 + ++ tokOpStrsHS10 + ++ tokOpStrsHS11 + ) +{-# LINE 246 "src/ehc/Scanner/Common.chs" #-} + , scoOffsideTrigs = + scoOffsideTrigs ehScanOpts' + ++ offsideTrigs + , scoOffsideTrigsGE = + scoOffsideTrigsGE ehScanOpts' + , scoOffsideModule = "module" + } + where offsideTrigs = + [ "where" + ] + ehScanOpts' = ehScanOpts opts + +{-# LINE 264 "src/ehc/Scanner/Common.chs" #-} +coreScanOpts :: EHCOpts -> ScanOpts +coreScanOpts opts + = grinScanOpts + { scoKeywordsTxt = (Set.fromList $ + [ "let", "in", "case", "of", "rec", "foreign", "uniq" + , "Int", "Char", "String", "Tag", "Rec" + , "module", "default" + , "BINDPLAIN", "BINDFUNCTION0", "BINDFUNCTION1", "BINDAPPLY0" + , "VAL" + , "FAIL" + , "DICT", "DICTCLASS", "DICTINSTANCE", "DICTOVERLOADED", "TRACK" + , "Integer" + , "foreignexport" + ]) + `Set.union` scoKeywordsTxt tyScanOpts + `Set.union` scoKeywordsTxt hsScanOpts' + , scoKeywExtraChars = Set.fromList "." + , scoKeywordsOps = scoKeywordsOps grinScanOpts `Set.union` scoKeywordsOps hsScanOpts' + , scoDollarIdent = True + , scoOpChars = Set.fromList "<->:=+*" + , scoSpecChars = Set.fromList "!=();{}#\\|,`" + , scoSpecPairs = Set.fromList [] `Set.union` scoSpecPairs ehScanOpts' + } + where hsScanOpts' = hsScanOpts opts + ehScanOpts' = ehScanOpts opts + +{-# LINE 300 "src/ehc/Scanner/Common.chs" #-} +tycoreScanOpts :: ScanOpts +tycoreScanOpts + = defaultScanOpts + { scoKeywordsTxt = (Set.fromList $ + [ "let", "in", "case", "of", "rec", "foreign", "uniq" + , "Int", "Char", "String", "Tag", "Rec" + , "module", "default" + , "BINDPLAIN", "BINDFUNCTION0", "BINDFUNCTION1", "BINDAPPLY0" + , "VAL" + , "DICT", "DICTCLASS", "DICTINSTANCE", "DICTOVERLOADED" + , "Integer" + , "foreignexport" + ]) + , scoKeywordsOps = Set.fromList [ "->", "=", ":", "::", "|", "\\" ] + , scoSpecChars = Set.fromList "();{},[]" + , scoOpChars = Set.fromList "|\\:=-<>" + , scoDollarIdent = True + } + +{-# LINE 331 "src/ehc/Scanner/Common.chs" #-} +grinScanOpts :: ScanOpts +grinScanOpts + = defaultScanOpts + { scoKeywordsTxt = Set.fromList $ + [ "eval", "apply" + , "call" + , "module", "update", "fetch", "store", "unit", "of", "rec", "case", "ffi", "fetchupdate" + , "throw", "try", "catch", "ctags", "applymap", "evalmap" + , "C", "F", "P", "A", "R", "H", "U", "W" + , "basicnode", "enumnode", "opaquenode", "ptrnode", "basicannot", "enumannot", "opaqueannot", "ptrannot" + , "annotfromtaggedptr", "annottotaggedptr", "annotdflt" + , "word" + , "DICTCLASS", "DICTINSTANCE", "DICTOVERLOADED", "SPECIALIZED" + , "_" + , "float", "double" + , "True", "False" -- for FFI annotation + ] + ++ map show allFFIWays + , scoKeywordsOps = Set.fromList [ "<-", "->", "=", "+=", "-=", ":=", "-", "*" ] + , scoSpecChars = Set.fromList "();{}#/\\|," + , scoOpChars = Set.fromList "<->:=+*" + , scoDollarIdent = True + } + +{-# LINE 363 "src/ehc/Scanner/Common.chs" #-} +tyScanOpts :: ScanOpts +tyScanOpts + = defaultScanOpts + { scoKeywordsTxt = Set.fromList [ "uid" ] + } + +{-# LINE 371 "src/ehc/Scanner/Common.chs" #-} +hsnScanOpts :: ScanOpts +hsnScanOpts + = defaultScanOpts + { scoKeywordsTxt = Set.fromList + [ "NEW" + , "ERR" + , "UNQ" + , "EVL" + , "FLD" + , "CLS" + , "DCT" + , "SDC" + , "RDC" + , "SUP" + , "DFL" + , "INL" + , "UND" + , "OFF" + , "CCN" + , "UPD" + , "FFI" + , "LBL" + , "ASP" + , "STR" + , "GEN" + , "FFE" + , "FFC" + ] + , scoSpecChars = Set.fromList ".{},`" + , scoOpChars = Set.fromList "[]:" `Set.union` scoOpChars hsScanOpts' + , scoAllowQualified = False + } + where hsScanOpts' = hsScanOpts emptyEHCOpts + +{-# LINE 420 "src/ehc/Scanner/Common.chs" #-} +foreignEntScanOpts :: FFIWay -> ScanOpts +foreignEntScanOpts way + = o { scoKeywordsTxt = Set.fromList [ "dynamic", "wrapper", "h", "static", "new", "js" ] + , scoSpecChars = Set.fromList ",.&%[]()*{}" + , scoDollarIdent = False + , scoKeywExtraChars = Set.fromList wayKeywExtraChars + , scoAllowQualified = False + , scoStringDelims = scoStringDelims o ++ wayStringDelims + } + where o = defaultScanOpts + (wayKeywExtraChars,wayStringDelims) + = case way of + _ -> ("" , "" ) + + +{-# LINE 459 "src/ehc/Scanner/Common.chs" #-} +splitTokensOnModuleTrigger :: ScanOpts -> [Token] -> Maybe ([Token],[Token]) +splitTokensOnModuleTrigger scanOpts ts + = case break ismod ts of + (ts1,ts2@[]) -> Nothing + tss -> Just tss + where ismod (Reserved s _) | s == scoOffsideModule scanOpts = True + ismod _ = False + +{-# LINE 469 "src/ehc/Scanner/Common.chs" #-} +offsideScanHandle :: ScanOpts -> FilePath -> Handle -> IO (OffsideInput [Token] Token (Maybe Token)) +offsideScanHandle scanOpts fn fh + = do { tokens <- scanHandle scanOpts fn fh + -- ; putStrLn (" tokens: " ++ show tokens) + ; case splitTokensOnModuleTrigger scanOpts tokens of + Just (ts1,ts2) -> return $ scanLiftTokensToOffside ts1 + $ scanOffsideWithTriggers moduleT oBrace cBrace triggers ts2 + _ -> return $ scanOffsideWithTriggers moduleT oBrace cBrace triggers tokens + } + where moduleT = reserved (scoOffsideModule scanOpts) noPos + oBrace = reserved (scoOffsideOpen scanOpts) noPos + cBrace = reserved (scoOffsideClose scanOpts) noPos + triggers = [ (Trigger_IndentGT,reserved x noPos) | x <- scoOffsideTrigs scanOpts ] + ++ [ (Trigger_IndentGE,reserved x noPos) | x <- scoOffsideTrigsGE scanOpts ] + +{-# LINE 494 "src/ehc/Scanner/Common.chs" #-} +floatDenot2NomDenom :: String -> (Integer,Integer) +floatDenot2NomDenom denot + = (numerator f,denominator f) + where (n,m,e) = getRational denot + f :: Rational + f = ((read n * md + mn) * en) % (ed * md) + en, ed, mn, md :: Integer + (en,ed) = case e of + Just (Just "-",e) -> (1,10 ^ read e) + Just (_,e) -> (10 ^ read e,1) + _ -> (1,1) + (mn,md) = case m of + Just m -> (read m,10 ^ length m) + _ -> (1,1) + +intDenot2Integer :: Int -> String -> Integer +intDenot2Integer b s = getBaseNumber (toInteger b) s + +{-# LINE 519 "src/ehc/Scanner/Common.chs" #-} +pKeyTk, pKeyTk' :: IsParser p Token + => String -> p Token +pKeyTk key = pCostReserved' 9 key +pKeyTk' key = pCostReserved' 8 key + +pKeyw :: (IsParser p Token,Show k) => k -> p Token +pKeyw k = pKeyTk (show k) + +{-# LINE 529 "src/ehc/Scanner/Common.chs" #-} +pKeywHsNname :: (IsParser p Token,Show k) => k -> p HsName +pKeywHsNname k = tokMkQName <$> pKeyw k + + +{-# LINE 535 "src/ehc/Scanner/Common.chs" #-} +pStringTk, pCharTk, + pInteger8Tk, pInteger10Tk, pInteger16Tk, pFractionTk, +{-# LINE 543 "src/ehc/Scanner/Common.chs" #-} + pQVaridTk, pQConidTk, + pQVarsymTk, pQConsymTk, +{-# LINE 547 "src/ehc/Scanner/Common.chs" #-} + pVaridTk , pConidTk , + pVaridTk', pConidTk', + pTextnmTk, pTextlnTk, pIntegerTk, pVarsymTk, pConsymTk + :: IsParser p Token => p Token + +pStringTk = pHsCostValToken' 7 TkString "" +pCharTk = pHsCostValToken' 7 TkChar "\NUL" +pInteger8Tk = pHsCostValToken' 7 TkInteger8 "0" +pInteger10Tk = pHsCostValToken' 7 TkInteger10 "0" +pInteger16Tk = pHsCostValToken' 7 TkInteger16 "0" +pFractionTk = pHsCostValToken' 7 TkFraction "0.0" +pVaridTk = pHsCostValToken' 7 TkVarid "" +pVaridTk' = pHsCostValToken' 6 TkVarid "" +pConidTk = pHsCostValToken' 7 TkConid "" +pConidTk' = pHsCostValToken' 6 TkConid "" +pConsymTk = pHsCostValToken' 7 TkConOp "" +pVarsymTk = pHsCostValToken' 7 TkOp "" +pTextnmTk = pHsCostValToken' 7 TkTextnm "" +pTextlnTk = pHsCostValToken' 7 TkTextln "" +pIntegerTk = pInteger10Tk +{-# LINE 575 "src/ehc/Scanner/Common.chs" #-} +pQVaridTk = pHsCostValToken' 7 TkQVarid "" +pQConidTk = pHsCostValToken' 7 TkQConid "" +pQConsymTk = pHsCostValToken' 7 TkQConOp "" +pQVarsymTk = pHsCostValToken' 7 TkQOp "" + +{-# LINE 586 "src/ehc/Scanner/Common.chs" #-} +pCONID, pCONID', pCONSYM, pVARID, pVARID', pVARSYM :: IsParser p Token => p Token + +pCONID = pConidTk +pCONID' = pConidTk +pCONSYM = pConsymTk +pVARID = pVaridTk +pVARID' = pVaridTk' +pVARSYM = pVarsymTk + +{-# LINE 606 "src/ehc/Scanner/Common.chs" #-} +pQCONID, pQCONSYM, pQVARID, pQVARSYM :: IsParser p Token => p Token + +pQCONID = pQConidTk +pQCONSYM = pQConsymTk +pQVARID = pQVaridTk +pQVARSYM = pQVarsymTk + +{-# LINE 619 "src/ehc/Scanner/Common.chs" #-} +tokGetVal :: Token -> String +tokGetVal x + = tokenVal x + +pV :: (IsParser p Token) => p Token -> p String +pV p = tokGetVal <$> p + +pHNm :: (IsParser p Token) => p Token -> p HsName +pHNm p = (hsnFromString . tokGetVal) <$> p + +{-# LINE 641 "src/ehc/Scanner/Common.chs" #-} +tokConcat :: Token -> Token -> Token +tokConcat t1 t2 = Reserved (tokenVal t1 ++ tokenVal t2) (position t1) + +tokEmpty :: Token +tokEmpty = Reserved "" noPos + +{-# LINE 653 "src/ehc/Scanner/Common.chs" #-} +pMODULE , + pWHERE , + pSEMI , + pDCOLON , + pCOLON , + pOBRACK , + pCBRACK , + pOCURLY , + pCCURLY , + pVOCURLY , + pVCCURLY , + pAT , + pPERCENT , + pDOT , + pCOMMA , + pOPAREN , + pCPAREN , + pINFIX , + pINFIXL , + pINFIXR , + pMINUS , + pSTAR , + pBANG , + pEQUAL , + pRARROW , + pBACKQUOTE , + pLET , + pLAM , + pSLASH , + pUNDERSCORE, + pIN + :: IsParser p Token => p Token + +{-# LINE 688 "src/ehc/Scanner/Common.chs" #-} +pMODULE = pKeyTk "module" +pWHERE = pKeyTk "where" +pSEMI = pKeyTk ";" +pCOLON = pKeyTk ":" +pDCOLON = pKeyTk "::" +pOBRACK = pKeyTk "[" +pCBRACK = pKeyTk "]" +pOCURLY = pKeyTk "{" +pCCURLY = pKeyTk "}" +pVOCURLY = pKeyTk "{-layout" +pVCCURLY = pKeyTk "}-layout" +pAT = pKeyTk "@" +pPERCENT = pKeyTk "%" +pDOT = pKeyTk "." +pCOMMA = pKeyTk "," +pOPAREN = pKeyTk "(" +pCPAREN = pKeyTk ")" +pINFIX = pKeyTk "infix" +pINFIXL = pKeyTk "infixl" +pINFIXR = pKeyTk "infixr" +pMINUS = pKeyTk "-" +pSTAR = pKeyTk "*" +pBANG = pKeyTk "!" +pEQUAL = pKeyTk "=" +pRARROW = pKeyw hsnArrow +pBACKQUOTE = pKeyTk "`" +pLET = pKeyTk "let" +pLAM = pKeyTk "\\" +pSLASH = pKeyTk "/" +pUNDERSCORE = pKeyTk "_" +pIN = pKeyTk "in" + +tokKeywStrsEH1 = [ "in", "let" ] +tokKeywStrsHS1 = [ "module", "where", "infix", "infixl", "infixr" ] +tokOpStrsEH1 = [ "=", "\\", show hsnArrow, "::", "@" ] +tokOpStrsHS1 = [ "-", "*", "!", "_", "%", "." ] + +{-# LINE 727 "src/ehc/Scanner/Common.chs" #-} +pTDOT , + pQDOT + :: IsParser p Token => p Token + +{-# LINE 733 "src/ehc/Scanner/Common.chs" #-} +pTDOT = pKeyTk "..." +pQDOT = pKeyTk "...." + +tokOpStrsEH2 = [ "...", "...." ] +tokOpStrsHS2 = [ ] + +{-# LINE 741 "src/ehc/Scanner/Common.chs" #-} +tokOpStrsEH3 = [ "%" ] +tokOpStrsHS3 = [ ] + +{-# LINE 746 "src/ehc/Scanner/Common.chs" #-} +pFORALL , + pEXISTS , + pTILDE + :: IsParser p Token => p Token + +{-# LINE 753 "src/ehc/Scanner/Common.chs" #-} +pFORALL = pKeyTk "forall" +pEXISTS = pKeyTk "exists" +pTILDE = pKeyTk (show hsnEqTilde) + +tokKeywStrsEH4 = [ "forall", "exists" ] +tokKeywStrsHS4 = [ ] +tokOpStrsEH4 = [ ".", show hsnEqTilde ] +tokOpStrsHS4 = [ ] + +{-# LINE 764 "src/ehc/Scanner/Common.chs" #-} +pLARROW , + pVBAR , + pDATA , + pNEWTYPE , + pCASE , + pOF , + pIF , + pTHEN , + pELSE , + pDOTDOT + :: IsParser p Token => p Token + +{-# LINE 778 "src/ehc/Scanner/Common.chs" #-} +pLARROW = pKeyTk "<-" +pVBAR = pKeyTk "|" +pDATA = pKeyTk "data" +pNEWTYPE = pKeyTk "newtype" +pCASE = pKeyTk "case" +pOF = pKeyTk "of" +pIF = pKeyTk "if" +pTHEN = pKeyTk "then" +pELSE = pKeyTk "else" +pDOTDOT = pKeyTk ".." + +tokKeywStrsEH5 = [ "data", "case", "if", "then", "else", "of" ] +tokKeywStrsHS5 = [ "newtype" ] +tokOpStrsEH5 = [ "|" ] +tokOpStrsHS5 = [ "<-", "..", ":" ] + +{-# LINE 796 "src/ehc/Scanner/Common.chs" #-} +pFFORALL , + pEEXISTS + :: IsParser p Token => p Token + +{-# LINE 802 "src/ehc/Scanner/Common.chs" #-} +pFFORALL = pKeyTk "Forall" +pEEXISTS = pKeyTk "Exists" + +tokKeywStrsEH6 = [ ] +tokKeywStrsHS6 = [ ] +tokKeywStrsHI6 = [ "Forall", "Exists" ] +tokOpStrsEH6 = [ "*" ] +tokOpStrsHS6 = [ ] + +{-# LINE 813 "src/ehc/Scanner/Common.chs" #-} +pOROWREC , + pCROWREC , + pOROWROW , + pCROWROW , + pOROWSUM , + pCROWSUM , + pCOLEQUAL , + pHASH + :: IsParser p Token => p Token + +{-# LINE 825 "src/ehc/Scanner/Common.chs" #-} +pOROWREC = pKeyTk (show hsnORec) +pCROWREC = pKeyTk (show hsnCRec) +pOROWROW = pKeyTk (show hsnORow) +pCROWROW = pKeyTk (show hsnCRow) +pOROWSUM = pKeyTk (show hsnOSum) +pCROWSUM = pKeyTk (show hsnCSum) +pCOLEQUAL = pKeyTk ":=" +pHASH = pKeyTk "#" + +{-# LINE 836 "src/ehc/Scanner/Common.chs" #-} +tokOpStrsEH7 = [ ":=", "#" ] +tokOpStrsHS7 = [ ] + +{-# LINE 841 "src/ehc/Scanner/Common.chs" #-} +pLABEL , + pLETSTRICT , + pSAFE , + pFOREIGN , + pDEFAULT , + pIMPORT , + pEXPORT + :: IsParser p Token => p Token + +{-# LINE 852 "src/ehc/Scanner/Common.chs" #-} +pLABEL = pKeyTk "label" +pLETSTRICT = pKeyTk "letstrict" +pSAFE = pKeyTk "safe" +pFOREIGN = pKeyTk "foreign" +pDEFAULT = pKeyTk "default" +pIMPORT = pKeyTk "import" +pEXPORT = pKeyTk "export" + +tokKeywStrsEH8 + = [ "letstrict", "foreign", "import" ] + ++ map show allFFIWays +tokKeywStrsHS8 = [ "default", "export", "label", "safe" ] + +{-# LINE 869 "src/ehc/Scanner/Common.chs" #-} +pFFIWay :: IsParser p Token => p (FFIWay,Token) +pFFIWay + = pAnyKey (\way -> (,) way <$> pKeyTk (show way)) allFFIWays + "pFFIWay" + +{-# LINE 879 "src/ehc/Scanner/Common.chs" #-} +pDARROW , + pLTCOLON , + pOIMPL , + pCIMPL , + pCLASS , + pINSTANCE , + pDO + :: IsParser p Token => p Token + +{-# LINE 890 "src/ehc/Scanner/Common.chs" #-} +pDARROW = pKeyTk (show hsnPrArrow) +pLTCOLON = pKeyTk "<:" +pOIMPL = pKeyTk (show hsnOImpl) +pCIMPL = pKeyTk (show hsnCImpl) +pCLASS = pKeyTk "class" +pINSTANCE = pKeyTk "instance" +pDO = pKeyTk "do" + +tokKeywStrsEH9 = [ "class", "instance" ] +tokKeywStrsHS9 = [ "do" ] +tokOpStrsEH9 = [ show hsnPrArrow, "<:" ] +tokOpStrsHS9 = [ ] + +{-# LINE 905 "src/ehc/Scanner/Common.chs" #-} +tokOpStrsEH10 = [] -- [ show hsnDynVar ] +tokOpStrsHS10 = [ ] + +{-# LINE 913 "src/ehc/Scanner/Common.chs" #-} +pTYPE + :: IsParser p Token => p Token + +{-# LINE 918 "src/ehc/Scanner/Common.chs" #-} +pTYPE = pKeyTk "type" + +{-# LINE 922 "src/ehc/Scanner/Common.chs" #-} +tokKeywStrsEH11 = [ "type" ] +tokKeywStrsHS11 = [ ] +tokOpStrsEH11 = [ ] +tokOpStrsHS11 = [ ] + +{-# LINE 929 "src/ehc/Scanner/Common.chs" #-} +pQUALIFIED , + pQUESTQUEST , + pAS , + pHIDING + :: IsParser p Token => p Token + +{-# LINE 937 "src/ehc/Scanner/Common.chs" #-} +pQUALIFIED = pKeyTk "qualified" +pAS = pKeyTk "as" +pHIDING = pKeyTk "hiding" +pQUESTQUEST = pKeyTk "??" + +tokKeywStrsEH12 = [ ] +tokKeywStrsHS12 = [ "qualified", "as", "hiding" ] + +{-# LINE 947 "src/ehc/Scanner/Common.chs" #-} +pDERIVING + :: IsParser p Token => p Token + +pDERIVING = pKeyTk "deriving" + +tokKeywStrsEH91 = [ "deriving" ] + +{-# LINE 956 "src/ehc/Scanner/Common.chs" #-} +pUNSAFE , + pTHREADSAFE , + pDYNAMIC , + pWRAPPER , + pSTATIC , + pH , + pNEW , + pJS , + pAMPERSAND + :: IsParser p Token => p Token + +pUNSAFE = pKeyTk "unsafe" +pTHREADSAFE = pKeyTk "threadsafe" +pDYNAMIC = pKeyTk "dynamic" +pWRAPPER = pKeyTk "wrapper" -- not a HS keyword, but only for foreign function entity +pSTATIC = pKeyTk "static" -- not a HS keyword, but only for foreign function entity +pH = pKeyTk "h" -- not a HS keyword, but only for foreign function entity +pAMPERSAND = pKeyTk "&" -- not a HS keyword, but only for foreign function entity +pNEW = pKeyTk "new" +pJS = pKeyTk "js" + +tokKeywStrsEH90 = [ ] +tokKeywStrsHS90 = [ "unsafe", "threadsafe", "dynamic" ] + +{-# LINE 982 "src/ehc/Scanner/Common.chs" #-} +pFUSE , + -- pWITH , + pCONVERT + :: IsParser p Token => p Token + +pFUSE = pKeyTk "fuse" +-- pWITH = pKeyTk "with" +pCONVERT = pKeyTk "convert" + +tokKeywStrsEH93 = [ ] +tokKeywStrsHS93 = [ "fuse", "convert" ] + +{-# LINE 996 "src/ehc/Scanner/Common.chs" #-} +pLANGUAGE_prag , + pOPTIONSUHC_prag , + pDERIVABLE_prag , + pEXCLUDEIFTARGET_prag, + pOPRAGMA , + pCPRAGMA + :: IsParser p Token => p Token + +pLANGUAGE_prag = pKeyTk "LANGUAGE" +pDERIVABLE_prag = pKeyTk "DERIVABLE" +pEXCLUDEIFTARGET_prag = pKeyTk "EXCLUDE_IF_TARGET" +pOPTIONSUHC_prag = pKeyTk "OPTIONS_UHC" +pOPRAGMA = pKeyTk "{-#" +pCPRAGMA = pKeyTk "#-}" + +tokPragmaStrsHS99= [ "LANGUAGE", "DERIVABLE", "EXCLUDE_IF_TARGET", "OPTIONS_UHC" {- , "INLINE", "NOINLINE", "SPECIALIZE" -} ] + + diff --git a/src/UHC/Light/Compiler/Scanner/Machine.hs b/src/UHC/Light/Compiler/Scanner/Machine.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Scanner/Machine.hs @@ -0,0 +1,430 @@ +module UHC.Light.Compiler.Scanner.Machine +( scanHandle +, scanFile, scan +, scanpredIsIdChar, scanpredIsKeywExtra +, getRational +, getBaseNumber ) +where +import Data.Char +import Data.List +import Data.Maybe +import System.IO +import UU.Scanner.Position +import UHC.Util.Utils +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Scanner.Token +import qualified Data.Set as Set +import UHC.Util.Debug + + + + +{-# LINE 37 "src/ehc/Scanner/Machine.chs" #-} +data ScanState + = ScanState + { ssAfterQual :: Bool + } + +defaultScanState = ScanState False + +{-# LINE 50 "src/ehc/Scanner/Machine.chs" #-} +scanHandle :: ScanOpts -> FilePath -> Handle -> IO [Token] +scanHandle opts fn fh + = do { txt <- hGetContents fh + ; return (scan opts (initPos fn) txt) + } + +{-# LINE 58 "src/ehc/Scanner/Machine.chs" #-} +scanFile :: ScanOpts -> FilePath -> IO [Token] +scanFile opts fn = + do txt <- readFile fn + return (scan opts (initPos fn) txt) + +scan :: ScanOpts -> Pos -> String -> [Token] +scan opts pos input + = if scoLitmode opts + then scanLitText defaultScanState pos input + else doScan defaultScanState pos input + + where + -- locatein :: Ord a => [a] -> a -> Bool + -- locatein es = isJust . btLocateIn compare (tab2tree (sort es)) + iskw = (`Set.member` scoKeywordsTxt opts) + iskwextra= scanpredIsKeywExtra opts + isop = (`Set.member` scoKeywordsOps opts) + isSymbol = (`Set.member` scoSpecChars opts) + isOpsym = (`Set.member` scoOpChars opts) + isPairSym= (`Set.member` scoSpecPairs opts) + isStringDelim = (`elem` scoStringDelims opts) + isPragma = (`Set.member` scoPragmasTxt opts) . map toUpper + + isIdStart c = isLower c || c == '_' || iskwextra c + isIdChar c = scanpredIsIdChar c || iskwextra c + -- isQIdChar c = isIdChar c || c == '.' + + allowQual = scoAllowQualified opts + + scanIdent isId p s + = (name,advc (length name) p,rest) + where (name,rest) = span isId s + +{-# LINE 105 "src/ehc/Scanner/Machine.chs" #-} + scanDollarIdent :: String -> (String,Int,String) + scanDollarIdent [] = ("",0,[]) + scanDollarIdent ('$':c:s) | not (isSpace c) + = let (str,w,s') = scanDollarIdent s + in (c:str,w+2,s') + scanDollarIdent cs@(c:s) | isSpace c || isSymbol c || isOpsym c + = ("",0,cs) + scanDollarIdent (c:s) = let (str,w,s') = scanDollarIdent s + in (c:str,w+1,s') + +{-# LINE 117 "src/ehc/Scanner/Machine.chs" #-} + scanQualified :: String -> ([String],String) + scanQualified s + = -- (\v -> tr "scanQualified" (s ++ ":" ++ show v) v) $ + qual [] s + where split isX s = span (\c -> isX c && c /= '.') s + validQuald c = isId c || isOpsym c + isId c = isIdStart c || isUpper c + qual q s + = case s of + (c:s') | isUpper c -- possibly a module qualifier + -> case split isIdChar s' of + (s'',('.':srest@(c':_))) | validQuald c' -- something validly qualifiable follows + -> qual (q ++ [[c] ++ s'']) srest + _ -> dflt + (c:_) | isOpsym c || isIdChar c -- not a qualifier, an operator or lowercase identifier + -> dflt + where dflt = (q,s) + +{-# LINE 137 "src/ehc/Scanner/Machine.chs" #-} + scanString :: Char -> Pos -> String -> (String,Pos,String) + scanString d p [] = ("",p,[]) + scanString d p ('\\':'&':xs) = scanString d (advc 2 p) xs + {- + scanString d p ('\'':xs) = let (str,p',r) = scanString d (advc 1 p) xs + in ('\'': str,p',r) + -} + scanString d p ( c :xs) | isStringDelim c && c /= d + = let (str,p',r) = scanString d (advc 1 p) xs + in (c:str,p',r) + scanString d p ('\\':x:xs) | isSpace x + = let (white,rest) = span isSpace xs + in case rest of + ('\\':rest') -> scanString d (advc 1 $ foldl adv (advc 2 p) white) rest' + _ -> ("",advc 2 p,xs) + scanString d p xs = let (ch,cw,cr) = getchar d xs + (str,p',r) = scanString d (advc cw p) cr + in maybe ("",p,xs) (\c -> (c:str,p',r)) ch + +{-# LINE 158 "src/ehc/Scanner/Machine.chs" #-} + scanLitText scSt p ('\\':'b':'e':'g':'i':'n':'{':'c':'o':'d':'e':'}':s) + | posIs1stColumn p + = doScan scSt (advc 12 p) s + scanLitText scSt p ('>':' ':s) + | posIs1stColumn p + = doScan scSt (advc 2 p) line ++ scanLitText scSt (advc (length line) p) rest + where (line,rest) = break (== '\n') s + scanLitText scSt p (c:s) + = scanLitText scSt (adv p c) s + scanLitText scSt p [] + = [] + +{-# LINE 172 "src/ehc/Scanner/Machine.chs" #-} + doScan scSt p [] = [] + doScan scSt p (c:s) | isSpace c = let (sp,next) = span isSpace s + in doScan (scSt {ssAfterQual=False}) (foldl adv p (c:sp)) next + + doScan scSt p "--" = [] + doScan scSt p ('-':'-':s@(c:_)) + | c == '-' || not (isOpsym c) + = doScan (scSt {ssAfterQual=False}) p (dropWhile (/= '\n') s) +{- +-} + doScan scSt p ('{':'-':'#':s) + | isPragma pragma + = reserved "{-#" p : reserved pragma p2 : doScan (scSt {ssAfterQual=False}) p3 s3 + where (w ,s2) = getWhite s + p2 = advc (length w) $ advc 3 p + (pragma,p3,s3) = scanIdent isIdChar p2 s2 + doScan scSt p ('#':'-':'}':s) = reserved "#-}" p : doScan (scSt {ssAfterQual=False}) (advc 3 p) s + doScan scSt p ('{':'-':s) = scanNestedComment doScan scSt (advc 2 p) s + doScan scSt p (d:ss) + | isStringDelim d + = let (s,p',rest) = scanString d (advc 1 p) ss + in if null rest || head rest /= d + then errToken "Unterminated string literal" p : doScan scSt p' rest + else valueToken TkString s p : doScan scSt (advc 1 p') (tail rest) + +{-# LINE 201 "src/ehc/Scanner/Machine.chs" #-} + doScan scSt p ('$':ss) + | scoDollarIdent opts = tok : doScan scSt (advc (w+1) p) ss' + where (ident,w,ss') = scanDollarIdent ss + tok = if null ident + then errToken "Zero length $identifier" p + else valueToken TkVarid ident p + +{-# LINE 210 "src/ehc/Scanner/Machine.chs" #-} + doScan scSt p ('\\':'e':'n':'d':'{':'c':'o':'d':'e':'}':s) + | scoLitmode opts && posIs1stColumn p + = scanLitText scSt (advc 10 p) s + +{-# LINE 216 "src/ehc/Scanner/Machine.chs" #-} + -- this is experimental, for now, not foolproof, only to be used for the Prelude + doScan scSt p ('\'':'\'':ss) + = let (s,w,r) = scanDQuoteIdent ss + in if null r + then errToken "Unterminated double quote ident" p : doScan (scSt {ssAfterQual=False}) (advc (w+1) p) r + else valueToken TkConid s p : doScan (scSt {ssAfterQual=False}) (advc (w+4) p) r + + doScan scSt p ('\'':ss) + = let (mc,cwidth,rest) = scanChar ss + in case mc of + Nothing -> errToken "Error in character literal" p : doScan (scSt {ssAfterQual=False}) (advc cwidth p) rest + Just c -> if null rest || head rest /= '\'' + then errToken "Unterminated character literal" p : doScan scSt (advc (cwidth+1) p) rest + else valueToken TkChar [c] p : doScan scSt (advc (cwidth+2) p) (tail rest) + + doScan scSt p cs@(c:c2:s) + | isPairSym sym = reserved sym p : doScan (scSt {ssAfterQual=False}) (advc 2 p) s + where sym = [c,c2] + doScan scSt p cs@(c:s) + | isSymbol c + = reserved [c] p + : doScan (scSt {ssAfterQual=False}) (advc 1 p) s +{-# LINE 240 "src/ehc/Scanner/Machine.chs" #-} + | isIdStart c || isUpper c + = + let (qualPrefix,qualTail) = scanQualified cs + in if null qualPrefix || not allowQual + then + let (name', p', s') = scanIdent isIdChar (advc 1 p) s + name = c:name' + nmiskw = iskw name + (mktok,mknm,p'',s'') + | otherwise = (id,id,p',s') + tok = if nmiskw + then reserved name p + else let n = mknm name + in valueToken (mktok $ varKind n) n p + in tok : doScan scSt p'' s'' + else case doScan (scSt {ssAfterQual=True}) (advc (length qualPrefix + sum (map length qualPrefix)) p) qualTail of + (tok@(ValToken tp val _):toks) + -> ValToken (tokTpQual tp) (qualPrefix ++ val) p : toks + ts -> ts +{-# LINE 268 "src/ehc/Scanner/Machine.chs" #-} + | isOpsym c + = let (name, s') = span isOpsym cs + tok n p (c:_) + | length suf' == 2 && isPairSym suf' + = (fst (tok pre p []) ++ [reserved suf' (advc (length pre) p)],1) + where (pre,suf) = splitAt (length n - 1) n + suf' = suf ++ [c] + tok n p s + | isop n && not (ssAfterQual scSt) + = ([reserved n p],0) + | length suf == 2 && isPairSym suf + = (fst (tok pre p []) ++ [reserved suf (advc (length pre) p)],0) + | c==':' = ([valueToken TkConOp n p],0) + | otherwise = ([valueToken TkOp n p],0) + where (pre,suf) = splitAt (length n - 2) n + (toks,drops) = tok name p s' + in toks ++ doScan (scSt {ssAfterQual=False}) (advc drops $ foldl adv p name) (drop drops s') +{-# LINE 287 "src/ehc/Scanner/Machine.chs" #-} + | scoAllowFloat opts && isDigit c + = let (tktype,(number,mantissa,exp),w,cs') = getRational' cs + m = maybe "" (\mant -> "." ++ mant) + e = maybe "" (\(sign,exp) -> "E" ++ maybe "" id sign ++ exp) + in valueToken tktype (number ++ m mantissa ++ e exp) p + : doScan scSt (advc w p) cs' +{-# LINE 295 "src/ehc/Scanner/Machine.chs" #-} + | isDigit c = let (tktype,number,width,s') = getNumber cs + in valueToken tktype number p : doScan scSt (advc width p) s' +{-# LINE 299 "src/ehc/Scanner/Machine.chs" #-} + | otherwise = errToken ("Unexpected character " ++ show c) p + : doScan scSt (adv p c) s + +{-# LINE 308 "src/ehc/Scanner/Machine.chs" #-} +-- | Is base char for identifiers (and keywords) +scanpredIsIdChar :: Char -> Bool +scanpredIsIdChar c = isAlphaNum c || c == '\'' || c == '_' -- -|| iskwextra c + +-- | Is extra char for identifiers (and keywords) +scanpredIsKeywExtra :: ScanOpts -> Char -> Bool +scanpredIsKeywExtra opts = (`Set.member` scoKeywExtraChars opts) + +{-# LINE 322 "src/ehc/Scanner/Machine.chs" #-} +varKind :: String -> EnumValToken +varKind ('_':s) = varKind s +varKind (c :s) | isUpper c = TkConid + | otherwise = TkVarid +varKind [] = TkVarid + +scanNestedComment + :: (ScanState -> Pos -> String -> [Token]) + -> ScanState + -> Pos + -> String + -> [Token] +scanNestedComment cont scSt pos inp = nest cont scSt pos inp + where nest c scSt p ('-':'}':s) = c scSt (advc 2 p) s + nest c scSt p ('{':'-':s) = nest (nest c) scSt (advc 2 p) s + nest c scSt p (x:s) = nest c scSt (adv p x) s + nest _ _ _ [] = [ errToken "Unterminated nested comment" pos] + + +{- +scanString :: Char -> Pos -> String -> (String,Pos,String) +scanString d p [] = ("",p,[]) +scanString d p ('\\':'&':xs) = scanString d (advc 2 p) xs +-- scanString d p ('\'':xs) = let (str,p',r) = scanString d (advc 1 p) xs +-- in ('\'': str,p',r) +scanString d p ( c :xs) | isStringDelim c && c /= d + = let (str,p',r) = scanString d (advc 1 p) xs + in (c:str,p',r) +scanString d p ('\\':x:xs) | isSpace x + = let (white,rest) = span isSpace xs + in case rest of + ('\\':rest') -> scanString d (advc 1 $ foldl adv (advc 2 p) white) rest' + _ -> ("",advc 2 p,xs) +scanString d p xs = let (ch,cw,cr) = getchar d xs + (str,p',r) = scanString d (advc cw p) cr + in maybe ("",p,xs) (\c -> (c:str,p',r)) ch +-} + +scanChar :: [Char] -> (Maybe Char,Int,[Char]) +scanChar ('"' :xs) = (Just '"',1,xs) +scanChar xs = getchar '\'' xs + +getchar :: Char -> [Char] -> (Maybe Char,Int,[Char]) +getchar d [] = (Nothing,0,[]) +getchar d s@('\n':_ ) = (Nothing,0,s ) +getchar d s@('\t':_ ) = (Nothing,0,s) +-- getchar d s@('\'':_ ) = (Nothing,0,s) +getchar d s@( c :_ ) | c == d + = (Nothing,0,s) +getchar d ('\\':xs) = let (c,l,r) = getEscChar xs + in (c,l+1,r) +getchar d (x:xs) = (Just x,1,xs) + +{-# LINE 377 "src/ehc/Scanner/Machine.chs" #-} +getWhite :: String -> (String,String) +getWhite = span (`elem` " \t\r\n") + +{-# LINE 382 "src/ehc/Scanner/Machine.chs" #-} +scanDQuoteIdent :: String -> (String,Int,String) +scanDQuoteIdent [] = ("",0,[]) +scanDQuoteIdent ('\'':'\'':xs) = ("",0,xs) +scanDQuoteIdent (x:xs) = let (s,w,r) = scanDQuoteIdent xs -- should check similar to getchar + in (x:s,w+1,r) + +getEscChar :: [Char] -> (Maybe Char,Int,[Char]) +getEscChar [] = (Nothing,0,[]) +getEscChar s@('x':xs) = let (tp,n,len,rest) = getNumber ('0' : s) + in (Just $ chr $ fromInteger $ getBaseNumber 16 n, len-1, rest) +getEscChar s@('o':xs) = let (tp,n,len,rest) = getNumber ('0' : s) + in (Just $ chr $ fromInteger $ getBaseNumber 8 n, len-1, rest) +getEscChar s@('^':x:xs) = case x `lookup` cntrCntrs of + Just c -> (Just c,2,xs) + _ -> (Nothing,0,s) + where cntrCntrs = [ ('@','\^@'), ('[','\^['), ('\\','\^\'), (']','\^]'), ('^','\^^'), ('_','\^_') ] + ++ zip ['A' .. 'Z'] ['\^A' .. '\^Z'] +getEscChar s@(x:xs) | isDigit x = let (tp,n,len,rest) = getNumber s + val = case tp of + TkInteger8 -> getBaseNumber 8 n + TkInteger16 -> getBaseNumber 16 n + TkInteger10 -> getBaseNumber 10 n + in if val >= 0 && val <= 255 + then (Just (chr $ fromInteger val),len, rest) + else (Nothing,1,rest) + | otherwise = case x `lookup` cntrChars of + Just c -> (Just c,1,xs) + Nothing + -> case filter (flip isPrefixOf s . fst) cntrStrs of + [] -> (Nothing,0,s) + ((m,mr):_) + -> (Just mr,ml,drop ml s) + where ml = length m + where cntrChars = [('a','\a'),('b','\b'),('f','\f'),('n','\n'),('r','\r'),('t','\t') + ,('v','\v'),('\\','\\'),('\"','\"'),('\'','\'')] + cntrStrs = [ ("NUL",'\NUL'), ("SOH",'\SOH'), ("STX",'\STX'), ("ETX",'\ETX') + , ("EOT",'\EOT'), ("ENQ",'\ENQ'), ("ACK",'\ACK'), ("BEL",'\BEL') + , ("BS" ,'\BS' ), ("HT" ,'\HT' ), ("LF" ,'\LF' ), ("VT" ,'\VT' ) + , ("FF" ,'\FF' ), ("CR" ,'\CR' ), ("SO" ,'\SO' ), ("SI" ,'\SI' ) + , ("DLE",'\DLE'), ("DC1",'\DC1'), ("DC2",'\DC2'), ("DC3",'\DC3') + , ("DC4",'\DC4'), ("NAK",'\NAK'), ("SYN",'\SYN'), ("ETB",'\ETB') + , ("CAN",'\CAN'), ("EM" ,'\EM' ), ("SUB",'\SUB'), ("ESC",'\ESC') + , ("FS" ,'\FS' ), ("GS" ,'\GS' ), ("RS" ,'\RS' ), ("US" ,'\US' ) + , ("SP" ,'\SP' ), ("DEL",'\DEL') + ] + +getBaseNumber :: Integer -> [Char] -> Integer +getBaseNumber base n = foldl (\r x -> toInteger (value x) + base * r) 0 n + +getNumber :: [Char] -> (EnumValToken,[Char],Int,[Char]) +getNumber cs@(c:s) + | c /= '0' = num10 + | null s = const0 + | hs == 'x' || hs == 'X' = num16 + | hs == 'o' || hs == 'O' = num8 + | otherwise = num10 + where (hs:ts) = s + const0 = (TkInteger10, "0",1,s) + num10 = let (n,r) = span isDigit cs + in (TkInteger10,n,length n,r) + num16 = readNum isHexaDigit ts TkInteger16 + num8 = readNum isOctalDigit ts TkInteger8 + readNum p ts tk + = let nrs@(n,rs) = span p ts + in if null n then const0 + else (tk , n, 2+length n,rs) + +{-# LINE 459 "src/ehc/Scanner/Machine.chs" #-} +getRational' :: String -> (EnumValToken,(String,Maybe String,Maybe (Maybe String,String)),Int,String) +getRational' s + = case s2 of + ('.':s3@(c:_)) | isDigit c && tktype == TkInteger10 && tktype2 == TkInteger10 + -> case scanExp s4 of + Just (sign,number3,width3,s5) + -> (TkFraction,(number,Just number2,Just (sign,number3)),width + width2 + width3 + 1,s5) + _ -> (TkFraction,(number,Just number2,Nothing),width + width2 + 1,s4) + where (tktype2,number2,width2,s4) = getNumber s3 + _ -> case scanExp s2 of + Just (sign,number3,width3,s5) + -> (TkFraction,(number,Nothing,Just (sign,number3)),width + width3,s5) + _ -> (tktype,(number,Nothing,Nothing),width,s2) + where (tktype,number,width,s2) = getNumber s + scanExp s + = case s of + (c:s5) | c == 'e' || c == 'E' + -> case s5 of + (csign:s6) + | csign == '+' || csign == '-' + -> case s6 of + (c:_) | isDigit c && tktype3 == TkInteger10 + -> Just (Just [csign],number3,width3+2,s7) + where (tktype3,number3,width3,s7) = getNumber s6 + _ -> Nothing + | isDigit csign && tktype3 == TkInteger10 + -> Just (Nothing,number3,width3+1,s7) + where (tktype3,number3,width3,s7) = getNumber s5 + _ -> Nothing + _ -> Nothing + +getRational :: String -> (String,Maybe String,Maybe (Maybe String,String)) +getRational s + = n + where (_,n,_,_) = getRational' s + +{-# LINE 497 "src/ehc/Scanner/Machine.chs" #-} +isHexaDigit :: Char -> Bool +isHexaDigit d = isDigit d || (d >= 'A' && d <= 'F') || (d >= 'a' && d <= 'f') + +isOctalDigit :: Char -> Bool +isOctalDigit d = d >= '0' && d <= '7' + +value :: Char -> Int +value c | isDigit c = ord c - ord '0' + | isUpper c = ord c - ord 'A' + 10 + | isLower c = ord c - ord 'a' + 10 diff --git a/src/UHC/Light/Compiler/Scanner/Scanner.hs b/src/UHC/Light/Compiler/Scanner/Scanner.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Scanner/Scanner.hs @@ -0,0 +1,45 @@ +module UHC.Light.Compiler.Scanner.Scanner +( module UHC.Light.Compiler.Scanner.Machine, module UHC.Light.Compiler.Scanner.Token, module UHC.Light.Compiler.Scanner.TokenParser, module UU.Scanner.Position ) +where +import Data.List +import UHC.Light.Compiler.Scanner.Machine +import UHC.Light.Compiler.Scanner.Token +import UHC.Light.Compiler.Scanner.TokenParser +import UU.Scanner.Position +import UU.Scanner.GenTokenOrd () +import UU.Scanner.GenTokenSymbol () + +{-# LINE 32 "src/ehc/Scanner/Scanner.chs" #-} +instance Show Token where + showsPrec _ token + = showString + (case token of + Reserved key pos -> "symbol " ++ key ++ maybeshow pos + ValToken tp val pos -> show tp ++ " " ++ concat (intersperse "." val) ++ maybeshow pos + ) + +instance Show EnumValToken where + show tp = case tp of + TkVarid -> "lower case identifier" + TkConid -> "upper case identifier" + TkOp -> "operator" + TkConOp -> "con operator" + TkQOp -> "qualified operator" + TkQVarid -> "lower case qualified identifier" + TkQConid -> "upper case qualified identifier" + TkQConOp -> "qualified con operator" + TkString -> "string" + TkChar -> "character" + TkInteger8 -> "octal integer" + TkInteger10 -> "decimal Integer" + TkInteger16 -> "hexadecimal integer" + TkFraction -> "fraction (float,...)" + TkTextnm -> "text name" + TkTextln -> "text lines" + TkError -> "error in scanner:" + +maybeshow :: Pos -> String +maybeshow (Pos l c fn) | l <= 0 || c <= 0 = "" + | otherwise = " at line " ++ show l + ++ ", column " ++ show c + ++ " of file " ++ show fn diff --git a/src/UHC/Light/Compiler/Scanner/Token.hs b/src/UHC/Light/Compiler/Scanner/Token.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Scanner/Token.hs @@ -0,0 +1,87 @@ +module UHC.Light.Compiler.Scanner.Token +( module UU.Scanner.GenToken +, reserved, valueToken, errToken, tokTpIsInt +, Token, ValTokenVal +, EnumValToken (..) +, tokenVals, tokenVal, tokenMap +, tokTpIsId +, tokTpQual ) +where +import UU.Scanner.Position +import UU.Scanner.GenToken +import qualified Data.Set as Set + + + +{-# LINE 27 "src/ehc/Scanner/Token.chs" #-} +-- | The value of a Token is a [String], of length > 1 only when it encodes qualified identifiers +type ValTokenVal = [String] +type Token = GenToken String EnumValToken ValTokenVal + +{-# LINE 33 "src/ehc/Scanner/Token.chs" #-} +-- | The kind of tokens +data EnumValToken + = TkVarid + | TkConid + | TkOp + | TkConOp + | TkString + | TkChar + | TkInteger8 + | TkInteger10 + | TkInteger16 + | TkFraction + | TkTextnm + | TkTextln + | TkQVarid -- qualified variants + | TkQConid + | TkQOp + | TkQConOp + | TkError + deriving (Eq, Ord) + +{-# LINE 64 "src/ehc/Scanner/Token.chs" #-} +-- | Extract the parts of a qualified identifier +tokenVals :: Token -> [String] +tokenVals (ValToken _ v _) = v +tokenVals (Reserved v _) = [v] + +-- | Extract the value as a flattened string +tokenVal :: Token -> String +tokenVal = concat . tokenVals + +tokenMap :: (String->String) -> Token -> Token +tokenMap f (ValToken t v p) = ValToken t (map f v) p +tokenMap f (Reserved k p) = Reserved (f k) p + +{-# LINE 79 "src/ehc/Scanner/Token.chs" #-} +reserved :: String -> Pos -> Token +reserved = Reserved + +valueToken :: EnumValToken -> String -> Pos -> Token +valueToken t s p = ValToken t [s] p + +errToken :: String -> Pos -> Token +errToken = valueToken TkError + +{-# LINE 90 "src/ehc/Scanner/Token.chs" #-} +tokTpIsInt :: EnumValToken -> Bool +tokTpIsInt tp = tp == TkInteger8 || tp == TkInteger10 || tp == TkInteger16 + +{-# LINE 95 "src/ehc/Scanner/Token.chs" #-} +tokTpIsId :: EnumValToken -> Bool +tokTpIsId + = (`Set.member` ts) + where ts = Set.fromList + [TkVarid,TkConid,TkOp,TkConOp + ,TkQVarid,TkQConid,TkQOp,TkQConOp + ] + +{-# LINE 119 "src/ehc/Scanner/Token.chs" #-} +-- | Qualified equivalents of token kinds representing unqualified tokens +tokTpQual :: EnumValToken -> EnumValToken +tokTpQual TkVarid = TkQVarid +tokTpQual TkConid = TkQConid +tokTpQual TkOp = TkQOp +tokTpQual TkConOp = TkQConOp +tokTpQual t = t diff --git a/src/UHC/Light/Compiler/Scanner/TokenParser.hs b/src/UHC/Light/Compiler/Scanner/TokenParser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Scanner/TokenParser.hs @@ -0,0 +1,120 @@ +module UHC.Light.Compiler.Scanner.TokenParser +where +import UU.Parsing.Interface (IsParser (..)) +import UU.Parsing.Derived (pListSep,pPacked) +import UU.Scanner.Position (Pos) +import UU.Scanner.GenTokenParser +import UHC.Light.Compiler.Scanner.Token + + +{-# LINE 38 "src/ehc/Scanner/TokenParser.chs" #-} +pHsValToken :: IsParser p Token => EnumValToken -> String -> p (String,Pos) +pHsValToken t s = valTokenStringRes <$> pValToken t [s] + +pHsCostValToken' :: IsParser p Token => Int -> EnumValToken -> String -> p Token +pHsCostValToken' c tp val = pCostValToken' c tp [val] + +{-# LINE 46 "src/ehc/Scanner/TokenParser.chs" #-} +------------------------------------------------------------------------- +-- IsParsers for Symbols +------------------------------------------------------------------------- + +valTokenStringRes :: (ValTokenVal,Pos) -> (String,Pos) +valTokenStringRes (l,p) = (concat l,p) + +pKeyPos :: IsParser p Token => String -> p Pos +pKeyPos keyword = pReserved keyword + + +pSpecPos :: IsParser p Token => Char -> p Pos +pSpecPos s = pReserved [s] + +pKey :: IsParser p Token => String -> p String +pKey key = key <$ pKeyPos key + +pSpec :: IsParser p Token => Char -> p String +pSpec c = [c] <$ pSpecPos c + +pStringPos, pCharPos, + pInteger8Pos, pInteger10Pos, pInteger16Pos, pFractionPos, + pVaridPos, pConidPos, pVarsymPos, pConsymPos, + pTextnmPos, pTextlnPos, pIntegerPos :: IsParser p Token => p (String,Pos) + +pStringPos = pHsValToken TkString "" +pCharPos = pHsValToken TkChar "\NUL" +pInteger8Pos = pHsValToken TkInteger8 "0" +pInteger10Pos = pHsValToken TkInteger10 "0" +pInteger16Pos = pHsValToken TkInteger16 "0" +pFractionPos = pHsValToken TkFraction "0.0" +pVaridPos = pHsValToken TkVarid "" +pConidPos = pHsValToken TkConid "" +pConsymPos = pHsValToken TkConOp "" +pVarsymPos = pHsValToken TkOp "" +pTextnmPos = pHsValToken TkTextnm "" +pTextlnPos = pHsValToken TkTextln "" +pIntegerPos = pInteger10Pos + +pString, pChar, + pInteger8, pInteger10, pInteger16, pFraction, + pVarid, pConid, pVarsym, pConsym, + pTextnm, pTextln, pInteger :: IsParser p Token => p String + +pString = fst <$> pStringPos +pChar = fst <$> pCharPos +pInteger8 = fst <$> pInteger8Pos +pInteger10 = fst <$> pInteger10Pos +pInteger16 = fst <$> pInteger16Pos +pFraction = fst <$> pFractionPos +pVarid = fst <$> pVaridPos +pConid = fst <$> pConidPos +pVarsym = fst <$> pVarsymPos +pConsym = fst <$> pConsymPos +pTextnm = fst <$> pTextnmPos +pTextln = fst <$> pTextlnPos +pInteger = fst <$> pIntegerPos + +pComma, pSemi, pOParen, pCParen, pOBrack, pCBrack, pOCurly, pCCurly + :: IsParser p Token => p String + +pComma = pSpec ',' +pSemi = pSpec ';' +pOParen = pSpec '(' +pCParen = pSpec ')' +pOBrack = pSpec '[' +pCBrack = pSpec ']' +pOCurly = pSpec '{' +pCCurly = pSpec '}' + +pCommaPos, pSemiPos, pOParenPos, pCParenPos, pOBrackPos, pCBrackPos, pOCurlyPos, pCCurlyPos + :: IsParser p Token => p Pos + +pCommaPos = pSpecPos ',' +pSemiPos = pSpecPos ';' +pOParenPos = pSpecPos '(' +pCParenPos = pSpecPos ')' +pOBrackPos = pSpecPos '[' +pCBrackPos = pSpecPos ']' +pOCurlyPos = pSpecPos '{' +pCCurlyPos = pSpecPos '}' + +pCommas :: IsParser p Token => p a -> p [a] +pSemics :: IsParser p Token => p a -> p [a] +pParens :: IsParser p Token => p a -> p a +pBracks :: IsParser p Token => p a -> p a +pCurly :: IsParser p Token => p a -> p a + +pCommas = pListSep pComma +pSemics = pListSep pSemi +pParens = pPacked pOParen pCParen +pBracks = pPacked pOBrack pCBrack +pCurly = pPacked pOCurly pCCurly + +pParens_pCommas :: IsParser p Token => p a -> p [a] +pBracks_pCommas :: IsParser p Token => p a -> p [a] +pCurly_pSemics :: IsParser p Token => p a -> p [a] + +pParens_pCommas = pParens.pCommas +pBracks_pCommas = pBracks.pCommas +pCurly_pSemics = pCurly .pSemics + + diff --git a/src/UHC/Light/Compiler/SourceCodeSig.hs b/src/UHC/Light/Compiler/SourceCodeSig.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/SourceCodeSig.hs @@ -0,0 +1,3 @@ +module UHC.Light.Compiler.SourceCodeSig where +sig = "3ddcbb16e055964ff5c25a07b42bdb42" +timestamp = "20141118 +0100 192532" diff --git a/src/UHC/Light/Compiler/Substitutable.hs b/src/UHC/Light/Compiler/Substitutable.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Substitutable.hs @@ -0,0 +1,230 @@ +module UHC.Light.Compiler.Substitutable +( VarUpdatable (..) +, VarExtractable (..) +, ppS +, substLift +, varmpMapTyVarKey +, setSubst +, tyFixTyVars, tyMetaTyVars +, varmpinfoFtvMp +, varmpOccurErr ) +where +import Data.List +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Trf.Subst +import UHC.Light.Compiler.Ty.Ftv +import qualified Data.Set as Set +import UHC.Util.Pretty +import UHC.Light.Compiler.Error +import qualified Data.Map as Map +import UHC.Light.Compiler.VarLookup +import UHC.Light.Compiler.Base.TermLike + + + + + + + +{-# LINE 46 "src/ehc/Substitutable.chs" #-} +infixr 6 {-- |=>, -} `varUpd` + +{-# LINE 50 "src/ehc/Substitutable.chs" #-} +infixr 6 {-- |==>, -} `varUpdCyc` + +{-# LINE 54 "src/ehc/Substitutable.chs" #-} +class VarUpdatable vv subst where + varUpd :: subst -> vv -> vv + varUpdCyc :: subst -> vv -> (vv,VarMp) + s `varUpdCyc` x = (s `varUpd` x,emptyVarMp) + +{-# LINE 65 "src/ehc/Substitutable.chs" #-} +class Ord k => VarExtractable vv k | vv -> k where + varFree :: vv -> [k] + varFreeSet :: vv -> Set.Set k + + -- default + varFree = Set.toList . varFreeSet + varFreeSet = Set.fromList . varFree + +{-# LINE 75 "src/ehc/Substitutable.chs" #-} +substLift :: (v' -> v) -> (v' -> v -> v') -> (subst -> v -> (v,r)) -> subst -> v' -> (v',r) +substLift toV updV app s v' + = (updV v' x,r) + where (x,r) = app s $ toV v' + +{-# LINE 86 "src/ehc/Substitutable.chs" #-} +varmpinfoFtvMp :: VarMpInfo -> TvCatMp +varmpinfoFtvMp i + = case i of + VMITy t -> tyFtvMp t + VMIImpls i -> implsFtvMp i + _ -> emptyTvCatMp -- incomplete + +{-# LINE 99 "src/ehc/Substitutable.chs" #-} +instance VarLookup m TyVarId VarMpInfo => VarUpdatable Ty m where + varUpd = tyAppVarLookup + varUpdCyc = tyAppVarLookup2 + +instance VarExtractable Ty TyVarId where + varFreeSet = tyFtv + +{-# LINE 114 "src/ehc/Substitutable.chs" #-} +-- instance VarUpdatable Label VarMp where +instance VarLookup m ImplsVarId VarMpInfo => VarUpdatable Label m where + s `varUpd` lb = maybe lb id $ varmpLabelLookupLabelCyc lb s + +instance VarExtractable Label TyVarId where + varFree (Label_Var v) = [v] + varFree _ = [] + +-- instance VarUpdatable LabelOffset VarMp where +instance VarLookup m UID VarMpInfo => VarUpdatable LabelOffset m where + s `varUpd` o@(LabelOffset_Var v) = maybe o id $ varmpOffsetLookup v s + s `varUpd` o = o + +instance VarExtractable LabelOffset TyVarId where + varFree (LabelOffset_Var v) = [v] + varFree _ = [] + +{-# LINE 133 "src/ehc/Substitutable.chs" #-} +instance (VarUpdatable vv subst) => VarUpdatable [vv] subst where + s `varUpd` l = map (varUpd s) l + s `varUpdCyc` l = (l,varmpUnions m) + where (l,m) = unzip $ map (varUpdCyc s) l + +instance (VarExtractable vv k) => VarExtractable [vv] k where + varFreeSet l = Set.unions $ map varFreeSet l + +{-# LINE 166 "src/ehc/Substitutable.chs" #-} +instance VarLookupCmb m (VarMp' k v) => VarUpdatable (VarMp' k v) m where + varUpd = (|+>) + +instance VarExtractable VarMp TyVarId where + varFreeSet (VarMp _ sl) = Set.unions $ map (varFreeSet . Map.elems) sl + +{-# LINE 176 "src/ehc/Substitutable.chs" #-} +instance VarUpdatable vv subst => VarUpdatable (HsName,vv) subst where + s `varUpd` (k,v) = (k,s `varUpd` v) + +instance VarExtractable vv k => VarExtractable (HsName,vv) k where + varFreeSet (_,v) = varFreeSet v + +{-# LINE 184 "src/ehc/Substitutable.chs" #-} +instance VarUpdatable Pred VarMp where + s `varUpd` p = (\(Ty_Pred p) -> p) (s `varUpd` (Ty_Pred p)) + +instance VarExtractable Pred TyVarId where + varFreeSet p = varFreeSet (Ty_Pred p) + +-- instance VarUpdatable PredScope VarMp where +instance VarLookup m ImplsVarId VarMpInfo => VarUpdatable PredScope m where + s `varUpd` sc = maybe sc id $ varmpScopeLookupScopeCyc sc s + +instance VarExtractable PredScope TyVarId where + varFree (PredScope_Var v) = [v] + varFree _ = [] + +instance VarUpdatable CHRPredOccCxt VarMp where + s `varUpd` (CHRPredOccCxt_Scope1 sc) = CHRPredOccCxt_Scope1 (s `varUpd` sc) + +instance VarExtractable CHRPredOccCxt TyVarId where + varFree (CHRPredOccCxt_Scope1 sc) = varFree sc + +instance VarUpdatable PredOcc VarMp where + s `varUpd` (PredOcc pr id sc r) = PredOcc (s `varUpd` pr) id (s `varUpd` sc) r + +instance VarExtractable PredOcc TyVarId where + varFreeSet (PredOcc pr id sc _) = varFreeSet pr `Set.union` varFreeSet sc + +instance VarUpdatable CHRPredOcc VarMp where + s `varUpd` (CHRPredOcc pr sc r) = CHRPredOcc (s `varUpd` pr) (s `varUpd` sc) r + +instance VarExtractable CHRPredOcc TyVarId where + varFreeSet (CHRPredOcc pr sc _) = varFreeSet pr `Set.union` varFreeSet sc + +instance VarUpdatable Impls VarMp where + s `varUpd` i = (\(Ty_Impls i) -> i) (s `varUpd` (Ty_Impls i)) + +instance VarExtractable Impls TyVarId where + varFreeSet i = varFreeSet (Ty_Impls i) + +{-# LINE 240 "src/ehc/Substitutable.chs" #-} +instance VarUpdatable VarMpInfo VarMp where + s `varUpd` vmi = case vmi of + VMITy t -> VMITy (s `varUpd` t) + VMIImpls i -> VMIImpls (s `varUpd` i) + VMIPred i -> VMIPred (s `varUpd` i) + VMIScope sc -> VMIScope (s `varUpd` sc) + VMIPredSeq x -> VMIPredSeq (s `varUpd` x) + -- VMIExts x -> VMIExts (s `varUpd` x) + vmi -> vmi + +{-# LINE 258 "src/ehc/Substitutable.chs" #-} +instance VarExtractable VarMpInfo VarId where + varFreeSet vmi = case vmi of + VMITy t -> varFreeSet t + VMIImpls i -> varFreeSet i + VMIPred i -> varFreeSet i + VMIScope sc -> varFreeSet sc + VMIPredSeq x -> varFreeSet x + -- VMIExts x -> varFreeSet x + vmi -> Set.empty + + +{-# LINE 292 "src/ehc/Substitutable.chs" #-} +instance VarUpdatable PredSeq VarMp where + s `varUpd` a@(PredSeq_Var v ) = maybe a id $ varmpPredSeqLookup v s + s `varUpd` (PredSeq_Cons h t) = PredSeq_Cons (s `varUpd` h) (s `varUpd` t) + _ `varUpd` x = x + +instance VarExtractable PredSeq TyVarId where + varFreeSet (PredSeq_Var v ) = Set.singleton v + varFreeSet (PredSeq_Cons h t) = varFreeSet h `Set.union` varFreeSet t + varFreeSet _ = Set.empty + +{-# LINE 308 "src/ehc/Substitutable.chs" #-} +-- | Construct varmp for fixing tvars to new fresh fixed tvars + varmp for unfixing those to (again) fresh tvars, resp meta tvars +fixTyVarsVarMp :: UID -> Ty -> (VarMp,VarMp,VarMp,VarMp) +fixTyVarsVarMp uniq t + = ( mk TyVarCateg_Fixed fv rv + , mk TyVarCateg_Meta fv rv + , mk TyVarCateg_Plain rv rv2 + , mk TyVarCateg_Meta rv rv2 + ) + where fv = varFree t + l = length fv + (rv,rv2) = splitAt l $ mkNewUIDL (2*l) uniq + mk cat fv rv = mkVarMp $ Map.fromList $ zipWith (\v r -> (v,VMITy (Ty_Var r cat))) fv rv + +tyFixTyVars :: UID -> Ty -> (Ty,VarMp,VarMp,VarMp) +tyFixTyVars uniq t + = (sTo `varUpd` t, sTo, sFr, smFr) + where (sTo,_,sFr,smFr) = fixTyVarsVarMp uniq t + +-- | replace tvars with tvars having TyVarCateg_Meta +tyMetaTyVars :: UID -> Ty -> Ty +tyMetaTyVars uniq t + = smTo `varUpd` t + where (_,smTo,_,_) = fixTyVarsVarMp uniq t + +{-# LINE 338 "src/ehc/Substitutable.chs" #-} +setSubst :: VarMp -> TyVarIdS -> TyVarIdS +setSubst m s = varFreeSet $ (varUpd m) $ map mkTyVar $ Set.toList s + +{-# LINE 347 "src/ehc/Substitutable.chs" #-} +varmpMapTyVarKey :: VarMp -> VarMp -> VarMp +varmpMapTyVarKey mMap m + = varmpUnions [ varmpTyUnit v x | (Ty_Var v _,x) <- assocLMapKey (\v -> fst $ appUnAnnCanon $ mMap `varUpd` mkTyVar v) $ varmpToAssocTyL m ] + + +{-# LINE 367 "src/ehc/Substitutable.chs" #-} +ppS :: VarUpdatable x m => (x -> PP_Doc) -> m -> x -> PP_Doc +ppS pp c x = (pp $ c `varUpd` x) >#< ppParens (pp x) + +{-# LINE 384 "src/ehc/Substitutable.chs" #-} +varmpOccurErr :: Range -> VarMp -> VarMp -> [Err] +varmpOccurErr r m mc = [ Err_OccurCycle r v (varmpDel [v] m `varUpd` t) | (v,t) <- varmpToAssocTyL mc ] + diff --git a/src/UHC/Light/Compiler/Ty.hs b/src/UHC/Light/Compiler/Ty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty.hs @@ -0,0 +1,1829 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty.ag) +module UHC.Light.Compiler.Ty(TyAGItf (..), Ty (..), TyAnn (..), TyL, tyInt, tyChar +, tyLHdAndTl, tyProdArgs +, tyUnAnn +, tyCanonAnn +, TyVarId, mkTyVar, mkNewTyVar, mkNewUIDTyVarL, mkNewTyVarL, mkTyFreshProd, mkTyFreshProdFrom, tyEnsureNonAny +, TyVarIdL, TyVarIdS +, LookupTy +, TyVarWild (..), TyVarWildMp +, tvwmpNoQuantS +, mkTyQu, TyVarCateg (..) +, tyMbVar +, tyVar +, TyQu (..) +, tvCatIsPlain, tvCatIsFixed +, TvInfo (..) +, emptyTvInfo +, mkTvInfo, mkTvInfoTy +, TvCatMp, emptyTvCatMp +, tyQu_Forall, tyQu_Exists +, tyquIsExists, tyquIsForall +, tyquMetaLev +, tyquExists +, showTyQu +, tyAnnMono +, tyAnnDecomposeMk +, tyIsVar, tyIsCon +, tvIsPlain, tyIsVarPlain +, tyIsSimple +, tyMbCon, tyConNm +, Polarity +, polCovariant, polContravariant, polInvariant +, polIsCovariant, polIsContravariant, polIsInvariant +, polOpp +, FIMode (..) +, fimOpp +, fimSwapPol +, InstTo (..) +, instToSplitQu +, kiStar +, tyQu_KiForall, tyQu_KiExists +, tyAppFunArgsWithLkup +, TyKiKey (..) +, tyKiKeyMbName +, tyKiKeyIsName +, instToL1AssocL +, kiRow +, FldTyL +, tyRowUnAnn, tyRowExtsUnAnn +, tyMbConWithLkup +, tyAppFunMbConNm, tyAppFunConNm +, tyRowExtsWithLkup, tyRecExtrWithLkup, tyRecExtsWithLkup +, tyRowExtr, tyRecExtr, tyRecExts +, rowExtCmp +, tyRecOffset +, tyDataTyNm +, tyRecExts2 +, tyRowOffsetOrder +, tyExtsOffset +, tyRecOffsetWithLkup +, Pred (..) +, Impls (..), ImplsVarId +, TyCtxt (..) +, tyEnsureNonAnyImpl +, LookupImpls +, tvCatIsMeta +, TvPurpose (..) +, tvpurposeIsTy +, mkTvInfoPlain +, PredScope (..), initPredScope +, pscpMbVar +, pscpEnter, pscpLeave +, pscpEnter', pscpLeave', pscpMk' +, pscpIsVisibleIn, pscpCommon +, pscpParents +, pscpCmp, pscpCmpByLen +, ImplsProveOcc (..), mkImplsProveOcc +, PredOcc (..), poId, mkPredOcc +, CHRPredOccCxt (..) +, CHRPredOcc' (..), CHRPredOcc, cpoScope, mkCHRPredOcc +, cpo2PredOcc +, mkTyMetaVar +, mkImplsTail, mkImplsVar, mkImplsNil +, mkTyImpls +, mkTyPr +, tyArrowArgResWithLkup +, tyArrowImplsResWithLkup, tyArrowImplsArgResWithLkup +, tyArrowImplsRes, tyArrowImplsArgRes +, tyQuant +, tyLImplsPreds +, tyPred, predNm, tyPredNm, tyPrArrowArgsRes +, tyPredMatchNmArgs, predMatchNmArgs +, tyPred2DataTy, pred2DataTy +, predTy +, predHasRuntimeEvidence +, implsPredsTailWithLkup, tyImplsWithLkup, implsPrIdLWithLkup +, tyImpls, implsPredsTail, implsPredsMbTail, implsIsTail, tyIsImplsTail, tyImplsPreds, implsPrIdPredL, implsPrIdL +, tyMb1ArrTailVar2VarWithLkup +, implsMbVar, implsTailVar +, implsIsEmpty +, tyIsPredicated, tyIsPredicatedWithLkup +, Label (..), LabelAGItf (..) +, LabelVarId +, LabelOffset (..) +, tyIsEmptyRow +, tyRowIsCanonOrdered +, labelMbVar +, tyLamArgsRes +, tyIsLam +, mkTyLam +, tyString +, tyAppFunArgsMk +, tyLamEtaRed +, tyDecomposeMk +, tyRecMap +, PredSeq (..) +, predSeqToList, predLFlatten +, mkPolNegate, mkPolVar +, tyAllConS +, tyInteger +, tyMbRecExts +, mkPredOccRng +, mkCHRPredOccRng +, tyIsA) where + +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts.Base +import Data.Maybe +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List +import UHC.Util.Pretty +import UHC.Util.Utils +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + +{-| +The module UHC.Light.Compiler.Ty +contains the Haskell interface to the internal representation of types +used by EHC. The AST is described in Ty/AbsSyn. + +-} + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +type TyL = [Ty] + + + +type TyVarId = VarId + + + +type TyVarIdL = [TyVarId] +type TyVarIdS = VarIdS + + + +type FldTyL = AssocL (Maybe HsName) Ty + + + +type ImplsVarId = VarId + + + +type LabelVarId = VarId + + + +type LookupTy = TyVarId -> Maybe Ty + + + +type LookupImpls = ImplsVarId -> Maybe Impls + + + +-- | tyvars may act as wildcard, that is, they act as placeholders inside partial type signatures, providing +-- some structure. Such wildcards come in flavors: +data TyVarWild + = TyVarWild_NoQuantTyExpr_YesQuantLetBinding -- quantify: not in TyExpr, yes in let binding + | TyVarWild_NoQuantTyExpr_NoQuantLetBinding -- quantify: not in TyExpr, not in let binding (enforce monomorphism) + deriving Eq + +type TyVarWildMp = Map.Map TyVarId TyVarWild + + + +tvwmpNoQuantS :: TyVarWildMp -> UIDS +tvwmpNoQuantS = Map.keysSet . Map.filter (== TyVarWild_NoQuantTyExpr_NoQuantLetBinding) + + + +tvCatIsPlain :: TyVarCateg -> Bool +tvCatIsPlain TyVarCateg_Plain = True +tvCatIsPlain _ = False + +tvCatIsFixed :: TyVarCateg -> Bool +tvCatIsFixed TyVarCateg_Fixed = True +tvCatIsFixed _ = False + + + +tvCatIsMeta :: TyVarCateg -> Bool +tvCatIsMeta TyVarCateg_Meta = True +tvCatIsMeta _ = False + + + +data TvPurpose + = TvPurpose_Ty TyVarCateg -- stands for unknown type, the known humble type variable + | TvPurpose_Impls -- possibly empty sequence of implicit parameters + | TvPurpose_Scope -- predicate scope + | TvPurpose_Pred -- predicate + | TvPurpose_AssNm -- assumed name, in CHR + | TvPurpose_Label -- label, in CHR, for ext records + | TvPurpose_Offset -- offset, in CHR, for ext records + | TvPurpose_PredSeq -- experimental still + deriving (Eq,Ord) + + + +instance Show TvPurpose where + show (TvPurpose_Ty TyVarCateg_Fixed) = "c" + show (TvPurpose_Ty TyVarCateg_Meta ) = "m" + show (TvPurpose_Ty _ ) = "v" + show TvPurpose_Impls = "i" + show TvPurpose_Scope = "s" + show TvPurpose_Pred = "p" + show TvPurpose_AssNm = "a" + show TvPurpose_Label = "l" + show TvPurpose_Offset = "o" + show TvPurpose_PredSeq = "s" + + + +tvpurposeIsTy (TvPurpose_Ty _) = True +tvpurposeIsTy _ = False + + + +data TvInfo + = TvInfo + { tvinfoCateg :: !TyVarCateg + , tvinfoPurpose :: !TvPurpose + } + + + +emptyTvInfo + = TvInfo TyVarCateg_Plain + (TvPurpose_Ty TyVarCateg_Plain) + + + +mkTvInfo = TvInfo + +mkTvInfoTy :: TyVarCateg -> TvInfo +mkTvInfoTy c = mkTvInfo c (TvPurpose_Ty c) + + + +instance Show TvInfo where + show i | pur == TvPurpose_Ty TyVarCateg_Fixed && cat == TyVarCateg_Fixed = "c" + | otherwise = show pur + where cat = tvinfoCateg i + pur = tvinfoPurpose i + + + +mkTvInfoPlain :: TvPurpose -> TvInfo +mkTvInfoPlain p = mkTvInfo TyVarCateg_Plain p + + + +type TvCatMp = Map.Map TyVarId TvInfo +emptyTvCatMp = Map.empty + + + +data LabelOffset + = LabelOffset_Off !Int + | LabelOffset_Var !UID + deriving + ( Eq, Ord + , Typeable, Data + ) + + + +instance Show LabelOffset where + show (LabelOffset_Off o) = show o + show (LabelOffset_Var v) = "off_" ++ show v + + + +data PredScope + = PredScope_Lev !(RLList Int) + | PredScope_Var !TyVarId + deriving (Eq,Ord) + +initPredScope :: PredScope +initPredScope = PredScope_Lev rllEmpty + + + +deriving instance Typeable PredScope +deriving instance Data PredScope + + + +pscpMbVar :: PredScope -> Maybe TyVarId +pscpMbVar (PredScope_Var v) = Just v +pscpMbVar _ = Nothing + + + +instance Show PredScope where + show (PredScope_Lev l) = show l + show (PredScope_Var v) = "[sc_" ++ show v ++ "]" + + + +pscpEnter :: Int -> PredScope -> (Int,PredScope) +pscpEnter x (PredScope_Lev s) = (x+1,PredScope_Lev (s `rllConcat` rllSingleton x)) + +pscpLeave :: PredScope -> PredScope +pscpLeave (PredScope_Lev s) = PredScope_Lev $ fst $ fromJust $ rllInitLast s + + + +-- enter yes/no scope, give back the threaded counter to outside the new scope and inside +-- use in conjunction with pscpLeave' +pscpEnter' :: Bool -> Int -> (Int,Int) +pscpEnter' yesEnter x + = if yesEnter + then (fst $ pscpEnter x initPredScope,0) + else (x,x) + +-- leave scope, on previous entering yes/no scope, give back the threaded counter to outside the new scope and inside +-- use in conjunction with pscpEnter' +pscpLeave' :: Bool -> Int -> Int -> Int +pscpLeave' yesEnter newScopeCounter innerScopeCounter + = if yesEnter + then newScopeCounter + else innerScopeCounter + +-- make scope, depending on yes/no entering +-- use in conjunction with pscpEnter' +pscpMk' :: Bool -> Int -> PredScope -> PredScope +pscpMk' yesEnter x s + = if yesEnter + then snd $ pscpEnter x s + else s + + + +pscpIsVisibleIn :: PredScope -> PredScope -> Bool +pscpIsVisibleIn (PredScope_Lev sOuter) (PredScope_Lev sInner) = sOuter `rllIsPrefixOf` sInner +pscpIsVisibleIn _ _ = False + +pscpCommon :: PredScope -> PredScope -> Maybe PredScope +pscpCommon (PredScope_Lev s1) (PredScope_Lev s2) + = Just $ PredScope_Lev $ commonPrefix s1 s2 + where commonPrefix xxs yys | isJust ht1 && isJust ht2 && x == y = rllSingleton x `rllConcat` commonPrefix xs ys + | otherwise = rllEmpty + where ht1 = rllHeadTail xxs + ht2 = rllHeadTail yys + (x,xs) = fromJust ht1 + (y,ys) = fromJust ht2 + -- commonPrefix _ _ = rllEmpty +pscpCommon _ _ + = Nothing + + + +pscpParents :: PredScope -> [PredScope] +pscpParents (PredScope_Lev s) | not (rllNull s) = map PredScope_Lev $ rllInits $ rllInit s +pscpParents _ = [] + + + +pscpCmp :: PredScope -> PredScope -> Maybe Ordering +pscpCmp (PredScope_Lev s) (PredScope_Lev t) = Just $ s `compare` t +pscpCmp _ _ = Nothing + +pscpCmpByLen :: PredScope -> PredScope -> Ordering +pscpCmpByLen (PredScope_Lev s) (PredScope_Lev t) = (rllLength s) `compare` (rllLength t) + + + +data ImplsProveOcc + = ImplsProveOcc + { ipoId :: !UID + , ipoScope :: !PredScope + } + deriving (Eq,Show,Ord) + +mkImplsProveOcc :: UID -> PredScope -> ImplsProveOcc +mkImplsProveOcc = ImplsProveOcc + + + +deriving instance Typeable ImplsProveOcc +deriving instance Data ImplsProveOcc + + + +data PredOcc + = PredOcc + { poPr :: !Pred + , poPoi :: !PredOccId + , poScope :: !PredScope + , poRange :: !Range + } + deriving (Show,Eq,Ord) + +poId :: PredOcc -> UID +poId = poiId . poPoi + +mkPredOcc :: Pred -> PredOccId -> PredScope -> PredOcc +mkPredOcc p i sc = rngLift emptyRange mkPredOccRng p i sc + + + +mkPredOccRng :: Range -> Pred -> PredOccId -> PredScope -> PredOcc +mkPredOccRng r p i sc = PredOcc p i sc r + + + +data CHRPredOccCxt + = CHRPredOccCxt_Scope1 + { cpocxScope :: !PredScope -- default, only allowed value for occurring preds + -- -- others for solving and CHR's only + } + deriving (Show,Eq,Ord) + + + + +deriving instance Typeable CHRPredOccCxt +deriving instance Data CHRPredOccCxt + + + +data CHRPredOcc' p + = CHRPredOcc + { cpoPr :: !p + -- , cpoScope :: !PredScope + , cpoCxt :: !CHRPredOccCxt + , cpoRange :: !Range + } + deriving (Show,Eq,Ord) + +type CHRPredOcc = CHRPredOcc' Pred + +mkCHRPredOcc :: Pred -> PredScope -> CHRPredOcc +mkCHRPredOcc p sc = mkCHRPredOccRng emptyRange p sc + +cpoScope :: CHRPredOcc -> PredScope +cpoScope = cpocxScope . cpoCxt + + + +cpo2PredOcc :: PredOccId -> CHRPredOcc -> PredOcc +cpo2PredOcc i o + = mkPredOccRng + (cpoRange o) + (cpoPr o) + i + (cpoScope o) + + + +deriving instance Typeable1 CHRPredOcc' +deriving instance Data CHRPredOcc + + + +mkCHRPredOccRng :: Range -> Pred -> PredScope -> CHRPredOcc +mkCHRPredOccRng r p sc = CHRPredOcc p (CHRPredOccCxt_Scope1 sc) r + + + +tyQu_Forall = TyQu_Forall metaLevVal +tyQu_Exists = TyQu_Exists metaLevVal + + + +tyQu_KiForall = TyQu_Forall metaLevTy +tyQu_KiExists = TyQu_Exists metaLevTy + + + +tyquIsExists, tyquIsForall :: TyQu -> Bool + + + +tyquIsForall (TyQu_Forall _) = True +tyquIsForall _ = False + +tyquIsExists (TyQu_Exists _) = True +tyquIsExists _ = False + + + +tyquMetaLev (TyQu_Forall l) = l +tyquMetaLev (TyQu_Exists l) = l +tyquMetaLev (TyQu_Plain l) = l + + + +tyquExists, tyquForall :: TyQu -> TyQu + + + +tyquForall (TyQu_Exists l) = TyQu_Forall l +tyquForall q = q + +tyquExists (TyQu_Forall l) = TyQu_Exists l +tyquExists q = q + + + +showTyQu (TyQu_Forall 0) = "forall" +showTyQu (TyQu_Forall 1) = "forall" ++ [charKindStar] +showTyQu (TyQu_Forall l) = "forall" ++ [charKindStar] ++ show l +showTyQu (TyQu_Exists 0) = "exists" +showTyQu (TyQu_Exists 1) = "exists" ++ [charKindStar] +showTyQu (TyQu_Exists l) = "exists" ++ [charKindStar] ++ show l +showTyQu (TyQu_Plain 0) = "" +showTyQu (TyQu_Plain 1) = [charKindStar] +showTyQu (TyQu_Plain l) = [charKindStar] ++ show l + + + +tyIsA :: Ty -> String +tyIsA (Ty_Con a ) = "CON" +tyIsA (Ty_App a b ) = "APP" +tyIsA (Ty_Ann a b ) = "ANN" +tyIsA (Ty_Var a b ) = "VAR" +tyIsA (Ty_Any ) = "ANY" +tyIsA (Ty_TBind a b c d) = "QUANT" +tyIsA (Ty_Ext a b c ) = "EXT" +tyIsA (Ty_Pred a ) = "PRED" +tyIsA (Ty_Lam a b ) = "LAM" +tyIsA (Ty_Impls a ) = "IMPLS" + + + +-- | Remove TyAnn's +tyUnAnn :: Ty -> Ty +tyUnAnn = fst . appUnAnn +{-# INLINE tyUnAnn #-} + + + +tyRowUnAnn :: AssocL HsName Ty -> AssocL HsName Ty +tyRowUnAnn = assocLMapElt tyUnAnn + +tyRowExtsUnAnn :: (Ty,AssocL HsName Ty) -> (Ty,AssocL HsName Ty) +tyRowExtsUnAnn (x,y) = (tyUnAnn x,tyRowUnAnn y) + + + +-- | Canonicalize TyAnn's +tyCanonAnn :: Ty -> Ty +tyCanonAnn t + = c [] t + where c seen t@(Ty_Ann a ta) | a `elem` seen = c seen ta + | otherwise = Ty_Ann a $ c (a:seen) ta + c _ t = t + + + +-- | Add TyAnn +tyAnn :: TyAnn -> Ty -> Ty +tyAnn a t@(Ty_Ann a' _) | a == a' = t +tyAnn a t = Ty_Ann a t + +-- | Add TyAnn_Mono +tyAnnMono :: Ty -> Ty +tyAnnMono = tyAnn TyAnn_Mono + + + +-- | Decompose type for annotation into unannotated type + reconstruction +tyAnnDecomposeMk :: Ty -> (Ty, [TyAnn], Ty -> Ty) +tyAnnDecomposeMk t + = case t of + Ty_Ann a t' -> (ta,as,\ta' -> tyAnn a $ mk ta') + where (ta,as,mk) = tyAnnDecomposeMk t' + _ -> (t ,[],id) + + + +tyIsVar :: Ty -> Bool +tyIsVar = isJust . tyMbVar + +tyIsCon :: Ty -> Bool +tyIsCon = isJust . tyMbCon + +tyIsQu :: Ty -> Bool +tyIsQu = isJust . tyMbQu + + + +tyIsVarPlain :: Ty -> Bool +tyIsVarPlain = maybe False (tvCatIsPlain . snd) . tyMbVar' + +tvIsPlain :: TvCatMp -> TyVarId -> Bool +tvIsPlain m v = maybe False (tvCatIsPlain . tvinfoCateg) $ Map.lookup v m + + + +tyIsEmptyRow :: Ty -> Bool +tyIsEmptyRow = maybe False (== hsnRowEmpty) . tyMbCon + + + +tyIsSimple :: Ty -> Bool +tyIsSimple t = tyIsVar t || tyIsCon t + + + +tyIsLam :: Ty -> Bool +tyIsLam ty + = not (null as) + where (as,_) = tyLamArgsRes ty + + + +instance AppLike Ty Ty {- TyAnn () -} where + -- AppLike + + app1App = Ty_App + appTop = id + appCon = Ty_Con . mkHNm + appPar = id + appRngVar _ = panic "Ty.appRngVar" + appProdApp tyL = recRec (zip positionalFldNames tyL) + -- appDflt = Ty_Any + appDbg s = Ty_Dbg $ "*ERR: " ++ s ++ " :*" + + appMbCon (Ty_Con n) = Just n + appMbCon _ = Nothing + + appMbApp1 (Ty_App f a) = Just (f,a) + appMbApp1 _ = Nothing + + appMbAnn1 (Ty_Ann a t) = Just (t, Ty_Ann a) + appMbAnn1 _ = Nothing + + appMbCanon1 t = do (is,r) <- tyMbArrowImplsResWithLkup (const Nothing) t + if not (null is) && all (maybe False implsIsEmpty . tyMbImpls) is then return (r, appArr is) else Nothing + + appMbDbg (Ty_Dbg s) = Just s + appMbDbg _ = Nothing + + appMbBind1 (Ty_TBind q v k t) = Just (t, Ty_TBind q v k) + appMbBind1 _ = Nothing + + + +instance BndLike Ty TyVarId {- TyAnn () -} where + -- BndLike + bndBndIn n l x = Ty_TBind (TyQu_Plain (l-1)) n x + + + +instance RecLike Ty Ty {- TyAnn () -} where + -- RecLike + recRow r = foldl (\t (n,e) -> Ty_Ext t n e) r + + recMbRecRow = tyMbRecRowWithLkup (const Nothing) + recUnRowExts = tyRowExtsWithLkup (const Nothing) + + + +mkTyVar :: TyVarId -> Ty +mkTyVar tv = Ty_Var tv TyVarCateg_Plain + + + +mkTyMetaVar :: TyVarId -> Ty +mkTyMetaVar tv = Ty_Var tv TyVarCateg_Meta + + + +mkNewTyVar :: UID -> Ty +mkNewTyVar u = let (_,v) = mkNewUID u in mkTyVar v + + + +mkNewUIDTyVarL :: Int -> UID -> ([UID],TyL) +mkNewUIDTyVarL sz u = let vs = mkNewUIDL sz u in (vs,map mkTyVar vs) + +mkNewTyVarL :: Int -> UID -> TyL +mkNewTyVarL sz u = snd (mkNewUIDTyVarL sz u) + + + +tyEnsureNonAny :: UID -> Ty -> Ty +tyEnsureNonAny u t = if t /= Ty_Any then t else mkNewTyVar u + + + +tyEnsureNonAnyImpl :: UID -> Ty -> Ty +tyEnsureNonAnyImpl u t + = if t /= Ty_Any then t + else let [i,r] = mkNewUIDL 2 u + in [mkImplsVar i] `appArr` mkTyVar r + + + +mkTyQu :: TyQu -> [(TyVarId,Ty)] -> Ty -> Ty +mkTyQu q tvL t = foldr (\(tv,k) t -> Ty_TBind q tv k t) t tvL + + + +mkTyFreshProdFrom :: UID -> Int -> Ty +mkTyFreshProdFrom uid arity = appProdApp . map mkTyVar . mkNewUIDL arity $ uid + +mkTyFreshProd :: Int -> Ty +mkTyFreshProd = mkTyFreshProdFrom uidStart + + + +mkTyLam :: [TyVarId] -> Ty -> Ty +mkTyLam args body = foldr Ty_Lam body args + + + +mkImplsTail :: ImplsVarId -> Impls +mkImplsTail v = Impls_Tail v [] + +mkImplsVar :: ImplsVarId -> Ty +mkImplsVar v = Ty_Impls (mkImplsTail v) + +mkImplsNil :: Ty +mkImplsNil = Ty_Impls Impls_Nil + + + +mkTyImpls :: [Pred] -> Ty -> Ty +mkTyImpls prL t = map mkTyPr prL `appArr` t + + + +mkTyPr :: Pred -> Ty +mkTyPr p + = case p of + Pred_Pred t -> t + _ -> Ty_Pred p + + + +tyInt :: Ty +tyInt = appCon hsnInt + + + +tyChar :: Ty +tyChar = appCon hsnChar + + + + + +kiStar :: Ty +kiStar = appCon hsnKindStar + + + +kiRow :: Ty +kiRow = appCon hsnKindRow +-- tyRowEmpty = appCon hsnRowEmpty + + + +tyInteger :: Ty +tyInteger = appCon hsnInteger + + + + + +tyString :: EHCOpts -> Ty +tyString o = appCon (ehcOptBuiltin o ehbnPrelString) + + + +-- tyArrowArgsRes :: Ty -> (TyL,Ty) +-- tyAppFunArgs :: Ty -> (Ty,TyL) +-- tyAppArgs :: Ty -> TyL +-- tyArrowArgs :: Ty -> TyL +-- tyArrowRes :: Ty -> Ty +-- tyArrowArg :: Ty -> Ty + + + +tyArrowArgResWithLkup :: LookupTy -> Ty -> (Ty,Ty) +tyArrowArgResWithLkup lookup = tyVarChkVisitLift lookup appUn1Arr appUn1Arr + + + +tyArrowImplsArgResWithLkup :: LookupTy -> Ty -> (TyL,Ty,Ty) +tyArrowImplsArgResWithLkup lookup t + = (i,a,r) + where (i,t') = tyArrowImplsResWithLkup lookup t + (a,r) = tyArrowArgResWithLkup lookup t' + +tyMbArrowImplsResWithLkup :: LookupTy -> Ty -> Maybe (TyL,Ty) +tyMbArrowImplsResWithLkup lookup t + = extr t + where extr t = case appMb1Arr t of + Just (a,r) + | isImpls a' + -- -> let (as,r') = extr r in (a':as,r') + -> case extr r of + Just (as,r') -> Just (a':as,r') + _ -> Just ([a'],r) + where a' = tyUnAnn a + isImpls (Ty_Pred _) = True + isImpls (Ty_Impls _) = True + isImpls _ = False + _ -> tyVarLift lookup extr (const Nothing) t + +tyArrowImplsResWithLkup :: LookupTy -> Ty -> (TyL,Ty) +tyArrowImplsResWithLkup lookup t = maybe ([],t) id $ tyMbArrowImplsResWithLkup lookup t + + + +tyArrowImplsRes :: Ty -> (TyL,Ty) +tyArrowImplsRes = tyArrowImplsResWithLkup (const Nothing) + +tyArrowImplsArgRes :: Ty -> (TyL,Ty,Ty) +tyArrowImplsArgRes = tyArrowImplsArgResWithLkup (const Nothing) + + + +tyProdArgs :: Ty -> TyL +tyLHdAndTl :: [Ty] -> (Ty,TyL) + + + +-- Substitution aware +tyAppFunArgsWithLkup :: LookupTy -> Ty -> (Ty,TyL) +tyAppFunArgsWithLkup lookup = tyVarChkVisitLift lookup appUnApp appUnApp +{-# INLINE tyAppFunArgsWithLkup #-} + + + +tyAppFunArgsMk :: Ty -> (Ty, TyL, Ty -> TyL -> Ty) +tyAppFunArgsMk + = extr [] + where extr as t + = case tyUnAnn t of + Ty_TBind q v k t -> (f,as,\f as -> Ty_TBind q v k $ mk f as) + where (f,as,mk) = tyAppFunArgsMk t + Ty_App f a -> extr (a:as) f + _ -> (t,as,\f as -> appTopApp (f:as)) + + + +tyLHdAndTl = hdAndTl' Ty_Any +{-# INLINE tyLHdAndTl #-} + + + +tyMbCon :: Ty -> Maybe HsName +-- tyMbCon t = case tyUnAnn t of {Ty_Con nm -> Just nm ; _ -> Nothing} +tyMbCon = appMbCon -- . fst . appUnAnn +{-# INLINE tyMbCon #-} + +tyConNm :: Ty -> HsName +tyConNm = maybe hsnUnknown id . tyMbCon +{-# INLINE tyConNm #-} + + + +tyMbConWithLkup :: LookupTy -> Ty -> Maybe HsName +tyMbConWithLkup lookup = tyVarChkVisitLift lookup tyMbCon tyMbCon +{-# INLINE tyMbConWithLkup #-} + + + +tyMbVar' :: Ty -> Maybe (TyVarId,TyVarCateg) +tyMbVar' t = case tyUnAnn t of {Ty_Var v c -> Just (v,c) ; _ -> Nothing} + +tyMbVar :: Ty -> Maybe TyVarId +tyMbVar = fmap fst . tyMbVar' +{-# INLINE tyMbVar #-} + + + +tyMbQu :: Ty -> Maybe TyQu +tyMbQu t + = case tyUnAnn t of + Ty_TBind q _ _ _ + -> Just q + _ -> Nothing + + + +tyVar :: Ty -> TyVarId +tyVar = maybe uidStart id . tyMbVar +{-# INLINE tyVar #-} + + + +tyProdArgs ty = let (t,al) = tyRecExts ty in map snd al + + + +tyAppFunMbConNm :: Ty -> Maybe HsName +tyAppFunMbConNm = tyMbCon . fst . appUnApp +{-# INLINE tyAppFunMbConNm #-} + +tyAppFunConNm :: Ty -> HsName +tyAppFunConNm = tyConNm . fst . appUnApp +{-# INLINE tyAppFunConNm #-} + + + +-- | The name of a data type extracted from a Ty +tyDataTyNm :: Ty -> HsName +tyDataTyNm = tyAppFunConNm . appUnArrRes + + + +-- | All constructors occurring in a type +tyAllConS :: Ty -> Set.Set HsName +tyAllConS t + = Set.unions $ (maybe Set.empty Set.singleton $ tyMbCon f) : map tyAllConS a + where (f,a,_) = tyDecomposeMk t + + + +tyQuant :: Ty -> Ty +tyQuant t + = case tyUnAnn t of + Ty_TBind _ _ _ t' -> tyQuant t' + _ -> t + + + +tyLImplsPreds :: TyL -> ([Pred],Impls) +tyLImplsPreds = foldr (\t (ps,i) -> case tyUnAnn t of {Ty_Pred p -> (p:ps,i); Ty_Impls i -> (ps,i)}) ([],Impls_Nil) + + + +tyLamArgsRes :: Ty -> ([TyVarId],Ty) +tyLamArgsRes + = extr + where extr t + = case tyUnAnn t of + Ty_Lam a r -> (a:as',r') + where (as',r') = extr r + _ -> ([],t) + + + +-- Eta reduce when the full list of args can be eliminated thus, i.e. it matches with the tail of the args applied in the app (if any) of the body +tyLamEtaRed :: Ty -> Maybe Ty +tyLamEtaRed t + | llas > 0 && rlDiff >= 0 && map mkTyVar las == rTl = Just (appTopApp (f:rHd)) + | otherwise = Nothing + where (las,r ) = tyLamArgsRes t + (f ,ras) = appUnApp r + llas = length las + rlas = length ras + rlDiff = rlas - llas + (rHd,rTl) = splitAt rlDiff ras + + + +-- mkTyRow :: Ty -> AssocL HsName Ty -> Ty +-- mkTyRow r = foldl (\t (n,e) -> Ty_Ext t n e) r + +{- +mkTyRec :: AssocL HsName Ty -> Ty +mkTyRec al = hsnRec `appConApp` [recRowEmp `recRow` al] + +mkTyRecExt :: Ty -> AssocL HsName Ty -> Ty +mkTyRecExt recd al + = let (row,exts) = recUnRowExts (recUnRecRow recd) + in hsnRec `appConApp` [row `recRow` (exts ++ al)] +-} + +-- mkTySum :: AssocL HsName Ty -> Ty +-- mkTySum al = hsnSum `appConApp` [recRowEmp `recRow` al] + + + +tyVarChkVisitLift :: LookupTy -> (Ty -> x) -> (Ty -> x) -> Ty -> x +tyVarChkVisitLift + = withLkupChkVisitLift tyMbVar (noVisit . tyUnAnn) + where noVisit (Ty_TBind _ qv _ _) = Set.singleton qv + noVisit _ = Set.empty + +tyVarLift :: LookupTy -> (Ty -> x) -> (Ty -> x) -> Ty -> x +tyVarLift = withLkupLift tyMbVar +{-# INLINE tyVarLift #-} + + + +implsTailVarLiftCyc :: (TyVarId -> Maybe Impls) -> (TyVarIdS -> Impls -> x) -> (Impls -> x) -> TyVarIdS -> Impls -> x +implsTailVarLiftCyc = withLkupLiftCyc1 implsMbVar (const Set.empty) +{-# INLINE implsTailVarLiftCyc #-} + + + +tyRowExtsWithLkup :: LookupTy -> Ty -> (Ty,AssocL HsName Ty) +tyRowExtsWithLkup lookup + = extr [] + where extr as t + = case tyUnAnn t of + (Ty_Ext r l e) -> extr ((l,e):as) r + t' -> tyVarLift lookup (extr as) (flip (,) as) t' + +tyRecExtsWithLkup :: LookupTy -> Ty -> (Ty,AssocL HsName Ty) +tyRecExtsWithLkup lookup t + = case tyRecRowWithLkup lookup t of + Ty_Any -> (Ty_Any,[]) + row -> tyRowExtsWithLkup lookup row + +tyRecRowWithLkup :: LookupTy -> Ty -> Ty +tyRecRowWithLkup lookup = maybe Ty_Any id . tyMbRecRowWithLkup lookup + +tyRowExtrWithLkup :: LookupTy -> HsName -> Ty -> Maybe (Ty,Ty) +tyRowExtrWithLkup lookup lbl t + = extr t + where extr t + = case tyUnAnn t of + (Ty_Ext r l e) | lbl == l -> Just (r,e) + | otherwise -> maybe Nothing (\(r',e') -> Just (Ty_Ext r' l e,e')) (extr r) + t' -> tyVarLift lookup extr (const Nothing) t' + +tyRecExtrWithLkup :: LookupTy -> HsName -> Ty -> Maybe (Ty,Ty) +tyRecExtrWithLkup lookup lbl t + = case tyRowExtrWithLkup lookup lbl (tyRecRowWithLkup lookup t) of + Nothing -> Nothing + Just (r,e) -> Just (hsnRec `appConApp` [r],e) + +tyMbRecRowWithLkup :: LookupTy -> Ty -> Maybe Ty +tyMbRecRowWithLkup lookup t + = case tyAppFunArgsWithLkup lookup t of + (f,[row]) + -> case tyMbConWithLkup lookup f of + Just n | hsnIsRec n || hsnIsSum n -> Just row + _ -> Nothing + _ -> Nothing + + + + + + +-- tyMbRecRow :: Ty -> Maybe Ty +-- tyMbRecRow = tyMbRecRowWithLkup (const Nothing) +-- {-# INLINE tyMbRecRow #-} +{- + = case tyAppFunArgs t of + (Ty_Con n,[row]) | hsnIsRec n || hsnIsSum n -> Just row + _ -> Nothing +-} + +-- tyRecRow :: Ty -> Ty +-- tyRecRow = maybe Ty_Any id . recMbRecRow +-- {-# INLINE tyRecRow #-} + +-- tyRowExts :: Ty -> (Ty,AssocL HsName Ty) +-- tyRowExts = tyRowExtsWithLkup (const Nothing) +-- {-# INLINE tyRowExts #-} + +tyRecExts :: Ty -> (Ty,AssocL HsName Ty) +tyRecExts = tyRecExtsWithLkup (const Nothing) +{-# INLINE tyRecExts #-} + +tyRowExtr :: HsName -> Ty -> Maybe (Ty,Ty) +tyRowExtr = tyRowExtrWithLkup (const Nothing) +{-# INLINE tyRowExtr #-} + +tyRecExtr :: HsName -> Ty -> Maybe (Ty,Ty) +tyRecExtr = tyRecExtrWithLkup (const Nothing) +{-# INLINE tyRecExtr #-} + + + +tyMbRecExts :: Ty -> Maybe (Ty,AssocL HsName Ty) +tyMbRecExts = fmap recUnRowExts . recMbRecRow + + + +tyRecExts2 :: Ty -> AssocL HsName (AssocL HsName Ty) +tyRecExts2 + = assocLMapElt (snd . tyRecExts) . snd . tyRecExts + + + +tyDecomposeMk :: Ty -> (Ty, TyL, Ty -> TyL -> Ty) +tyDecomposeMk t + = case t of + Ty_TBind q v k t' -> (f,as,\f' as' -> Ty_TBind q v k $ mk f' as') + where (f,as,mk) = tyDecomposeMk t' + Ty_App _ _ -> (f,as,\f' as' -> appTopApp (f':as')) + where (f,as) = appUnApp t + Ty_Ext _ _ _ -> (r,assocLElts e,\r' e' -> recRow r' $ zip (assocLKeys e) e') + where (r,e) = recUnRowExts t + _ | not (null an) -> (t2,as,\f' as' -> mk1 $ mk2 f' as') + | otherwise -> (t,[],const) + where (t1,an,mk1) = tyAnnDecomposeMk t + (t2,as,mk2) = tyDecomposeMk t1 + + + +-- | Map 'f' over fields of record +tyRecMap :: (Ty -> Ty) -> Ty -> Ty +tyRecMap f r + = mk rem (map f fs) + where (rem,fs,mk) = tyDecomposeMk r + + + +tyRowIsCanonOrdered :: AssocL HsName a -> Bool +tyRowIsCanonOrdered = isSortedByOn rowLabCmp fst +{-# INLINE tyRowIsCanonOrdered #-} + + + +rowExtCmp :: (HsName,a) -> (HsName,a) -> Ordering +rowExtCmp (n1,_) (n2,_) = n1 `rowLabCmp` n2 +{-# INLINE rowExtCmp #-} + +-- tyRowCanonOrderBy :: (o -> o -> Ordering) -> AssocL o a -> AssocL o a +-- tyRowCanonOrderBy = rowCanonOrderBy +-- {-# INLINE tyRowCanonOrderBy #-} + +-- tyRowCanonOrder :: AssocL HsName a -> AssocL HsName a +-- tyRowCanonOrder = tyRowCanonOrderBy rowLabCmp +-- {-# INLINE tyRowCanonOrder #-} + + + +tyRowOffsetOrder :: (a -> Int) -> AssocL HsName a -> AssocL HsName a +tyRowOffsetOrder off = sortOn (off . snd) +{-# INLINE tyRowOffsetOrder #-} + + + +tyExtsOffset :: HsName -> AssocL HsName a -> ((Int,Presence),Maybe a) +tyExtsOffset lbl exts + = find 0 lbl exts + where find o l (e@(_,a):es) = case (l,panic "Ty.tyExtsOffset") `rowExtCmp` e of + GT -> find (o+1) l es + EQ -> ((o,Present),Just a) + LT -> ((o,Absent),Nothing) + find o _ [] = ((o,Absent),Nothing) + +tyRecOffset :: HsName -> Ty -> Int +tyRecOffset lbl t + = fst $ fst $ tyExtsOffset lbl $ rowCanonOrder exts + where (_,exts) = tyRecExts t + + + +tyRecOffsetWithLkup :: LookupTy -> HsName -> Ty -> Int +tyRecOffsetWithLkup lookup nm + = tyVarLift lookup o o + where o = tyRecOffset nm + + + +tyPred :: Ty -> Pred +tyPred t + = case tyUnAnn t of + Ty_Pred pt -> pt + _ -> Pred_Pred t + +predNm :: Pred -> HsName +predNm = tyAppFunConNm . predTy +{-# INLINE predNm #-} + +tyPredNm :: Ty -> HsName +tyPredNm = predNm . tyPred +{-# INLINE tyPredNm #-} + +tyPrArrowArgsRes :: Ty -> ([Pred],Pred) +tyPrArrowArgsRes tp = let (tl,t) = appUnArr tp in (map tyPred tl, tyPred t) + + + +-- | extract class name and class args of predicate packages as Ty +tyPredMatchNmArgs :: Ty -> (HsName,[Ty]) +tyPredMatchNmArgs = predMatchNmArgs . tyPred +{-# INLINE tyPredMatchNmArgs #-} + +-- | extract class name and class args of predicate +predMatchNmArgs :: Pred -> (HsName,[Ty]) +predMatchNmArgs p + = case p of + Pred_Class t -> (tyAppFunConNm t, appUnAppArgs t) + Pred_Pred t -> predMatchNmArgs $ snd $ tyPrArrowArgsRes t + Pred_Lacks _ (Label_Lab l) -> (hsnUniqify HsNameUniqifier_LacksLabel l, []) + Pred_Lacks _ _ -> (mkHNm "_LabVar_", []) -- necessary? only used by CHR's + Pred_Eq t1 t2 -> (hsnEqTilde,[t1,t2]) + + + +-- | construct for a predicate its corresponding data type +pred2DataTy :: Pred -> Ty +pred2DataTy p + = appConApp (hsnClass2Dict n) as + where (n,as) = predMatchNmArgs p + +-- | construct for a predicate packaged as a Ty its corresponding data type +tyPred2DataTy :: Ty -> Ty +tyPred2DataTy = pred2DataTy . tyPred +{-# INLINE tyPred2DataTy #-} + + + +predTy :: Pred -> Ty +predTy p + = case p of + Pred_Class t -> t + Pred_Pred t -> t + Pred_Lacks t _ -> t + Pred_Eq t _ -> t -- does it matter if we return the left or the right type? + + + +predSeqToList :: PredSeq -> [Pred] +predSeqToList (PredSeq_Cons h t) = h : predSeqToList t +predSeqToList _ = [] + +predLFlatten :: [Pred] -> [Pred] +predLFlatten + = concatMap fl + where fl (Pred_Preds s) = predSeqToList s + fl p = [p] + + + +-- | Is runtime evidence required for the predicate? +predHasRuntimeEvidence :: Pred -> Bool +predHasRuntimeEvidence p + = case p of + Pred_Eq _ _ -> False + _ -> True + + + +implsPredsTailWithLkup' :: (TyVarId -> Maybe Impls) -> PredScope -> Impls -> ([(PredOcc,[ImplsProveOcc])],Impls) +implsPredsTailWithLkup' lookup sc i + = extr Set.empty i + where extr vsVisited i + = case i of + Impls_Cons _ p pv prange ipos t + -> ((mkPredOccRng prange p pv sc,ipos) : p',mi) + where (p',mi) = extr vsVisited t + _ -> implsTailVarLiftCyc lookup extr ((,) []) vsVisited i + +implsPredsTailWithLkup :: (TyVarId -> Maybe Impls) -> PredScope -> Impls -> ([PredOcc],Impls) +implsPredsTailWithLkup lookup sc i + = (map fst is,t) + where (is,t) = implsPredsTailWithLkup' lookup sc i + +tyImplsWithLkup :: LookupTy -> Ty -> Impls +tyImplsWithLkup lookup = tyVarLift lookup tyImpls tyImpls +{-# INLINE tyImplsWithLkup #-} + +implsPrIdLWithLkup :: (TyVarId -> Maybe Impls) -> Impls -> [PredOccId] +implsPrIdLWithLkup lookup = map poPoi . fst . implsPredsTailWithLkup lookup initPredScope +{-# INLINE implsPrIdLWithLkup #-} + + + + +tyMbVarWithLkup :: LookupTy -> Ty -> Maybe TyVarId +tyMbVarWithLkup lookup = tyVarLift lookup tyMbVar tyMbVar + + + +tyMbImpls :: Ty -> Maybe Impls +tyMbImpls + = extr . tyUnAnn + where extr (Ty_Impls i) = Just i + extr _ = Nothing + +tyImpls :: Ty -> Impls +tyImpls = panicJust "tyImpls" . tyMbImpls +{-# INLINE tyImpls #-} + +implsPredsTail' :: PredScope -> Impls -> ([(PredOcc,[ImplsProveOcc])],Impls) +implsPredsTail' = implsPredsTailWithLkup' (const Nothing) +{-# INLINE implsPredsTail' #-} + +implsPredsTail :: PredScope -> Impls -> ([PredOcc],Impls) +implsPredsTail = implsPredsTailWithLkup (const Nothing) +{-# INLINE implsPredsTail #-} + +implsPredsMbTail :: Impls -> ([(PredOcc,[ImplsProveOcc])],Maybe Impls) +implsPredsMbTail i = case implsPredsTail' initPredScope i of + (i',t@(Impls_Tail _ _)) -> (i',Just t) + (i', Impls_Nil ) -> (i',Nothing) + +tyImplsPreds :: PredScope -> Ty -> [PredOcc] +tyImplsPreds sc = fst . implsPredsTail sc . tyImpls +{-# INLINE tyImplsPreds #-} + +implsIsTail :: Impls -> Bool +implsIsTail = isJust . implsMbVar +{-# INLINE implsIsTail #-} + +tyIsImplsTail :: Ty -> Bool +tyIsImplsTail = implsIsTail . tyImpls +{-# INLINE tyIsImplsTail #-} + +implsPrIdPredL :: Impls -> [(PredOccId,Pred)] +implsPrIdPredL i = [ (poPoi po, poPr po) | po <- fst $ implsPredsTail initPredScope i ] + +implsPrIdL :: Impls -> [PredOccId] +implsPrIdL = map fst . implsPrIdPredL +{-# INLINE implsPrIdL #-} + + + +-- | Is an 'Impls' the tail (last empty element) of a sequence? +implsMbTailVarWithLkup :: LookupImpls -> Impls -> Maybe ImplsVarId +implsMbTailVarWithLkup lkup (Impls_Tail iv _) = maybe (Just iv) (const Nothing) (lkup iv) +implsMbTailVarWithLkup _ _ = Nothing +{-# INLINE implsMbTailVarWithLkup #-} + +-- | Is a 'Ty' the tail of an Impls? +tyMbTailVarWithLkup :: LookupImpls -> Ty -> Maybe ImplsVarId +tyMbTailVarWithLkup lkup t = do { i <- tyMbImpls t ; implsMbTailVarWithLkup lkup i } +{-# INLINE tyMbTailVarWithLkup #-} + +-- | Is 'Ty' a function type from an Impls tail to ... +tyMb1ArrTailVarWithLkup :: LookupImpls -> Ty -> Maybe (ImplsVarId,Ty) +tyMb1ArrTailVarWithLkup lkup t = do { (a,r) <- appMb1Arr t; i <- tyMbTailVarWithLkup lkup a; return (i,r) } +{-# INLINE tyMb1ArrTailVarWithLkup #-} + +-- | Is 'Ty' a function type from an Impls tail to a ty var +tyMb1ArrTailVar2VarWithLkup :: LookupTy -> LookupImpls -> Ty -> Maybe (ImplsVarId,TyVarId) +tyMb1ArrTailVar2VarWithLkup lkupt lkupi t = do { (i,r) <- tyMb1ArrTailVarWithLkup lkupi t; v <- tyMbVarWithLkup lkupt r; return (i,v) } + + + +implsMbVar :: Impls -> Maybe TyVarId +implsMbVar (Impls_Tail v _) = Just v +implsMbVar _ = Nothing + +implsTailVar :: Impls -> ImplsVarId +implsTailVar = panicJust "implsTailVar" . implsMbVar +{-# INLINE implsTailVar #-} + + + +implsIsEmpty :: Impls -> Bool +implsIsEmpty (Impls_Cons _ _ _ _ _ _) = False +implsIsEmpty _ = True + + + +tyIsPredicated :: Ty -> Bool +tyIsPredicated (Ty_Impls i) = not $ implsIsEmpty i +tyIsPredicated t = isPr a + where a = map tyUnAnn $ appUnArrArgs t + isPr (Ty_Pred p:_) = True + isPr _ = False + +tyIsPredicatedWithLkup :: LookupTy -> Ty -> Bool +tyIsPredicatedWithLkup lookup = tyVarLift lookup tyIsPredicated tyIsPredicated +{-# INLINE tyIsPredicatedWithLkup #-} + + + +labelMbVar :: Label -> Maybe TyVarId +labelMbVar (Label_Var v) = Just v +labelMbVar _ = Nothing + + + +data TyKiKey + = TyKiKey_Name !HsName + | TyKiKey_TyVar !TyVarId + deriving (Eq,Ord) + +instance Show TyKiKey where + show (TyKiKey_Name n) = show n + show (TyKiKey_TyVar v) = show v + + + +deriving instance Typeable TyKiKey +deriving instance Data TyKiKey + + + +tyKiKeyMbName :: TyKiKey -> Maybe HsName +tyKiKeyMbName (TyKiKey_Name n) = Just n +tyKiKeyMbName _ = Nothing + + + +tyKiKeyIsName :: TyKiKey -> Bool +tyKiKeyIsName = isJust . tyKiKeyMbName +{-# INLINE tyKiKeyIsName #-} + + + +data TyCtxt = TyCtxt_Ty | TyCtxt_Pred | TyCtxt_Class deriving (Show,Eq) + + + +type Polarity = Ty + + + +polCovariant :: Polarity +polCovariant = appCon hsnCovariant + +polContravariant :: Polarity +polContravariant = appCon hsnContravariant + +polInvariant :: Polarity +polInvariant = appCon hsnInvariant + + + +mkPolNegate :: Polarity -> Polarity +mkPolNegate = appCon1App hsnPolNegation + +mkPolVar :: UID -> Polarity +mkPolVar = mkTyVar + + + +polIs :: HsName -> Polarity -> Bool +polIs nm = maybe False (== nm) . tyMbCon + +polIsCovariant, polIsContravariant, polIsInvariant :: Polarity -> Bool +polIsCovariant = polIs hsnCovariant +polIsContravariant = polIs hsnContravariant +polIsInvariant = polIs hsnInvariant + + + +polOpp :: Polarity -> Polarity +polOpp pol | polIsCovariant pol = polContravariant + | polIsContravariant pol = polCovariant + | otherwise = polInvariant + + + +data FIMode = FitSubLR + | FitSubRL + | FitUnify + deriving (Eq,Ord) + + + +fimOpp :: FIMode -> FIMode +fimOpp m + = case m of + FitSubLR -> FitSubRL + FitSubRL -> FitSubLR + _ -> m + + + +fimSwapPol :: Polarity -> FIMode -> FIMode +fimSwapPol pol m = if polIsContravariant pol then fimOpp m else m + + + +instance Show FIMode where + show FitSubLR = "<=" + show FitSubRL = ">=" + show FitUnify = "==" + + + +data InstTo + = InstTo_Plain -- a plain value + | InstTo_Qu -- the fresh type (tyvar) instantiated to + { instoQu :: TyQu -- how tvar was quantified, also includes the meta level + , instoFrom :: TyVarId -- the tvar from which is instantiated + , instoTo :: TyVarId -- the new tvar to which is instantiated + , instoL1 :: Ty + } +{- + | InstTo_Lam -- a lambda + { instoLam :: [InstTo] + } +-} + deriving Show + + + +instToIsQu :: InstTo -> Bool +instToIsQu (InstTo_Qu _ _ _ _) = True +instToIsQu _ = False + + + +-- split of initial quantifier instantiations, to be used for Sys F generation for type parameterization +instToSplitQu :: [InstTo] -> ([InstTo],[InstTo]) +instToSplitQu = span instToIsQu + + + +-- get tvar -> kind bindings of instantiation +instToL1AssocL :: [InstTo] -> AssocL TyVarId (MetaLev,Ty) +instToL1AssocL l = [ (v,(tyquMetaLev q,k)) | (InstTo_Qu q _ v k) <- l ] + + + +instance Serialize TyKiKey where + sput (TyKiKey_Name a) = sputWord8 0 >> sput a + sput (TyKiKey_TyVar a) = sputWord8 1 >> sput a + sget = do t <- sgetWord8 + case t of + 0 -> liftM TyKiKey_Name sget + 1 -> liftM TyKiKey_TyVar sget + + + +instance Binary ImplsProveOcc where + put (ImplsProveOcc a b) = put a >> put b + get = liftM2 ImplsProveOcc get get + +instance Serialize ImplsProveOcc where + sput = sputPlain + sget = sgetPlain + +instance Binary PredScope where + put (PredScope_Lev a ) = putWord8 0 >> put a + put (PredScope_Var a ) = putWord8 1 >> put a + get = do tag <- getWord8 + case tag of + 0 -> liftM PredScope_Lev get + 1 -> liftM PredScope_Var get + +instance Serialize PredScope where + sput = sputPlain + sget = sgetPlain + +instance Binary CHRPredOccCxt where + put (CHRPredOccCxt_Scope1 a) = put a + get = liftM CHRPredOccCxt_Scope1 get + +instance Serialize CHRPredOccCxt where + sput = sputPlain + sget = sgetPlain + +instance Binary LabelOffset where + put (LabelOffset_Off a) = putWord8 0 >> put a + put (LabelOffset_Var a) = putWord8 1 >> put a + get = do t <- getWord8 + case t of + 0 -> liftM LabelOffset_Off get + 1 -> liftM LabelOffset_Var get + +instance Serialize LabelOffset where + sput = sputPlain + sget = sgetPlain + + + + +instance Binary TyQu where + put (TyQu_Forall a) = putWord8 0 >> put a + put (TyQu_Exists a) = putWord8 1 >> put a + put (TyQu_Plain a) = putWord8 1 >> put a + get = do tag <- getWord8 + case tag of + 0 -> liftM TyQu_Forall get + 1 -> liftM TyQu_Exists get + 2 -> liftM TyQu_Plain get + +instance Serialize TyQu where + sput = sputPlain + sget = sgetPlain + + + +instance Serialize Ty where + sput (Ty_Con a ) = sputWord8 0 >> sput a + sput (Ty_App a b ) = sputWord8 1 >> sput a >> sput b + sput (Ty_Ann a b ) = sputWord8 2 >> sput a >> sput b + sput (Ty_Var a b ) = sputWord8 3 >> sput a >> sput b + sput (Ty_Any ) = sputWord8 4 + sput (Ty_TBind a b c d) = sputWord8 5 >> sput a >> sput b >> sput c >> sput d + sput (Ty_Ext a b c ) = sputWord8 6 >> sput a >> sput b >> sput c + sput (Ty_Pred a ) = sputWord8 7 >> sput a + sput (Ty_Lam a b ) = sputWord8 8 >> sput a >> sput b + sput (Ty_Impls a ) = sputWord8 9 >> sput a + sput (Ty_Dbg a ) = sputWord8 10 >> sput a + sget = do tag <- sgetWord8 + case tag of + 0 -> liftM Ty_Con sget + 1 -> liftM2 Ty_App sget sget + 2 -> liftM2 Ty_Ann sget sget + 3 -> liftM2 Ty_Var sget sget + 4 -> return Ty_Any + 5 -> liftM4 Ty_TBind sget sget sget sget + 6 -> liftM3 Ty_Ext sget sget sget + 7 -> liftM Ty_Pred sget + 8 -> liftM2 Ty_Lam sget sget + 9 -> liftM Ty_Impls sget + 10 -> liftM Ty_Dbg sget + +instance Serialize TyAnn where + sput (TyAnn_Empty ) = sputWord8 0 + sput (TyAnn_Mono ) = sputWord8 1 + sput (TyAnn_Strictness a) = sputWord8 2 >> sput a + sget = do tag <- sgetWord8 + case tag of + 0 -> return TyAnn_Empty + 1 -> return TyAnn_Mono + 2 -> liftM TyAnn_Strictness sget + +instance Binary TyVarCateg where + put = putEnum8 + get = getEnum8 + +instance Serialize TyVarCateg where + sput = sputPlain + sget = sgetPlain + +instance Serialize Pred where + sput (Pred_Class a ) = sputWord8 0 >> sput a + sput (Pred_Pred a ) = sputWord8 1 >> sput a + sput (Pred_Lacks a b) = sputWord8 2 >> sput a >> sput b + sput (Pred_Arrow a b) = sputWord8 3 >> sput a >> sput b + sput (Pred_Eq a b) = sputWord8 4 >> sput a >> sput b + sput (Pred_Var a ) = sputWord8 5 >> sput a + sput (Pred_Preds a ) = sputWord8 6 >> sput a + sget = do tag <- sgetWord8 + case tag of + 0 -> liftM Pred_Class sget + 1 -> liftM Pred_Pred sget + 2 -> liftM2 Pred_Lacks sget sget + 3 -> liftM2 Pred_Arrow sget sget + 4 -> liftM2 Pred_Eq sget sget + 5 -> liftM Pred_Var sget + 6 -> liftM Pred_Preds sget + +instance Serialize Label where + sput (Label_Lab a) = sputWord8 0 >> sput a + sput (Label_Var a) = sputWord8 1 >> sput a + sget = do tag <- sgetWord8 + case tag of + 0 -> liftM Label_Lab sget + 1 -> liftM Label_Var sget + +instance Serialize PredSeq where + sput (PredSeq_Nil ) = sputWord8 0 + sput (PredSeq_Cons a b ) = sputWord8 1 >> sput a >> sput b + sput (PredSeq_Var a ) = sputWord8 2 >> sput a + sget = do tag <- sgetWord8 + case tag of + 0 -> return PredSeq_Nil + 1 -> liftM2 PredSeq_Cons sget sget + 2 -> liftM PredSeq_Var sget + +{- +instance Binary PredSeq where + put = putList (PredSeq_Nil ==) (\(PredSeq_Cons a b) -> (a,b)) + get = getList PredSeq_Nil PredSeq_Cons +-} + +instance Serialize CHRPredOcc where + -- Range info is stripped on the fly + sput (CHRPredOcc a b _) = sput a >> sput b + -- Range info is stripped on the fly + sget = liftM2 (\a b -> CHRPredOcc a b emptyRange) sget sget + +instance Serialize Impls where + sput (Impls_Nil ) = sputWord8 0 + sput (Impls_Tail a b ) = sputWord8 1 >> sput a >> sput b + sput (Impls_Cons a b c d e f) = sputWord8 2 >> sput a >> sput b >> sput c >> sput d >> sput e >> sput f + sget = do tag <- sgetWord8 + case tag of + 0 -> return Impls_Nil + 1 -> liftM2 Impls_Tail sget sget + 2 -> + liftM6 Impls_Cons sget sget sget sget sget sget + + +-- Impls ------------------------------------------------------- +data Impls = Impls_Tail {iv_Impls_Tail :: !(ImplsVarId),proveOccs_Impls_Tail :: !(([ImplsProveOcc]))} + | Impls_Cons {iv_Impls_Cons :: !(ImplsVarId),pr_Impls_Cons :: !(Pred),pv_Impls_Cons :: !(PredOccId),prange_Impls_Cons :: !(Range),proveOccs_Impls_Cons :: !(([ImplsProveOcc])),tl_Impls_Cons :: !(Impls)} + | Impls_Nil {} + deriving ( Data,Eq,Ord,Show,Typeable) +-- Label ------------------------------------------------------- +data Label = Label_Lab {nm_Label_Lab :: !(HsName)} + | Label_Var {lv_Label_Var :: !(LabelVarId)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- LabelAGItf -------------------------------------------------- +data LabelAGItf = LabelAGItf_AGItf {lab_LabelAGItf_AGItf :: !(Label)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- Pred -------------------------------------------------------- +data Pred = Pred_Class {ty_Pred_Class :: !(Ty)} + | Pred_Pred {ty_Pred_Pred :: !(Ty)} + | Pred_Lacks {ty_Pred_Lacks :: !(Ty),lab_Pred_Lacks :: !(Label)} + | Pred_Arrow {args_Pred_Arrow :: !(PredSeq),res_Pred_Arrow :: !(Pred)} + | Pred_Eq {tyL_Pred_Eq :: !(Ty),tyR_Pred_Eq :: !(Ty)} + | Pred_Var {pv_Pred_Var :: !(TyVarId)} + | Pred_Preds {seq_Pred_Preds :: !(PredSeq)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- PredSeq ----------------------------------------------------- +data PredSeq = PredSeq_Cons {hd_PredSeq_Cons :: !(Pred),tl_PredSeq_Cons :: !(PredSeq)} + | PredSeq_Nil {} + | PredSeq_Var {av_PredSeq_Var :: !(TyVarId)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- Ty ---------------------------------------------------------- +data Ty = Ty_Con {nm_Ty_Con :: !(HsName)} + | Ty_App {func_Ty_App :: !(Ty),arg_Ty_App :: !(Ty)} + | Ty_Ann {ann_Ty_Ann :: !(TyAnn),ty_Ty_Ann :: !(Ty)} + | Ty_Dbg {info_Ty_Dbg :: !(String)} + | Ty_Any {} + | Ty_Var {tv_Ty_Var :: !(TyVarId),categ_Ty_Var :: !(TyVarCateg)} + | Ty_TBind {qu_Ty_TBind :: !(TyQu),tv_Ty_TBind :: !(TyVarId),l1_Ty_TBind :: !(Ty),ty_Ty_TBind :: !(Ty)} + | Ty_Ext {ty_Ty_Ext :: !(Ty),nm_Ty_Ext :: !(HsName),extTy_Ty_Ext :: !(Ty)} + | Ty_Pred {pr_Ty_Pred :: !(Pred)} + | Ty_Lam {tv_Ty_Lam :: !(TyVarId),ty_Ty_Lam :: !(Ty)} + | Ty_Impls {impls_Ty_Impls :: !(Impls)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- TyAGItf ----------------------------------------------------- +data TyAGItf = TyAGItf_AGItf {ty_TyAGItf_AGItf :: !(Ty)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- TyAnn ------------------------------------------------------- +data TyAnn = TyAnn_Empty {} + | TyAnn_Strictness {s_TyAnn_Strictness :: !(Strictness)} + | TyAnn_Mono {} + deriving ( Data,Eq,Ord,Show,Typeable) +-- TyQu -------------------------------------------------------- +data TyQu = TyQu_Forall {mlev_TyQu_Forall :: !(MetaLev)} + | TyQu_Exists {mlev_TyQu_Exists :: !(MetaLev)} + | TyQu_Plain {mlev_TyQu_Plain :: !(MetaLev)} + deriving ( Data,Eq,Ord,Show,Typeable) +-- TyVarCateg -------------------------------------------------- +data TyVarCateg = TyVarCateg_Plain {} + | TyVarCateg_Fixed {} + | TyVarCateg_Meta {} + deriving ( Data,Enum,Eq,Ord,Show,Typeable) diff --git a/src/UHC/Light/Compiler/Ty/AppSpineGam.hs b/src/UHC/Light/Compiler/Ty/AppSpineGam.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/AppSpineGam.hs @@ -0,0 +1,79 @@ +module UHC.Light.Compiler.Ty.AppSpineGam +( module UHC.Light.Compiler.Gam.AppSpineGam +, asGamLookup +, mkAppSpineGam +, asFOUpdCoe ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.AppSpineGam +import UHC.Light.Compiler.Gam.AppSpineGam +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FIEnv +import UHC.Util.Utils +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core.Subst + + +{-# LINE 48 "src/ehc/Ty/AppSpineGam.chs" #-} +arrowAppSpineVertebraeInfoL :: FIEnv -> [AppSpineVertebraeInfo] +arrowAppSpineVertebraeInfoL env + = [ AppSpineVertebraeInfo polContravariant fioMkStrong + asFODflt + (Just dfltFOUpdCoe) + , AppSpineVertebraeInfo polCovariant id + asFOArrow + (Just (\opts [ffo,afo] + -> let (u',u1) = mkNewUID (foUniq afo) + -- c = lrcoeForLamTyApp opts u1 (foCSubst afo) (foLRCoe ffo) (foLRCoe afo) + (c,s) = lrcoeForLamTyAppAsSubst opts u1 (foLRCoe ffo) (foLRCoe afo) + in afo { foUniq = u' + , foLRCoe = c + , foCSubst = foCSubst afo `cSubstApp` s + } + ) ) + ] + +prodAppSpineVertebraeInfoL :: [AppSpineVertebraeInfo] +prodAppSpineVertebraeInfoL + = repeat + $ AppSpineVertebraeInfo polCovariant id asFODflt + (Just dfltFOUpdCoe) + +{-# LINE 98 "src/ehc/Ty/AppSpineGam.chs" #-} +dfltFOUpdCoe :: AppSpineFOUpdCoe +dfltFOUpdCoe _ x = last' (panic "Ty.AppSpineGam.dfltFOUpdCoe") x + +asFOUpdCoe :: AppSpineVertebraeInfo -> AppSpineFOUpdCoe +asFOUpdCoe = maybe dfltFOUpdCoe id . asMbFOUpdCoe + +{-# LINE 106 "src/ehc/Ty/AppSpineGam.chs" #-} +asFODflt :: FIOut -> FIOut -> FIOut +asFODflt _ afo = afo + +{-# LINE 111 "src/ehc/Ty/AppSpineGam.chs" #-} +asFOArrow :: FIOut -> FIOut -> FIOut +asFOArrow _ afo = afo {foLInstToL = InstTo_Plain : foLInstToL afo, foRInstToL = InstTo_Plain : foRInstToL afo} + +{-# LINE 120 "src/ehc/Ty/AppSpineGam.chs" #-} +asGamLookup :: HsName -> AppSpineGam -> Maybe AppSpineInfo +asGamLookup nm g + = case gamLookup nm g of + j@(Just _) + -> j + Nothing | hsnIsProd nm + -> Just $ emptyAppSpineInfo {asgiVertebraeL = take (hsnProdArity nm) prodAppSpineVertebraeInfoL} + _ -> Nothing + + +{-# LINE 137 "src/ehc/Ty/AppSpineGam.chs" #-} +mkAppSpineGam :: FIEnv -> AppSpineGam +mkAppSpineGam env + = assocLToGam + [ (hsnArrow , emptyAppSpineInfo {asgiVertebraeL = arrowAppSpineVertebraeInfoL env}) + , (hsnRec , emptyAppSpineInfo {asgiVertebraeL = take 1 prodAppSpineVertebraeInfoL}) + ] + diff --git a/src/UHC/Light/Compiler/Ty/FIEnv.hs b/src/UHC/Light/Compiler/Ty/FIEnv.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/FIEnv.hs @@ -0,0 +1,63 @@ +module UHC.Light.Compiler.Ty.FIEnv +( FIEnv (..) +, emptyFE ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Opts +import qualified Data.Set as Set +import UHC.Light.Compiler.Gam +import UHC.Light.Compiler.Gam.AppSpineGam +import UHC.Util.Pretty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Ty +import UHC.Util.Utils +import UHC.Light.Compiler.Gam.TyGam +import UHC.Light.Compiler.Gam.PolGam +import UHC.Light.Compiler.Gam.DataGam + + + + + + + + + +{-# LINE 60 "src/ehc/Ty/FIEnv.chs" #-} +data FIEnv + = FIEnv + { feAppSpineGam :: !AppSpineGam -- ty app spine info + , feEHCOpts :: !EHCOpts -- compiler options + , feDontBind :: !TyVarIdS -- inhibit type var binding for ... + , fePredScope :: !PredScope -- the scope used by predicate resolution + , feTyGam :: !TyGam -- type environment, for type synonym expansion + , fePolGam :: !PolGam -- polarity environment, for co/contra variance + , feDataGam :: !DataGam -- datatype info, for tycore generation, for coercions + , feRange :: !Range -- position of source code from where subsumption is invoked + } + +{-# LINE 89 "src/ehc/Ty/FIEnv.chs" #-} +emptyFE + = FIEnv + { feAppSpineGam = emptyGam + , feEHCOpts = defaultEHCOpts + , feDontBind = Set.empty + , fePredScope = initPredScope + , feTyGam = emptyGam + , fePolGam = emptyGam + , feDataGam = emptyGam + , feRange = emptyRange + } + +{-# LINE 118 "src/ehc/Ty/FIEnv.chs" #-} +instance Show FIEnv where + show _ = "FIEnv" + +{-# LINE 123 "src/ehc/Ty/FIEnv.chs" #-} +instance PP FIEnv where + pp e = "FIEnv" + >#< (empty + >-< pp (feTyGam e) + ) + diff --git a/src/UHC/Light/Compiler/Ty/FIEnv2.hs b/src/UHC/Light/Compiler/Ty/FIEnv2.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/FIEnv2.hs @@ -0,0 +1,14 @@ +module UHC.Light.Compiler.Ty.FIEnv2 +( defaultFIEnv ) +where +import UHC.Light.Compiler.Ty.FIEnv +import UHC.Light.Compiler.Ty.AppSpineGam +import UHC.Light.Compiler.AbstractCore + + +{-# LINE 25 "src/ehc/Ty/FIEnv2.chs" #-} +defaultFIEnv + = emptyFE + { feAppSpineGam = mkAppSpineGam defaultFIEnv + } + diff --git a/src/UHC/Light/Compiler/Ty/FitsIn.hs b/src/UHC/Light/Compiler/Ty/FitsIn.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/FitsIn.hs @@ -0,0 +1,1106 @@ +module UHC.Light.Compiler.Ty.FitsIn +( fitsIn +, fitsInL', fitsInL +, fitsInFold +, fitsInForToTyCore +, fitsIn' +, fitPredIntoPred +, fitPredToEvid' +, fitPredToEvid ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.Trf.Instantiate +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Gam.Full +import Data.Maybe +import Data.List as List +import UHC.Light.Compiler.Ty.AppSpineGam +import qualified Data.Set as Set +import UHC.Util.Utils +import UHC.Util.Pretty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Error.Pretty +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Base.Debug as Debug +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Ty.Trf.Canonic +import qualified Data.Map as Map +import UHC.Util.Pretty +import UHC.Light.Compiler.Gam.ClGam +import UHC.Light.Compiler.Pred +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Subst +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Core.Pretty +import UHC.Light.Compiler.Pred.CommonCHR +import UHC.Light.Compiler.Core.Utils +import UHC.Light.Compiler.Ty.Trf.BetaReduce + + + + + + + + + + + +{-# LINE 89 "src/ehc/Ty/FitsIn.chs" #-} +fiAppVarMp :: VarUpdatable Ty gm => FIIn' gm -> Ty -> Ty +fiAppVarMp fi x = fiVarMpLoc fi `varUpd` (fiVarMp fi `varUpd` x) + +{-# LINE 98 "src/ehc/Ty/FitsIn.chs" #-} +instance Show (FIIn' gm) where + show _ = "FIIn" + +instance PP (FIIn' gm) where + pp fi = "FIIn:" >#< pp (fiEnv fi) + +{-# LINE 106 "src/ehc/Ty/FitsIn.chs" #-} +fiUpdOpts :: (FIOpts -> FIOpts) -> FIIn' gm -> FIIn' gm +fiUpdOpts upd fi = fi {fiFIOpts = upd (fiFIOpts fi)} + +{-# LINE 111 "src/ehc/Ty/FitsIn.chs" #-} +fiInhibitVarExpandL :: TyVarId -> FIIn' gm -> FIIn' gm +fiInhibitVarExpandL v fi = fi {fiExpLTvS = v `Set.insert` fiExpLTvS fi} + +fiVarIsExpandedL :: TyVarId -> FIIn' gm -> Bool +fiVarIsExpandedL v fi = v `Set.member` fiExpLTvS fi + +fiInhibitVarExpandR :: TyVarId -> FIIn' gm -> FIIn' gm +fiInhibitVarExpandR v fi = fi {fiExpRTvS = v `Set.insert` fiExpRTvS fi} + +fiVarIsExpandedR :: TyVarId -> FIIn' gm -> Bool +fiVarIsExpandedR v fi = v `Set.member` fiExpRTvS fi + +{-# LINE 125 "src/ehc/Ty/FitsIn.chs" #-} +fiSwapCoCo :: FIIn' gm -> FIIn' gm +fiSwapCoCo fi = fi {fiExpLTvS = fiExpRTvS fi, fiExpRTvS = fiExpLTvS fi} + +{-# LINE 140 "src/ehc/Ty/FitsIn.chs" #-} +fiAppSpineLookup + :: forall gm . + ( VarLookupCmb VarMp gm + , VarLookup gm TyVarId VarMpInfo + ) + => FIIn' gm -> HsName -> AppSpineGam -> Maybe AppSpineInfo +fiAppSpineLookup fi n gappSpineGam + = case (asGamLookup n $ feAppSpineGam $ fiEnv fi,polGamLookup n (fePolGam $ fiEnv fi)) of + (Just asi, Just pgi) + -> Just $ upd pgi asi + (_,Just pgi) + -> Just $ upd pgi emptyAppSpineInfo + (mbasi,_) + -> mbasi + where upd pgi asi + | foHasErrs fo = asi + | otherwise = asi {asgiVertebraeL = zipWith asUpdateByPolarity (appUnArrArgs $ tyCanonic (emptyTyBetaRedEnv' emptyFE) $ foVarMp fo `varUpd` foTy fo) (asgiVertebraeL asi)} + where pol = pgiPol pgi + (polargs,polres) = appUnArr pol + (_,u1,u2) = mkNewLevUID2 uidStart + fo = fitsIn weakFIOpts emptyFE u1 (emptyVarMp :: VarMp) pol (map mkPolVar (mkNewUIDL (length polargs) u2) `appArr` polCovariant) + +{-# LINE 290 "src/ehc/Ty/FitsIn.chs" #-} +manyFO :: [FIOut] -> FIOut +manyFO = foldr1 (\fo1 fo2 -> if foHasErrs fo1 then fo1 else fo2) + +fitsIn + :: forall gm . + {- ( VarUpdatable Ty gm + , VarLookupCmb VarMp gm + , VarLookupCmb gm gm + ) + => -} + ( VarLookup gm TyVarId VarMpInfo + , VarLookupCmb VarMp gm + ) + => FIOpts -> FIEnv -> UID -> gm -> Ty -> Ty + -> FIOut +fitsIn opts env uniq varmp + = fitsInFI + ((emptyFI + { fiUniq = uniq + , fiFIOpts = opts + , fiVarMp = varmp + , fiEnv = env + } + ) :: FIIn' gm + ) + +{-# LINE 320 "src/ehc/Ty/FitsIn.chs" #-} +fitsInFI + :: forall gm . + {- ( VarUpdatable Ty gm + , VarLookupCmb VarMp gm + , VarLookupCmb gm gm + ) + => -} + ( VarLookup gm TyVarId VarMpInfo + , VarLookupCmb VarMp gm + ) + => FIIn' gm -> Ty -> Ty + -> FIOut +fitsInFI fi ty1 ty2 + = foRes {foTrace = reverse $ foTrace foRes} + where + appSpineGam = feAppSpineGam $ fiEnv fi + -- options + globOpts = feEHCOpts $ fiEnv fi + -- range where fitsIn takes place + range = feRange $ fiEnv fi + + -- tracing + trfiAdd tr fi = fi + trfi msg rest fi = fi + trfoAdd tr fo = fo + trfo msg rest fo = fo + + -- derivation tree + dtfo _ _ _ _ _ _ fo = fo + + -- results + res' fi tv t = updtr $ (fifo fi emptyFO) {foTy = tv, foMbAppSpineInfo = fiAppSpineLookup fi (tyConNm t) appSpineGam} + where updtr = id + res fi t = res' fi t t + + -- errors + err fi e = trfo "err" (ppErrL e) + $ emptyFO {foUniq = fioUniq (fiFIOpts fi), foErrL = e, foTrace = fiTrace fi} + errClash fiErr t1 t2 = maybe dflt (\mk -> err fiErr [mk ty1 ty2]) $ fiMbMkErrClash $ fiFIOpts fiErr + where dflt = err fiErr [rngLift range Err_UnifyClash (fiAppVarMp fiErr ty1) (fiAppVarMp fiErr ty2) (fioMode (fiFIOpts fi)) (fiAppVarMp fiErr t1) (fiAppVarMp fiErr t2) (fioMode (fiFIOpts fiErr))] + + + -- binding + occurBind fi isLBind v t= bind fi isLBind v t + +{-# LINE 417 "src/ehc/Ty/FitsIn.chs" #-} + -- 20080309, AD: naming of function is not right, type info neither, error yes. Should indicate a double expansion of tyvar, indicating infinite type. + errInfinite fi v t = err fi [rngLift range Err_UnifyOccurs (fiAppVarMp fi ty1) (fiAppVarMp fi ty2) (fioMode (fiFIOpts fi)) v t (fioMode (fiFIOpts fi))] + +{-# LINE 422 "src/ehc/Ty/FitsIn.chs" #-} + lookupImplsVarCyc fi v = fiLookupVar' varmpImplsLookupCyc varmpImplsLookupCyc v (fiVarMpLoc fi) (fiVarMp fi) +{-# LINE 425 "src/ehc/Ty/FitsIn.chs" #-} + lookupLabelCyc fi v = fiLookupVar' varmpLabelLookupLabelCyc varmpLabelLookupLabelCyc v (fiVarMpLoc fi) (fiVarMp fi) + +{-# LINE 429 "src/ehc/Ty/FitsIn.chs" #-} + bind fi isLBind tv t = dtfo "bind" fi tv' t [] (tv `varmpTyUnit` t) + $ res' (fiBindTyVar tv t fi2) tv' t + where tv' = mkTyVar tv + fi2 = case (tyMbVar t, (if isLBind then fioBindRVars else fioBindLVars) (fiFIOpts fi)) of + (Just v, FIOBindNoBut but) | not (v `Set.member` but) + -> -- (\x -> let o = fiFIOpts x in Debug.tr "fitsIn.bind.fi2" (isLBind >#< tv >#< t >-< show (fioBindRVars o) >#< show (fioBindLVars o) >-< show (fioDontBind $ fiFIOpts fi) >#< show (fioDontBind o)) x) $ + fiInhibitBind v fi + _ -> fi + +{-# LINE 448 "src/ehc/Ty/FitsIn.chs" #-} + allowImpredTVBindL fi t _ + = fioBindLFirst (fiFIOpts fi) && fiAllowTyVarBind fi t + allowImpredTVBindR fi t _ + = fioBindRFirst (fiFIOpts fi) && fiAllowTyVarBind fi t + +{-# LINE 455 "src/ehc/Ty/FitsIn.chs" #-} + -- removal of quantifier + unquant fi t hide howToInst + = ( fi { fiUniq = u + , fiVarMpLoc = instToL1VarMp instto |+> fiVarMpLoc fi + } + , uqt,back,instto + ) + where (u,uq) = mkNewLevUID (fiUniq fi) + (uqt,rtvs,instto) = tyInst1Quants uq howToInst t + back = if hide then \fo -> foSetVarMp (varmpDel rtvs (foVarMp fo)) $ foUpdTy t fo + else id + +{-# LINE 501 "src/ehc/Ty/FitsIn.chs" #-} + foUpdVarMp c fo = fo {foVarMp = c |+> foVarMp fo} + fifo fi fo = fo { foVarMp = fiVarMpLoc fi, foUniq = fiUniq fi, foTrace = fiTrace fi + , foDontBind = fioDontBind (fiFIOpts fi) + } + fofi fo fi = -- (\x -> Debug.tr "fofi" ((pp $ show $ fioDontBind o) >-< (pp $ show $ foDontBind fo) >-< (pp $ show $ fioDontBind $ fiFIOpts x)) x) + fi { fiVarMpLoc = foVarMp fo, fiUniq = foUniq fo, fiTrace = foTrace fo + , fiFIOpts = o {fioDontBind = foDontBind fo} + } + where o = fiFIOpts fi + +{-# LINE 517 "src/ehc/Ty/FitsIn.chs" #-} + fiInhibitBind v fi = fi {fiFIOpts = o {fioDontBind = v `Set.insert` fioDontBind o}} + where o = fiFIOpts fi + +{-# LINE 522 "src/ehc/Ty/FitsIn.chs" #-} + foUpdTy t fo = fo {foTy = t} + +{-# LINE 526 "src/ehc/Ty/FitsIn.chs" #-} + foCmbAppTy ffo afo = afo {foTy = Ty_App (foTy ffo) (foTy afo)} + foCmbVarMp ffo afo = afo -- {foVarMp = foVarMp afo `varUpd` foVarMp ffo} + foCmbCoCon ffo afo = afo {foMbAppSpineInfo = fmap asgiShift1SpinePos $ foMbAppSpineInfo ffo} + +{-# LINE 532 "src/ehc/Ty/FitsIn.chs" #-} + foCmbPrL ffo afo = afo {foPredOccL = foPredOccL afo ++ foPredOccL ffo, foGathCnstrMp = foGathCnstrMp afo `cnstrMpUnion` foGathCnstrMp ffo} +{-# LINE 535 "src/ehc/Ty/FitsIn.chs" #-} + foCmbCSubst ffo afo = afo {foCSubst = cSubstApp (foCSubst afo) (foCSubst ffo)} +{-# LINE 542 "src/ehc/Ty/FitsIn.chs" #-} + foCmbApp ffo = + -- foCmbTvKiVarMp ffo . + -- (\afo -> afo {foDontBind = ((\x -> Debug.tr "foCmbApp.ffo" (pp $ show x) x) $ foDontBind ffo) `Set.union` ((\x -> Debug.tr "foCmbApp.afo" (pp $ show x) x) $ foDontBind afo)}) . + foCmbPrfRes ffo . + foCmbCoCon ffo . foCmbVarMp ffo . foCmbAppTy ffo + +{-# LINE 560 "src/ehc/Ty/FitsIn.chs" #-} + foCmbPrfRes ffo = foCmbPrL ffo + . foCmbCSubst ffo + +{-# LINE 570 "src/ehc/Ty/FitsIn.chs" #-} + fiAddPr n i prTy fi + = let e = fiEnv fi + (_,assumePredScope) = pscpEnter 0 $ fePredScope (fiEnv fi) + pr = tyPred prTy + in (fi { fiEnv = e {fePredScope = assumePredScope} },gathPredLToAssumeCnstrMp [rngLift range mkPredOccRng pr i assumePredScope]) + foUpdErrs e fo = fo {foErrL = e ++ foErrL fo} + foUpdCnstrMp m fo = fo {foGathCnstrMp = m `cnstrMpUnion` foGathCnstrMp fo} + foUpdPrL prL prMp fo = foUpdCnstrMp prMp $ fo {foPredOccL = prL ++ foPredOccL fo} + foUpdImplExpl iv im tpr fo + = foUpdVarMp (iv `varmpImplsUnit` im) + $ foUpdTy ([tpr] `appArr` foTy fo) + $ fo + foUpdLRCoe lrcoe fo = fo {foLRCoe = lrcoe `lrcoeUnion` foLRCoe fo} + foUpdImplExplCoe iv im tpr + lrcoe + fo + = foUpdImplExpl iv im tpr + $ foUpdLRCoe lrcoe + fo + +{-# LINE 611 "src/ehc/Ty/FitsIn.chs" #-} + deepInstMatchTy fi t + = case t of + _ | not (null as + || tyConNm f == hsnPolNegation + ) + -> Just (appTopApp $ mkNewTyVarL (length as + 1) u1, fi') + | otherwise -> Nothing + where (f,as) = appUnApp t + where (u,u1) = mkNewLevUID (fiUniq fi) + fi' = fi {fiUniq = u} + +{-# LINE 626 "src/ehc/Ty/FitsIn.chs" #-} + fPairWise fi tL1 tL2 + = foldr (\(t1,t2) (foL,fii) + -> let fo = fVar' fTySyn fii id t1 t2 + in (fo:foL,fofi fo fii)) + ([],fi) + (zip tL1 tL2) + +{-# LINE 641 "src/ehc/Ty/FitsIn.chs" #-} + fRow fi tr1 tr2 isRec isSum + = foR + where (r1,exts1) = tyRowExtsUnAnn $ tyRowExtsWithLkup (fiLookupTyVarCyc fi) tr1 + (r2,exts2) = tyRowExtsUnAnn $ tyRowExtsWithLkup (fiLookupTyVarCyc fi) tr2 + (extsIn1,extsIn12,extsIn2) = split (rowCanonOrder exts1) (rowCanonOrder exts2) + split ees1@(e1:es1) ees2@(e2:es2) + = case e1 `rowExtCmp` e2 of + EQ -> let (es1',es12,es2') = split es1 es2 in (es1',(e1,e2):es12,es2') + LT -> let (es1',es12,es2') = split es1 ees2 in (e1:es1',es12,es2') + GT -> let (es1',es12,es2') = split ees1 es2 in (es1',es12,e2:es2') + split ees1 ees2 + = (ees1,[],ees2) + mkTv fi = (fi',mkTyVar u) + where (u',u) = mkNewUID (fiUniq fi) + fi' = fi {fiUniq = u'} + bind fo v r e = manyFO [fo,foUpdTy (foTy fo `recRow` e) $ foUpdVarMp (v `varmpTyUnit` recRow r e) $ fo] + (u',u1) = mkNewLevUID (fiUniq fi) + fi2 = fi {fiUniq = u'} + + fR fi r1 r2@(Ty_Var v2 f2) e1@(_:_) e12 e2 + | fiAllowTyVarBind fi r2 + = bind (fR fi2 r1 rv [] e12 e2) v2 rv e1 + where (fi2,rv) = mkTv fi + fR fi r1@(Ty_Var v1 f1) r2 e1 e12 e2@(_:_) + | fiAllowTyVarBind fi r1 + = bind (fR fi2 rv r2 e1 e12 []) v1 rv e2 + where (fi2,rv) = mkTv fi + fR fi r1@(Ty_Con n1) _ _ _ e2@(_:_) + | n1 == hsnRowEmpty && isRec + = err fi [rngLift range Err_MissingRowLabels (assocLKeys e2) (fiAppVarMp fi tr1)] +{- + fR fi r1 r2@(Ty_Con n2) e1@(_:_) e12 e2 + | n2 == hsnRowEmpty && isRec && not (null labs) + = err fi [rngLift range Err_MissingRowLabels labs (fiAppVarMp fi tr2)] + where labs = fioNoLLabElimFor (fiFIOpts fi) `List.intersect` assocLKeys e1 +-} + fR fi r1 r2@(Ty_Con n2) e1@(_:_) e12 e2 + | n2 == hsnRowEmpty && isRec + = if null labs + then fR fi r1 r2 [] e12 e2 + else err fi [rngLift range Err_TooManyRowLabels (assocLKeys e1) (fiAppVarMp fi tr2)] + where labs = fioNoRLabElimFor (fiFIOpts fi) `List.intersect` assocLKeys e1 + fR fi r1@(Ty_Con n1) r2 e1 e12 e2@(_:_) + | n1 == hsnRowEmpty && isSum + = fR fi r1 r2 e1 e12 [] + fR fi r1 r2@(Ty_Con n2) e1@(_:_) e12 e2 + | n2 == hsnRowEmpty && isSum + = err fi [rngLift range Err_MissingRowLabels (assocLKeys e1) (fiAppVarMp fi tr2)] + fR fi r1 r2 e1 e12@(_:_) e2 + = foR + where (e1L,e2L) = unzip e12 + (foL,fi2) = fPairWise ({- fiUpdOpts fioMkStrong -} fi) (assocLElts e1L) (assocLElts e2L) + eKeys = assocLKeys e1L + eL = zip eKeys (map foTy foL) + fo = fR fi2 r1 r2 e1 [] e2 + foR = manyFO ([fo] ++ foL ++ [foRes]) + foRes = (\fo -> foldr foCmbPrfRes fo foL) + $ foUpdRecFldsCoe eKeys foL tr1 + $ foUpdTy (foTy fo `recRow` eL) fo + +{-# LINE 710 "src/ehc/Ty/FitsIn.chs" #-} + fR fi r1@(Ty_Var _ f1) r2@(Ty_Con n2) [] [] [] + | tvCatIsFixed f1 && n2 == hsnRowEmpty && isRec + = res fi r2 + fR fi r1@(Ty_Var v1 f1) r2@(Ty_Con n2) [] [] [] + | f1 `elem` fioBindCategs (fiFIOpts fi) {- tvCatIsPlain f1 -} && n2 == hsnRowEmpty && isRec + = occurBind fi True v1 r2 + fR fi r1 r2 [] [] [] + = (fBase fi id r1 r2) + { foLRCoe = emptyLRCoe + } + +{-# LINE 736 "src/ehc/Ty/FitsIn.chs" #-} + fR fi _ _ _ _ _ + = errClash fi tr1 tr2 + +{-# LINE 745 "src/ehc/Ty/FitsIn.chs" #-} + fo = fR fi2 r1 r2 extsIn1 extsIn12 extsIn2 + foR = (if isRec then foUpdRecCoe tr1 r1 r2 extsIn1 extsIn12 extsIn2 else id) fo + foUpdRecCoe tr1 r1 r2 e1 e12 e2 fo + = let rn = uidHNm u1 + predScope = fePredScope (fiEnv fi) + -- tr1s = foVarMp fo `varUpd` tr1 + fi3 = fofi fo fi2 + tr1s = uncurry recRow $ tyRowExtsUnAnn $ tyRowExtsWithLkup (fiLookupTyVarCyc fi3) tr1 + (u',u2,u3,u4) = mkNewLevUID3 (foUniq fo) + r = acoreVar rn + mkLSel n u = acoreSelCaseTy (emptyRCEEnv globOpts) (Just (hsnUniqifyEval rn,acoreTyErr "fitsIn.mkLSel")) r CTagRec n {-n-} (acoreNmHole u) Nothing + mkLPred' r l u + = let r' = maybe Ty_Any fst $ tyRowExtr l r + in (rngLift range mkPredOccRng (Pred_Lacks r' (Label_Lab l)) (mkPrIdCHR u) predScope,r') + mkLPred r l u = fst (mkLPred' r l u) + rowCoeL = sortByOn rowLabCmp fst (foRowCoeL fo) + -- rowCoeL = sortByOn rowLabCmp fst $ map fst extsIn12 + (fuUpdL,prUpdL,tr1s',csubstUpd,_) + = foldr (\(l,c) (fuL,prL,r,csubst,u) + -> let (u',u1,u2) = mkNewLevUID2 u + (sel,csubstSel) = coeEvalOnAsSubst u2 c (mkLSel l u1) + in ( ( l + , (CExpr_TupUpd (acoreBuiltinUndefined globOpts) CTagRec l (acoreNmHole u) sel,Nothing) + ) : fuL + , mkLPred r l u1 : prL + , r + , csubst `cSubstApp` csubstSel + , u' + ) + ) + ([],[],tr1s,emptyCSubst,u2) + rowCoeL + (fuDelL,prDelL,_,_) + = foldl (\(fuL,prL,r,u) l + -> let (pr,r') = mkLPred' r l u + in ( ( l + , (CExpr_TupDel (acoreVar hsnWild) CTagRec l (acoreNmHole u),Nothing) + ) : fuL + , pr:prL,r',uidNext u + ) + ) + ([],[],tr1s',u3) (sortBy rowLabCmp (assocLKeys e1)) + fuL = fuUpdL ++ reverse fuDelL + (prBldL, fBldL, _, csubstBld, _) + = foldr (\l (prL,fL,r,csubst,u) + -> let (u',u1,u2) = mkNewLevUID2 u + (sel,csubstSel) + = maybe (s,emptyCSubst) (\c -> coeEvalOnAsSubst u2 c s) (lookup l rowCoeL) + where s = mkLSel l u1 + in ( mkLPred r l u1 : prL, + sel : + fL + , r + , csubst `cSubstApp` csubstSel + , u' + ) + ) + ([], [], tr1s, emptyCSubst, u3) + (sortBy rowLabCmp ((assocLKeys . map fst $ e12) ++ assocLKeys e2)) + in case r2 of + Ty_Con n2 + | n2 == hsnRowEmpty && null fuL && null e2 + -> fo + { foLRCoe = emptyLRCoe + , foCSubst = foCSubst fo `cSubstApp` csubstUpd `cSubstApp` csubstBld + } +{- -- when ext rec deletes are implemented + | n2 == hsnRowEmpty && null fuUpdL && not (null fuDelL) && null e2 + -> let coe = Coe_Map (\e -> acoreLet CBindCateg_Plain [CBind_Bind rn e] (fuMkCExpr globOpts u4 fuDelL r)) + in fo { foLRCoe = lrcoeLSingleton coe + , foPredOccL = prDelL ++ foPredOccL fo + , foGathCnstrMp = gathPredLToProveCnstrMp prDelL `cnstrMpUnion` foGathCnstrMp fo + , foUniq = u' + } +-} + | n2 == hsnRowEmpty && not (null prBldL) + -> let + coe = Coe_Map (\e -> acoreLet1Plain rn e (acoreTagTupTy CTagRec (acoreTyErr "fitsIn.foUpdRecCoe.coe") fBldL)) + in fo { foPredOccL = prBldL ++ foPredOccL fo + , foGathCnstrMp = gathPredLToProveCnstrMp prBldL `cnstrMpUnion` foGathCnstrMp fo + , foUniq = u' + , foLRCoe = lrcoeLSingleton coe + } + Ty_Var _ cat + | tvCatIsFixed cat && not (null fuL) + -> fo { foPredOccL = prUpdL ++ prDelL ++ foPredOccL fo + , foGathCnstrMp = gathPredLToProveCnstrMp (prUpdL ++ prDelL) `cnstrMpUnion` foGathCnstrMp fo + , foUniq = u' + , foLRCoe = lrcoeLSingleton coe + } + where coe = Coe_Map (\e -> acoreLet1Plain rn e (fuMkCExpr globOpts u4 fuL r)) + _ | not (null fuUpdL) + -> fo { foPredOccL = prUpdL ++ foPredOccL fo + , foGathCnstrMp = gathPredLToProveCnstrMp prUpdL `cnstrMpUnion` foGathCnstrMp fo + , foUniq = u' + , foLRCoe = lrcoeLSingleton coe + } + | otherwise + -> fo + { foLRCoe = emptyLRCoe + } + where coe = Coe_Map (\e -> acoreLet1Plain rn e (fuMkCExpr globOpts u4 fuUpdL r)) + +{-# LINE 984 "src/ehc/Ty/FitsIn.chs" #-} + foUpdRecFldsCoe eKeys foL tr1 foR + = let (u',u1) = mkNewLevUID (foUniq foR) + us = mkNewLevUIDL (length foL) u1 + (cL,sL) + = unzip + [ ((l,c),s) + | (l,fo,u) <- zip3 eKeys foL us + , let (c,s) = lrcoeWipeWeaveAsSubst globOpts u (foVarMp foR) (foLRCoe fo) + , not (acoreCoeIsId c) + ] + in foR { foUniq = u' + , foRowCoeL = cL + , foCSubst = foldr cSubstApp (foCSubst foR) sL + } + +{-# LINE 1022 "src/ehc/Ty/FitsIn.chs" #-} + f fi t1 t2 + = fBase fi id t1 t2 +{-# LINE 1030 "src/ehc/Ty/FitsIn.chs" #-} + fTySyn fi updTy t1 t2 + = case filter (not . foHasErrs) tries of + (fo:_) -> fo + _ -> case (drop limit rt1, drop limit rt2, tries) of + ((t:_),_ ,_ ) -> err (trfiAdd (tbroutTracePPL t) fi2) [rngLift range Err_TyBetaRedLimit (fiAppVarMp fi2 t1) (fiAppVarMp fi2 (tbroutRes t)) limit] + (_ ,(t:_),_ ) -> err (trfiAdd (tbroutTracePPL t) fi2) [rngLift range Err_TyBetaRedLimit (fiAppVarMp fi2 t2) (fiAppVarMp fi2 (tbroutRes t)) limit] + (_ ,_ ,ts@(_:_)) -> last ts + (_ ,_ ,_ ) -> errClash fi2 t1 t2 + where limit = ehcOptTyBetaRedCutOffAt globOpts + fi2 = fi + rt1 = tyBetaRedAndInit (emptyTyBetaRedEnv {tbredFI=fi2}) betaRedTyLookup t1 + rt2 = tyBetaRedAndInit (emptyTyBetaRedEnv {tbredFI=fi2}) betaRedTyLookup t2 + tries = take (limit+1) $ try fi2 (rt1) (rt2) + where -- get the pairwise fitsIn of further and further expanded synonyms + try fi (t1:ts1@(_:_)) (t2:ts2@(_:_)) = (ok t1 t2 $ fBase fi' updTy (tbroutRes t1) (tbroutRes t2)) ++ try fi' ts1 ts2 + where fi' = trfiAdd (tbroutTracePPL t1) $ trfiAdd (tbroutTracePPL t2) fi + try fi ts1@[t1] (t2:ts2@(_:_)) = (ok t1 t2 $ fBase fi' updTy (tbroutRes t1) (tbroutRes t2)) ++ try fi' ts1 ts2 + where fi' = trfiAdd (tbroutTracePPL t2) fi + try fi (t1:ts1@(_:_)) ts2@[t2] = (ok t1 t2 $ fBase fi' updTy (tbroutRes t1) (tbroutRes t2)) ++ try fi' ts1 ts2 + where fi' = trfiAdd (tbroutTracePPL t1) fi + try fi [t1] [t2] = ok t1 t2 $ fBase fi' updTy (tbroutRes t1) (tbroutRes t2) + where fi' = fi + -- check for a valid combi using lookahead info of next expansion + ok e1 e2 f | betaRedIsOkFitsinCombi (fiAllowTyVarBind fi) + e1 e2 = [f] + | otherwise = [] + +{-# LINE 1063 "src/ehc/Ty/FitsIn.chs" #-} + varMayFit isL fi t@(Ty_Var v f) + = f `elem` fioBindCategs (fiFIOpts fi) && not (v `Set.member` fioDontBind (fiFIOpts fi)) + -- where mbvs = if isL then fioBindLVars (fiFIOpts fi) else fioBindRVars (fiFIOpts fi) +{-# LINE 1068 "src/ehc/Ty/FitsIn.chs" #-} + varMayExpand mbvs fi t@(Ty_Var v f) + = not ((fioBindIsYes mbvs || v `Set.member` fioBindNoSet mbvs) || v `Set.member` fioDontBind (fiFIOpts fi)) + +{-# LINE 1073 "src/ehc/Ty/FitsIn.chs" #-} + fVar' f fi updTy t1@(Ty_Var v1 f1) t2@(Ty_Var v2 f2) + | v1 == v2 && f1 == f2 + && not (fioExpandEqTyVar (fiFIOpts fi)) + = res fi t1 + fVar' f fi updTy t1@(Ty_Var v1 f1) t2 + | isJust mbTy1 = if fiVarIsExpandedL v1 fi + then errInfinite fi v1 t1' + else fVar' f (fiInhibitVarExpandL v1 fi2) updTy t1' t2 + | varMayExpand mbvs fi t1 = fVar' f (fiInhibitBind v1 fi2) updTy t1 t2 + where mbTy1 = fiLookupTyVarCyc fi v1 + t1' = fromJust mbTy1 + fi2 = fi + mbvs = fioBindLVars (fiFIOpts fi) + fVar' f fi updTy t1 t2@(Ty_Var v2 f2) + | isJust mbTy2 = if fiVarIsExpandedR v2 fi + then errInfinite fi v2 t2' + else fVar' f (fiInhibitVarExpandR v2 fi2) updTy t1 t2' + | varMayExpand mbvs fi t2 = fVar' f (fiInhibitBind v2 fi2) updTy t1 t2 + where mbTy2 = fiLookupTyVarCyc fi v2 + t2' = fromJust mbTy2 + fi2 = fi + mbvs = fioBindRVars (fiFIOpts fi) + fVar' f fi updTy t1 t2 = fAnn f fi2 updTy t1 t2 + where fi2 = fi + + fVar f fi t1 t2 = fVar' f fi id t1 t2 + +{-# LINE 1147 "src/ehc/Ty/FitsIn.chs" #-} + -- | tvar binding part 1: 2 tvars + varBind1 fi updTy t1@(Ty_Var v1 f1) t2@(Ty_Var v2 f2) + | v1 == v2 && f1 == f2 = Just $ res fi t1 + | lBefR && fiAllowTyVarBind fi t1 = Just $ bind fi True v1 (updTy t2) + | not lBefR && fiAllowTyVarBind fi t2 = Just $ bind fi False v2 (updTy t1) + where lBefR = fioBindLBeforeR (fiFIOpts fi) + varBind1 _ _ _ _ = Nothing + + -- | tvar binding part 2: 1 of 2 tvars, impredicatively + varBind2 fi updTy t1@(Ty_Var v1 _) t2 + | isJust m && v1 == v2 = Just $ res (fiBindImplsVar iv2 Impls_Nil fi) (updTy t1) + | allowImpredTVBindL fi t1 t2 = Just $ occurBind fi True v1 (updTy t2) + where m@(~(Just (iv2,v2))) = tyMb1ArrTailVar2VarWithLkup (fiLookupTyVarCyc fi) (lookupImplsVarCyc fi) t2 + varBind2 fi updTy t1 t2@(Ty_Var v2 _) + | isJust m && v1 == v2 = Just $ res (fiBindImplsVar iv1 Impls_Nil fi) (updTy t2) + | allowImpredTVBindR fi t2 t1 = Just $ occurBind fi False v2 (updTy t1) + where m@(~(Just (iv1,v1))) = tyMb1ArrTailVar2VarWithLkup (fiLookupTyVarCyc fi) (lookupImplsVarCyc fi) t1 + varBind2 _ _ _ _ = Nothing + + -- | tvar binding part 3: 1 of 2 tvars, non impredicatively + varBind3 fi updTy t1@(Ty_Var v1 _) t2 + | fiAllowTyVarBind fi t1 = case deepInstMatchTy fi t2 of + Just (t1',fi') | fiRankEqInstRank fi + -> Just $ fVar' fBase (fiInitInstRank $ fiBindTyVar v1 t1' fi') updTy t1 t2 + _ -> Just $ occurBind fi True v1 t2 + varBind3 fi updTy t1 t2@(Ty_Var v2 _) + | fiAllowTyVarBind fi t2 = case deepInstMatchTy fi t1 of + Just (t2',fi') | fiRankEqInstRank fi + -> Just $ fVar' fBase (fiInitInstRank $ fiBindTyVar v2 t2' fi') updTy t1 t2 + _ -> Just $ occurBind fi False v2 t1 + varBind3 _ _ _ _ = Nothing + +{-# LINE 1189 "src/ehc/Ty/FitsIn.chs" #-} + fAnn f fi updTy t1@(Ty_Var _ _) t2 = case tyAnnDecomposeMk t2 of + (t2@(Ty_Var _ _), (_:_), mk2) + -> fVar' f fi2 (updTy . mk2) t1 t2 + where fi2 = fi + _ -> f fi updTy t1 t2 + fAnn f fi updTy t1 t2@(Ty_Var _ _) = case tyAnnDecomposeMk t1 of + (t1@(Ty_Var _ _), (_:_), mk1) + -> fVar' f fi2 (updTy . mk1) t1 t2 + where fi2 = fi + _ -> f fi updTy t1 t2 + fAnn f fi updTy t1 t2 = f fi updTy t1 t2 + +{-# LINE 1211 "src/ehc/Ty/FitsIn.chs" #-} + fVarPred2 f fi tpr1 (Ty_Impls (Impls_Tail iv2 _)) + | isJust mbTl = f fi tpr1 (Ty_Impls tl2) + where mbTl@(~(Just tl2)) = lookupImplsVarCyc fi iv2 + fVarPred2 f fi (Ty_Impls (Impls_Tail iv1 _)) tpr2 + | isJust mbTl = f fi (Ty_Impls tl1) tpr2 + where mbTl@(~(Just tl1)) = lookupImplsVarCyc fi iv1 + fVarPred2 f fi tpr1 tpr2 + = f fi tpr1 tpr2 + fVarPred1 f fi (Ty_Impls (Impls_Tail iv1 _)) + | isJust mbTl = f fi (Ty_Impls (fromJust mbTl)) + where mbTl = lookupImplsVarCyc fi iv1 + fVarPred1 f fi tpr1 + = f fi tpr1 + +{-# LINE 1227 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1 t2 + | fioMode (fiFIOpts fi) == FitSubRL = fBase fi' updTy t2 t1 + where fi' = fiSwapCoCo $ fi {fiFIOpts = fioSwapOpts $ fioSwapPolarity polContravariant $ fiFIOpts fi} + fBase fi updTy Ty_Any t2 = res fi t2 + fBase fi updTy t1 Ty_Any = res fi t1 + fBase fi updTy t1@(Ty_Con s1) t2@(Ty_Con s2) + | s1 == s2 = dtfo "con" fi t1 t2 [] emptyVarMp + $ res fi t2 + + fBase fi updTy t1 t2 + | isJust mbVarBind = fromJust mbVarBind + where mbVarBind = varBind1 fi updTy t1 t2 + +{-# LINE 1242 "src/ehc/Ty/FitsIn.chs" #-} + -- get rid of annotation for fitsIn, but preserve as result + fBase fi updTy t1@(Ty_Ann TyAnn_Mono at1) t2 = fo + where fi2 = fi { fiFIOpts = (fiFIOpts fi) {fioBindLFirst = False} } + fo = fVar' fBase fi2 (updTy . tyAnnMono) at1 t2 + fBase fi updTy t1 t2@(Ty_Ann TyAnn_Mono at2) + = fo + where fi2 = fi { fiFIOpts = (fiFIOpts fi) {fioBindRFirst = False} } + fo = fVar' fBase fi2 (updTy . tyAnnMono) t1 at2 + + fBase fi updTy t1@(Ty_Ann a1 at1) t2 = fVar' fBase fi updTy at1 t2 + fBase fi updTy t1 t2@(Ty_Ann a2 at2) + = fVar' fBase fi updTy t1 at2 + +{-# LINE 1257 "src/ehc/Ty/FitsIn.chs" #-} + -- always get rid of empty implicits + fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1) + t2 + | hsnIsArrow c1 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp + = fromJust mbfp + where mbfp = fVarPred1 fP fi tpr1 + fP fi (Ty_Impls (Impls_Nil)) + = Just (fVar' fTySyn fi updTy tr1 t2) + fP fi _ = Nothing + fBase fi updTy t1 + t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2) + | hsnIsArrow c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp + = fromJust mbfp + where mbfp = fVarPred1 fP fi tpr2 + fP fi (Ty_Impls (Impls_Nil)) + = Just (fVar' fTySyn fi updTy t1 tr2) + fP fi _ = Nothing + +{-# LINE 1277 "src/ehc/Ty/FitsIn.chs" #-} + -- here we decide whether to bind impredicatively, anything not to be bounded as such must be dealt with before here + fBase fi updTy t1 t2 + | isJust mbVarBind = fromJust mbVarBind + where mbVarBind = varBind2 fi updTy t1 t2 + +{-# LINE 1284 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1@(Ty_Pred pr1) t2@(Ty_Pred pr2) + | fioPredAsTy (fiFIOpts fi) && isJust mbfp + = let (fo,pr) = fromJust mbfp in foUpdTy (Ty_Pred pr) fo + where mbfp = fP pr1 pr2 + fP (Pred_Class ct1) (Pred_Class ct2) + = Just (fo,Pred_Class (foTy fo)) + where fo = fVar' fTySyn fi id ct1 ct2 + fP (Pred_Pred prt1) (Pred_Pred prt2) + = Just (fo,Pred_Pred (foTy fo)) + where fo = fVar' fTySyn fi id prt1 prt2 +{-# LINE 1296 "src/ehc/Ty/FitsIn.chs" #-} + fP (Pred_Lacks lt1 l1) (Pred_Lacks lt2 l2) + | l1' == l2' + = Just (fo,Pred_Lacks (foTy fo) l1') + where fo = fVar' fTySyn fi id lt1 lt2 + l1' = maybe l1 id $ lookupLabelCyc fi l1 + l2' = maybe l2 id $ lookupLabelCyc fi l2 +{-# LINE 1304 "src/ehc/Ty/FitsIn.chs" #-} + fP _ _ + = Nothing + +{-# LINE 1309 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1@(Ty_TBind q1 _ _ _) t2@(Ty_TBind q2 _ _ _) + | fioMode (fiFIOpts fi) == FitUnify && q1 == q2 + = fVar' fTySyn fi2 id uqt1 uqt2 + where (fi1,uqt1,_,_) = unquant fi t1 False instCoConst + (fi2,uqt2,_,_) = unquant fi1 t2 False instCoConst + +{-# LINE 1321 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1 t2@(Ty_TBind _ _ _ _) + | fioIsSubsume (fiFIOpts fi) && fioLeaveRInst (fiFIOpts fi) + = back2 (fo { foRInstToL = instto2 ++ foRInstToL fo + }) + where (fi2,uqt2,back2,instto2) = unquant fi t2 False instCoConst + fo = fVar' fTySyn fi2 id t1 uqt2 + fBase fi updTy t1 t2@(Ty_TBind _ _ _ _) + | fioIsSubsume (fiFIOpts fi) && not (fioLeaveRInst (fiFIOpts fi)) + = back2 (fo { foRInstToL = instto2 ++ foRInstToL fo + }) + where (fi2,uqt2,back2,instto2) = unquant fi t2 False instContra + fo = fVar' fTySyn fi2 id t1 uqt2 + +{-# LINE 1344 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1@(Ty_TBind _ _ _ _) t2 + | fioIsSubsume (fiFIOpts fi) = fo { foLInstToL = instto1 ++ foLInstToL fo + } + where (fi1,uqt1,back1,instto1) = unquant fi t1 False instCoConst + fo = fVar' fTySyn fi1 id uqt1 t2 + +{-# LINE 1356 "src/ehc/Ty/FitsIn.chs" #-} + -- tpr1 => tr1 `fit` tpr2 => tr2 + fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1) + t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2) + | hsnIsArrow c1 && c1 == c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp + = fromJust mbfp + where -- decompose + -- the work + (u',u1,u2,u3) = mkNewLevUID3 (fiUniq fi) + prfPredScope = fePredScope (fiEnv fi) + mbfp = fVarPred2 fP (fi {fiUniq = u'}) tpr1 tpr2 + mberr = Just (errClash fi t1 t2) + {- + fSub fi prv tr1 tr2 + = + where prn = poiHNm prv + fi2 = fiAddPr prn prv tpr2 fi + fo = fVar fTySyn fi2 tr1 tr2 + -} + fP fi tpr1@(Ty_Pred _) tpr2@(Ty_Pred _) + = if foHasErrs pfo + then Nothing + else Just ( foUpdTy (updTy $ [foTy pfo] `appArr` foTy fo) + $ foUpdLRCoe (mkIdLRCoeWith n CMetaVal_Dict) + $ fo) + where pfo = fVar' fBase (fi {fiFIOpts = predFIOpts}) id tpr2 tpr1 + n = uidHNm u2 + fo = fVar' fTySyn (fofi pfo fi) id tr1 tr2 + fP fi tpr1@(Ty_Pred pr1) (Ty_Impls (Impls_Tail iv2 ipo2)) + = Just (foUpdImplExplCoe iv2 + (Impls_Cons iv2 pr1 (mkPrIdCHR u2) range ipo2 im2) + tpr1 + (mkIdLRCoeWith n CMetaVal_Dict) + fo) + where im2 = Impls_Tail u1 ipo2 + n = uidHNm u2 + fo = fVar' fTySyn fi updTy tr1 ([Ty_Impls im2] `appArr` tr2) + fP fi (Ty_Impls (Impls_Tail iv1 ipo1)) tpr2@(Ty_Pred pr2) + = Just (foUpdImplExplCoe iv1 + (Impls_Cons iv1 pr2 (mkPrIdCHR u2) range ipo1 im1) + tpr2 + (mkIdLRCoeWith n CMetaVal_Dict) + fo) + where im1 = Impls_Tail u1 ipo1 + n = uidHNm u2 + fo = fVar' fTySyn fi updTy ([Ty_Impls im1] `appArr` tr1) tr2 + fP fi (Ty_Impls (Impls_Tail iv1 _)) tpr2@(Ty_Impls im2@(Impls_Nil)) + = Just (foUpdImplExpl iv1 im2 tpr2 (fVar' fTySyn fi id tr1 tr2)) + fP fi (Ty_Impls (Impls_Nil)) tpr2@(Ty_Impls im2@(Impls_Tail iv2 _)) + = Just (foUpdImplExpl iv2 Impls_Nil (Ty_Impls Impls_Nil) (fVar' fTySyn fi id tr1 tr2)) + fP fi tpr1@(Ty_Impls (Impls_Tail iv1 _)) (Ty_Impls im2@(Impls_Tail iv2 _)) | iv1 == iv2 + = Just (res fi tpr1) + fP fi (Ty_Impls (Impls_Tail iv1 ipo1)) (Ty_Impls im2@(Impls_Tail iv2 ipo2)) + = Just (foUpdImplExplCoe iv1 im2' (Ty_Impls im2') + (mkLRCoe (Coe_ImplApp iv2) (Coe_ImplLam iv2)) + (fVar' fTySyn fi updTy tr1 tr2)) + where im2' = Impls_Tail iv2 ({- [ipo] ++ -} ipo1 ++ ipo2) + -- ipo = mkImplsProveOcc u1 (fePredScope (fiEnv fi)) + fP fi (Ty_Impls Impls_Nil) (Ty_Impls Impls_Nil) + = Just (fVar' fTySyn fi updTy tr1 tr2) + fP fi (Ty_Impls Impls_Nil) (Ty_Impls _) + = mberr + fP fi (Ty_Impls Impls_Nil) (Ty_Pred _) + = mberr + fP fi (Ty_Impls _) (Ty_Impls Impls_Nil) + = mberr + -- fP fi (Ty_Pred _) (Ty_Impls Impls_Nil) + -- = mberr + fP fi _ _ + = Nothing + +{-# LINE 1456 "src/ehc/Ty/FitsIn.chs" #-} + -- t1 `fit` tpr2 => tr2 + fBase fi updTy t1 + t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2) + | hsnIsArrow c2 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp + = fromJust mbfp + where -- decompose + -- the work + (u',u1) = mkNewLevUID (fiUniq fi) + mbfp = fVarPred1 fP (fi {fiUniq = u'}) tpr2 + mkPrTy pr2 fo = [Ty_Pred ({- foVarMp fo `varUpd` -} pr2)] `appArr` foTy fo + fSub fi updTy pr2v pr2 tr2 + = let pr2n = poiHNm pr2v + (fi3,cnstrMp) + = fiAddPr pr2n pr2v tpr2 fi + fo = fVar' fTySyn fi3 updTy t1 tr2 + rCoe = acoreCoeLamLet pr2n (poiId pr2v) + in ( foUpdCnstrMp cnstrMp fo + , rCoe + ) + {- + fP fi (Ty_Impls (Impls_Nil)) + = Just fo + where fo = fVar' fTySyn fi updTy t1 tr2 + -} + fP fi (Ty_Impls (Impls_Tail iv2 _)) + = Just (foUpdVarMp (iv2 `varmpImplsUnit` Impls_Nil) fo) + where fo = fVar' fTySyn fi updTy t1 tr2 + fP fi (Ty_Impls (Impls_Cons _ pr2 pv2 _ _ im2)) + = Just ( foUpdTy (updTy $ mkPrTy pr2 fo) + $ foUpdLRCoe (lrcoeRSingleton rCoe) + $ fo ) + where ( fo + , rCoe + ) + = fSub fi id pv2 pr2 ([Ty_Impls im2] `appArr` tr2) + fP fi (Ty_Pred pr2) | fioAllowRPredElim (fiFIOpts fi) + = Just ( foUpdTy (updTy $ mkPrTy pr2 fo) + $ foUpdLRCoe (lrcoeRSingleton rCoe) + $ fo ) + where ( fo + , rCoe + ) + = fSub fi id (mkPrIdCHR u1) pr2 tr2 + fP fi _ = Nothing + +{-# LINE 1541 "src/ehc/Ty/FitsIn.chs" #-} + -- tpr1 => tr1 `fit` t2 + fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1) + t2 + | hsnIsArrow c1 && not (fioPredAsTy (fiFIOpts fi)) && isJust mbfp + = fromJust mbfp + where -- decompose + -- the work + (u',u1,u2,u3) = mkNewLevUID3 (fiUniq fi) + prfPredScope = fePredScope (fiEnv fi) + mbfp = fVarPred1 fP (fi {fiUniq = u'}) tpr1 + fSub fi updTy pv1 psc1 pr1 tr1 + = let fo = fVar' fTySyn fi updTy tr1 t2 + fs = foVarMp fo + prfPrL= [rngLift range mkPredOccRng pr1 pv1 psc1] + coe = acoreCoeApp1 (acoreNmHolePred pv1) + in ( fo + , coe + , gathPredLToProveCnstrMp prfPrL + ) + {- + fP fi (Ty_Impls (Impls_Nil)) + = Just (fVar' fTySyn fi updTy tr1 t2) + -} + fP fi (Ty_Impls (Impls_Tail iv1 _)) + | fiCoeCtx fi == CoeCtx_Allow + = Just ( + foUpdLRCoe (lrcoeLSingleton (Coe_ImplApp iv1)) + (fVar' fTySyn fi updTy tr1 t2) + ) + | otherwise + = Just (foUpdVarMp (iv1 `varmpImplsUnit` Impls_Nil) (fVar' fTySyn fi updTy tr1 t2)) + fP fi (Ty_Impls (Impls_Cons _ pr1 pv1 _ _ im1)) + = Just ( foUpdPrL [] cnstrMp + $ foUpdLRCoe (lrcoeLSingleton lCoe) + $ fo ) + where ( fo + , lCoe + , cnstrMp ) = fSub fi updTy pv1 prfPredScope pr1 ([Ty_Impls im1] `appArr` tr1) + fP fi (Ty_Pred pr1) + = Just ( foUpdPrL [] cnstrMp + $ foUpdLRCoe (lrcoeLSingleton lCoe) + $ fo ) + where ( fo + , lCoe + , cnstrMp ) = fSub fi updTy (mkPrIdCHR u1) prfPredScope pr1 tr1 + fP fi _ = Nothing + +{-# LINE 1633 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1@(Ty_App (Ty_Con n1) tr1) + t2@(Ty_App (Ty_Con n2) tr2) + | n1 == n2 && (isRec || isSum) + = foUpdTy (updTy $ n1 `appConApp` [foTy fo]) fo + where -- decompose + -- the work + isRec = hsnIsRec n1 + isSum = hsnIsSum n1 + fo = fRow fi tr1 tr2 isRec isSum + +{-# LINE 1658 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1 t2 + | isJust mbVarBind = fromJust mbVarBind + where mbVarBind = varBind3 fi updTy t1 t2 + +{-# LINE 1664 "src/ehc/Ty/FitsIn.chs" #-} + -- tf1 ta1 `fit` tf2 ta2 + fBase fi updTy t1@(Ty_App tf1 ta1) + t2@(Ty_App tf2 ta2) + = manyFO [ ffo, afo + , dtfo "app" fi t1 t2 [(ffo,"l"),(afo,"r")] emptyVarMp + $ foUpdTy (updTy $ foTy rfo) rfo + ] + where -- decompose + -- the work + fi2 = fi + ffo = fVar' fTySyn fi2 id tf1 tf2 + spine = asgiSpine $ foAppSpineInfo ffo + (as,_) = hdAndTl' unknownAppSpineVertebraeInfo spine + pol = asPolarity as + aCoeCtx= case (foMbAppSpineInfo ffo,asMbFOUpdCoe as) of + (Nothing,_ ) -> CoeCtx_DontAllow + (Just _ ,Nothing) -> CoeCtx_DontAllow + _ -> CoeCtx_Allow + fi3 = fi2 + fi4 = -- (\x -> Debug.tr "fBase.fi4" ((pp $ show $ fioDontBind $ fiFIOpts fi) >-< (pp $ show $ foDontBind ffo) >-< (pp $ show $ fioDontBind $ fiFIOpts x) ) x) $ + -- (fofi ffo $ fiUpdRankByPolarity pol $ fiSwapCoCo fi3) {fiFIOpts = asFIO as $ fioSwapPolarity pol $ fiFIOpts fi} + (fofi ffo $ + fiUpdRankByPolarity pol $ + fiSwapCoCo + (fi3 { fiFIOpts = asFIO as $ fioSwapPolarity pol $ fiFIOpts fi + , fiCoeCtx = aCoeCtx + })) + afo = fVar' fTySyn fi4 id ta1 ta2 + rfo = if aCoeCtx == CoeCtx_DontAllow && hasSubCoerce + then errCoerce + else asFOUpdCoe as globOpts [ffo, asFO as ffo $ foCmbApp ffo afo] + where errCoerce = err fi4 [rngLift range Err_NoCoerceDerivation + (fiAppVarMp fi4 ty1) (fiAppVarMp fi4 ty2) (fioMode (fiFIOpts fi4)) + (foVarMp afo `varUpd` foTy ffo) (foVarMp afo `varUpd` foTy afo)] + hasSubCoerce = not $ lrcoeIsId $ foLRCoe afo + +{-# LINE 1733 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1@(Ty_Ext _ _ _) t2@(Ty_Ext _ _ _) + = fRow fi t1 t2 False False + +{-# LINE 1753 "src/ehc/Ty/FitsIn.chs" #-} + -- N.B. hsnInvariant is a unique name which cannot be written by a programmer. In other words, + -- this pattern match cannot trigger during other type inferences. + -- Weaken Co/Contravariant polarity to Invariant polarity + fBase fi updTy t1@(Ty_Con _) t2@(Ty_Con s2) + | s2 == hsnInvariant = res fi t2 + -- Invariance propagates through Negate. A bit tricky because this bit of evaluation means unclarity what the return value is + fBase fi updTy t1@(Ty_Con s1) t2@(Ty_App (Ty_Con sf2) ta2) + | s1 == hsnInvariant && sf2 == hsnPolNegation + = fVar' fBase fi id t1 ta2 + +{-# LINE 1765 "src/ehc/Ty/FitsIn.chs" #-} + fBase fi updTy t1 t2 = errClash fi t1 t2 + +{-# LINE 1769 "src/ehc/Ty/FitsIn.chs" #-} + foRes = fVar' fTySyn fi id ty1 ty2 + +{-# LINE 1773 "src/ehc/Ty/FitsIn.chs" #-} +fitsIn' :: String -> FIOpts -> FIEnv -> UID -> VarMp -> Ty -> Ty -> FIOut +fitsIn' msg opts env uniq varmp ty1 ty2 + = fitsIn opts (trPP (msg ++ "-env") env) (trPP (msg ++ "-uniq") uniq) varmp (trPP (msg ++ "-ty1") ty1) (trPP (msg ++ "-ty2") ty2) + +{-# LINE 1783 "src/ehc/Ty/FitsIn.chs" #-} +fitsInL' :: FIOpts -> FIEnv -> UID -> VarMp -> TyL -> TyL -> ([FIOut],FIOut) +fitsInL' opts env uniq varmp tyl1 tyl2 + = fitsInLWith (\fo1 fo2 -> fo2 {foVarMp = foVarMp fo1 |+> foVarMp fo2, foErrL = foErrL fo1 ++ foErrL fo2}) + (mkFitsInWrap' env) opts uniq varmp tyl1 tyl2 + +fitsInL :: FIOpts -> FIEnv -> UID -> VarMp -> TyL -> TyL -> (TyL,FIOut) +fitsInL opts env uniq varmp tyl1 tyl2 + = (map foTy foL,fo) + where (foL,fo) = fitsInL' opts env uniq varmp tyl1 tyl2 + +{-# LINE 1799 "src/ehc/Ty/FitsIn.chs" #-} +fitsInFold :: FIOpts -> FIEnv -> UID -> VarMp -> TyL -> FIOut +fitsInFold opts env uniq varmp tyl + = foldl (\fo t -> if foHasErrs fo then fo else fitsIn opts env uniq varmp (foTy fo) t) + emptyFO tyl + +{-# LINE 1810 "src/ehc/Ty/FitsIn.chs" #-} +fitPredIntoPred + :: ( VarLookupCmb VarMp gm + , VarLookup gm TyVarId VarMpInfo + ) + => FIIn' gm -> Pred -> Pred + -> Maybe (Pred,VarMp) +fitPredIntoPred fi pr1 pr2 + = f pr1 pr2 + where f (Pred_Var pv1) pr2@(Pred_Var pv2) | pv1 == pv2 = Just (pr2,emptyVarMp) + f (Pred_Var pv1) pr2 | isJust mbPr = f (fromJust mbPr) pr2 + where mbPr = varmpPredLookup pv1 (fiVarMp fi) + f pr1 (Pred_Var pv2) | isJust mbPr = f pr1 (fromJust mbPr) + where mbPr = varmpPredLookup pv2 (fiVarMp fi) + f (Pred_Var pv1) pr2@(Pred_Var pv2) = Just (pr2,pv1 `varmpPredUnit` pr2) + f pr1 (Pred_Var pv2) = Nothing + f (Pred_Var pv1) pr2 = Just (pr2,pv1 `varmpPredUnit` pr2) + f (Pred_Lacks r1@(Ty_Var rv1 _) l1) pr2 + | fiAllowTyVarBind fi r1 && isJust mbTy + = f (Pred_Lacks (fromJust mbTy) l1) pr2 + where mbTy = varmpTyLookup rv1 (fiVarMp fi) + f (Pred_Lacks t1 (Label_Var lv1)) pr2 | isJust mbLb + = f (Pred_Lacks t1 (fromJust mbLb)) pr2 + where mbLb = varmpLabelLookup lv1 (fiVarMp fi) + f (Pred_Lacks ty1@(Ty_Var rv1 _) (Label_Var lv1)) + (Pred_Lacks ty2 l2@(Label_Lab lb2)) + | fiAllowTyVarBind fi ty1 + = Just (Pred_Lacks ty2 l2, (rv1 `varmpTyUnit` ty2) `varUpd` (lv1 `varmpLabelUnit` l2)) + f (Pred_Lacks ty1 (Label_Var lv1)) + (Pred_Lacks ty2 l2@(Label_Lab lb2)) + | tyIsEmptyRow ty1 && tyIsEmptyRow ty2 + = Just (Pred_Lacks ty2 l2, lv1 `varmpLabelUnit` l2) + -- assumption: a PredSeq_Var can only occur as a tail in a PredSeq + f (Pred_Preds ps1) (Pred_Preds ps2) + = do (ps, varMp) <- fPreds ps1 ps2 + return (Pred_Preds ps, varMp) + where + fPreds ps@(PredSeq_Var v1) (PredSeq_Var v2) + | v1 == v2 + = Just (ps, emptyVarMp) + fPreds (PredSeq_Var v1) ps + = Just (ps, v1 `varmpPredSeqUnit` ps) + fPreds ps (PredSeq_Var v1) + = Just (ps, v1 `varmpPredSeqUnit` ps) + fPreds (PredSeq_Cons pr1 ps1) (PredSeq_Cons pr2 ps2) + = do (pr', s1) <- f pr1 pr2 + (ps', s2) <- fPreds (s1 `varUpd` ps1) (s1 `varUpd` ps2) + return (PredSeq_Cons pr' ps', s2 |+> s1) + fPreds PredSeq_Nil PredSeq_Nil + = Just (PredSeq_Nil, emptyVarMp) + fPreds _ _ + = Nothing + f pr1 pr2 + = if foHasErrs fo + then {- tr "fitPredIntoPred" + (pr1 >-< pr2 >-< ppErrL (foErrL fo) + >-< "fiVarMp" >#< fiVarMp fi >-< "foVarMp" >#< foVarMp fo + >-< "fioDontBind" >#< show (fioDontBind (fiFIOpts fi)) + >-< "fioBindLVars" >#< show (fioBindLVars (fiFIOpts fi)) >-< "fioBindRVars" >#< show (fioBindRVars (fiFIOpts fi)) + >-< "foTrace" >#< vlist (foTrace fo) + ) $ -} + Nothing + else Just (tyPred $ foTy fo,foVarMp fo) + where fo = fitsIn (predFIOpts + { fioBindRVars = FIOBindNoBut Set.empty + , fioDontBind = fioDontBind (fiFIOpts fi) + , fioBindCategs = fioBindCategs (fiFIOpts fi) + }) + (fiEnv fi) (fiUniq fi) (fiVarMp fi) + (Ty_Pred pr1) (Ty_Pred pr2) + +{-# LINE 1914 "src/ehc/Ty/FitsIn.chs" #-} +fitPredToEvid' :: UID -> VarMp -> Ty -> Either ClGamInfo ClGam -> FIOut +fitPredToEvid' u varmp prTy gg + = case prTy of + Ty_Any -> emptyFO + _ -> fPr u prTy + where fPr u prTy + = case tyUnAnn prTy of -- TBD: necessary? + Ty_Pred p@(Pred_Class _) + -> case gg of + Left clgi -> fClgi u clgi prTy + Right g -> maybe err (\clgi -> fClgi u clgi prTy) $ gamLookup (fst $ predMatchNmArgs p) g + where err = emptyFO {foErrL = [rngLift emptyRange mkErr_NamesNotIntrod "class" [fst $ tyPredMatchNmArgs prTy]]} + where fClgi u clgi prTy + = fo {foTy = appUnArrRes (foTy fo)} + where (u',u1,u2) = mkNewLevUID2 u + fo = fitsIn (predFIOpts {fioBindRVars = FIOBindNoBut $ Set.singleton u2}) emptyFE u1 varmp (clgiPrToEvidTy clgi) ([prTy] `appArr` mkTyVar u2) + Ty_Pred (Pred_Pred t) + -> let (aL,r) = appUnArr t + (_,aLr'@(r':aL')) = foldr (\t (u,ar) -> let (u',u1) = mkNewLevUID u in (u',fPr u1 t : ar)) (u,[]) (r : aL) + in manyFO (aLr' ++ [emptyFO {foTy = map foTy aL' `appArr` foTy r'}]) + +{-# LINE 1937 "src/ehc/Ty/FitsIn.chs" #-} +fitPredToEvid :: UID -> VarMp -> Ty -> ClGam -> FIOut +fitPredToEvid u varmp prTy g = fitPredToEvid' u varmp prTy (Right g) + +{-# LINE 1946 "src/ehc/Ty/FitsIn.chs" #-} +mkFitsInWrap' :: FIEnv -> FitsIn' +mkFitsInWrap' env + = \opt u varmp t1 t2 + -> let fo = fitsIn opt env u varmp t1 t2 + in fo + +mkFitsInWrap :: FIEnv -> FitsIn +mkFitsInWrap env + = \opt u varmp t1 t2 + -> let fo = fitsIn opt env u varmp t1 t2 + in (foTy fo, foVarMp fo, foErrL fo) + +{-# LINE 1964 "src/ehc/Ty/FitsIn.chs" #-} +-- fitsInForToTyCore :: C.KiFitsIn +fitsInForToTyCore uniq t1 t2 + = foLInstToL fo + where fo = fitsIn (strongFIOpts {fioExpandEqTyVar=True}) emptyFE uniq (emptyVarMp :: VarMp) t1 t2 + diff --git a/src/UHC/Light/Compiler/Ty/FitsInCommon.hs b/src/UHC/Light/Compiler/Ty/FitsInCommon.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/FitsInCommon.hs @@ -0,0 +1,187 @@ +module UHC.Light.Compiler.Ty.FitsInCommon +( FIOut (..), emptyFO, foHasErrs +, foErrSq +, FitsIn, FitsIn' +, trfit, trfitIn, trfitOu +, foAppSpineInfo +, foPlusVarMp, foSetVarMp, foBindTyVar +, AppSpineVertebraeInfo (..) +, unknownAppSpineVertebraeInfo +, unknownAppSpineVertebraeInfoL +, AppSpineInfo (asgiVertebraeL), emptyAppSpineInfo, asgiShift1SpinePos, asgiSpine +, fitsInLWith +, AppSpineFOUpdCoe +, asUpdateByPolarity ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Error +import qualified UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Substitutable +import UHC.Util.Pretty +import qualified Data.Set as Set +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Pred.CommonCHR +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Coercion +import UHC.Light.Compiler.Core.Subst + + + + + + + + +{-# LINE 48 "src/ehc/Ty/FitsInCommon.chs" #-} +trfit :: String -> String -> PP_Doc -> PP_Doc +trfit dir msg rest = dir >|< "." >|< msg >|< ":" >#< rest + +trfitIn = trfit ">" +trfitOu = trfit "<" + +{-# LINE 66 "src/ehc/Ty/FitsInCommon.chs" #-} +foErrSq :: FIOut -> ErrSq +foErrSq = Seq.fromList . foErrL + +{-# LINE 79 "src/ehc/Ty/FitsInCommon.chs" #-} +data FIOut + = FIOut + { foVarMp :: !VarMp -- tvar bindings found during fitsIn + , foTy :: !Ty -- the unified type + , foUniq :: !UID -- uniq value seed for fresh tvars + , foMbAppSpineInfo :: !(Maybe AppSpineInfo) -- Ty_App spine info + , foErrL :: !ErrL -- errors + , foTrace :: [PP_Doc] -- trace + , foLInstToL :: [InstTo] -- instantiation over arrow '->' of left ty + , foRInstToL :: [InstTo] -- instantiation over arrow '->' of right ty + , foDontBind :: !TyVarIdS -- output variant of fioDontBind + , foCSubst :: !CSubst -- subst for holes in the Core + , foLRCoe :: !LRCoe -- coercion over arrow structure + , foPredOccL :: ![PredOcc] -- arisen predicates (to be obsolete) + , foGathCnstrMp :: !CHRPredOccCnstrMp -- arisen predicates + , foRowCoeL :: !(AssocL HsName Coe) -- internal, coercions for row fields + } + +{-# LINE 124 "src/ehc/Ty/FitsInCommon.chs" #-} +emptyFO + = FIOut + { foVarMp = emptyVarMp + , foTy = Ty_Any + , foUniq = uidStart + , foMbAppSpineInfo = Nothing + , foErrL = [] + , foTrace = [] + , foLInstToL = [] + , foRInstToL = [] + , foDontBind = Set.empty + , foCSubst = emptyCSubst + , foLRCoe = emptyLRCoe + , foPredOccL = [] + , foGathCnstrMp = emptyCnstrMp + , foRowCoeL = [] + } + +{-# LINE 166 "src/ehc/Ty/FitsInCommon.chs" #-} +foHasErrs :: FIOut -> Bool +foHasErrs = not . null . foErrL + +{-# LINE 171 "src/ehc/Ty/FitsInCommon.chs" #-} +foAppSpineInfo :: FIOut -> AppSpineInfo +foAppSpineInfo fo = maybe emptyAppSpineInfo id $ foMbAppSpineInfo fo + +{-# LINE 180 "src/ehc/Ty/FitsInCommon.chs" #-} +foPlusVarMp :: VarMp -> FIOut -> FIOut +foPlusVarMp c fo = fo {foVarMp = c |+> foVarMp fo} + +foSetVarMp :: VarMp -> FIOut -> FIOut +foSetVarMp c fo = fo {foVarMp = c} + +foBindTyVar :: TyVarId -> Ty -> FIOut -> FIOut +foBindTyVar v t = foPlusVarMp (v `varmpTyUnit` t) + +{-# LINE 195 "src/ehc/Ty/FitsInCommon.chs" #-} +type AppSpineFOUpdCoe = EHCOpts -> [FIOut] -> FIOut + +{-# LINE 199 "src/ehc/Ty/FitsInCommon.chs" #-} +data AppSpineVertebraeInfo + = AppSpineVertebraeInfo + { asPolarity :: Polarity -- the polarity on this spine position + , asFIO :: FIOpts -> FIOpts -- how to update the context (swap ...) + , asFO :: FIOut -> FIOut -> FIOut -- \ffo afo -> afo, update app function arg FIOut with app function FIOut + , asMbFOUpdCoe :: Maybe AppSpineFOUpdCoe -- possibly update coercion + } + +{-# LINE 211 "src/ehc/Ty/FitsInCommon.chs" #-} +instance Show AppSpineVertebraeInfo where + show _ = "AppSpineVertebraeInfo" + +instance PP AppSpineVertebraeInfo where + pp = pp . asPolarity + +{-# LINE 219 "src/ehc/Ty/FitsInCommon.chs" #-} +unknownAppSpineVertebraeInfo :: AppSpineVertebraeInfo +unknownAppSpineVertebraeInfo + = AppSpineVertebraeInfo + polInvariant fioMkUnify + asFODflt + Nothing + +{-# LINE 230 "src/ehc/Ty/FitsInCommon.chs" #-} +asFODflt :: FIOut -> FIOut -> FIOut +asFODflt _ afo = afo + +{-# LINE 235 "src/ehc/Ty/FitsInCommon.chs" #-} +unknownAppSpineVertebraeInfoL :: [AppSpineVertebraeInfo] +unknownAppSpineVertebraeInfoL = repeat unknownAppSpineVertebraeInfo + +{-# LINE 240 "src/ehc/Ty/FitsInCommon.chs" #-} +asUpdateByPolarity :: Polarity -> AppSpineVertebraeInfo -> AppSpineVertebraeInfo +asUpdateByPolarity pol as + = as {asPolarity = pol, asFIO = mkfio} + where mkfio | polIsContravariant pol = fioMkStrong + | polIsCovariant pol = id + | otherwise = fioMkUnify + +{-# LINE 249 "src/ehc/Ty/FitsInCommon.chs" #-} +data AppSpineInfo + = AppSpineInfo + { asgiSpinePos :: Int + , asgiVertebraeL :: [AppSpineVertebraeInfo] + } + +instance Show AppSpineInfo where + show _ = "AppSpineInfo" + +instance PP AppSpineInfo where + pp i = ppBracketsCommas (take 5 $ asgiVertebraeL i) >|< "@" >|< asgiSpinePos i + +emptyAppSpineInfo :: AppSpineInfo +emptyAppSpineInfo = AppSpineInfo 0 unknownAppSpineVertebraeInfoL + +asgiShift1SpinePos :: AppSpineInfo -> AppSpineInfo +asgiShift1SpinePos i = i {asgiSpinePos = asgiSpinePos i + 1} + +asgiSpine :: AppSpineInfo -> [AppSpineVertebraeInfo] +asgiSpine i = drop (asgiSpinePos i) $ asgiVertebraeL i + +{-# LINE 276 "src/ehc/Ty/FitsInCommon.chs" #-} +type FitsIn' = FIOpts -> UID -> VarMp -> Ty -> Ty -> FIOut +type FitsIn = FIOpts -> UID -> VarMp -> Ty -> Ty -> (Ty,VarMp,ErrL) + +{-# LINE 281 "src/ehc/Ty/FitsInCommon.chs" #-} +fitsInLWith :: (FIOut -> FIOut -> FIOut) -> FitsIn' -> FIOpts -> UID -> VarMp -> TyL -> TyL -> ([FIOut],FIOut) +fitsInLWith foCmb elemFits opts uniq varmp tyl1 tyl2 + = (foL,fo) + where ((_,fo),foL) + = foldr (\(t1,t2) ((u,foThr),foL) + -> let (u',ue) = mkNewLevUID u + fo = elemFits opts ue (foVarMp foThr `varUpd` varmp) (foVarMp foThr `varUpd` t1) (foVarMp foThr `varUpd` t2) + in ((u',foCmb fo foThr),fo:foL) + ) + ((uniq,emptyFO),[]) + . zip tyl1 + $ tyl2 + diff --git a/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs b/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs @@ -0,0 +1,129 @@ +module UHC.Light.Compiler.Ty.FitsInCommon2 +( module UHC.Light.Compiler.Ty.FIEnv +, ppTyWithFI, ppTyWithFIFO +, FIIn' (..), FIIn +, emptyFI', emptyFI +, fiLookupVar', fiLookupTyVarCyc +, fiLookupReplaceTyCyc +, fiAllowTyVarBind +, fiInitInstRank, fiRankEqInstRank, fiUpdRankByPolarity +, fiPlusVarMp, fiSetVarMp, fiBindTyVar +, TyBetaRedEnv (..), emptyTyBetaRedEnv, emptyTyBetaRedEnv' +, fiBindImplsVar ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Utils1 +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty.FIEnv +import qualified Data.Set as Set +import UHC.Util.Pretty +import UHC.Light.Compiler.AbstractCore + + + +{-# LINE 36 "src/ehc/Ty/FitsInCommon2.chs" #-} +ppTyWithFI :: (VarLookupCmb VarMp gm, VarUpdatable Ty gm) => FIIn' gm -> Ty -> PP_Doc +ppTyWithFI fi t = ppTyS (fiVarMpLoc fi |+> fiVarMp fi) t + +ppTyWithFIFO :: (VarLookupCmb VarMp gm, VarUpdatable Ty gm) => FIIn' gm -> FIOut -> Ty -> PP_Doc +ppTyWithFIFO fi fo t = ppTyS (foVarMp fo |+> fiVarMp fi) t + +{-# LINE 56 "src/ehc/Ty/FitsInCommon2.chs" #-} +data FIIn' globvm + = FIIn + { fiFIOpts :: !FIOpts -- options to fitsIn + , fiUniq :: !UID -- unique thread + , fiVarMp :: !globvm -- global (type) var bindings + , fiVarMpLoc :: !VarMp -- locally introduced (type) var bindings + , fiExpLTvS :: !(Set.Set TyVarId) -- lhs ty vars for which expansion (via VarMp) is inhibited (already done once) + , fiExpRTvS :: !(Set.Set TyVarId) -- and rhs + , fiRank :: !Int -- rank + , fiMbInstRank :: !(Maybe Int) -- rank where possible deep instantation did start + , fiTrace :: [PP_Doc] -- ???? 20080110, must be strict otherwise ghc 6.8.1 generates crashing program ???? + , fiCoeCtx :: CoeCtx -- the coercion context + , fiEnv :: !FIEnv -- environment (Gam's,...) + } + +type FIIn = FIIn' VarMp + +{-# LINE 77 "src/ehc/Ty/FitsInCommon2.chs" #-} +emptyFI' :: gm -> FIIn' gm +emptyFI' m + = FIIn + { fiFIOpts = strongFIOpts + , fiUniq = uidStart + , fiVarMp = m + , fiVarMpLoc = emptyVarMp + , fiExpLTvS = Set.empty + , fiExpRTvS = Set.empty + , fiRank = 1 + , fiMbInstRank = Nothing + , fiTrace = [] + , fiCoeCtx = CoeCtx_Allow + , fiEnv = emptyFE + } + +-- emptyFI :: forall gm . FIIn' gm +emptyFI = emptyFI' emptyVarMp + +{-# LINE 100 "src/ehc/Ty/FitsInCommon2.chs" #-} +-- lookup a tvar subsequently in 2 VarMps +fiLookupVar' :: (v -> m1 -> Maybe x) -> (v -> m2 -> Maybe x) -> v -> m1 -> m2 -> Maybe x +fiLookupVar' lkup1 lkup2 v m1 m2 + = case lkup1 v m1 of + Nothing -> lkup2 v m2 + j -> j + +-- lookup a tvar in the VarMps of a FIIn +fiLookupTyVarCyc :: VarLookup gm TyVarId VarMpInfo => FIIn' gm -> TyVarId -> Maybe Ty +fiLookupTyVarCyc fi v = fiLookupVar' varmpTyLookupCyc varmpTyLookupCyc v (fiVarMpLoc fi) (fiVarMp fi) + +{-# LINE 117 "src/ehc/Ty/FitsInCommon2.chs" #-} +-- lookup a possible tvar in the VarMps of a FIIn, the result being the replacement if any +fiLookupReplaceTyCyc :: VarLookup gm TyVarId VarMpInfo => FIIn' gm -> Ty -> Ty +fiLookupReplaceTyCyc fi t = maybe t (maybe t id . fiLookupTyVarCyc fi) $ tyMbVar t + +{-# LINE 131 "src/ehc/Ty/FitsInCommon2.chs" #-} +data TyBetaRedEnv gm + = TyBetaRedEnv + { tbredFI :: FIIn' gm + } + +emptyTyBetaRedEnv' fe = TyBetaRedEnv ((emptyFI {fiEnv = fe}) :: FIIn) +emptyTyBetaRedEnv = TyBetaRedEnv emptyFI + +{-# LINE 145 "src/ehc/Ty/FitsInCommon2.chs" #-} +-- Pre: is a tyvar +fiAllowTyVarBind :: FIIn' gm -> Ty -> Bool +fiAllowTyVarBind fi (Ty_Var v f) = f `elem` fioBindCategs (fiFIOpts fi) -- f == TyVarCateg_Plain + && not (v `Set.member` fioDontBind (fiFIOpts fi)) +fiAllowTyVarBind fi _ = False + +{-# LINE 159 "src/ehc/Ty/FitsInCommon2.chs" #-} +fiInitInstRank :: FIIn' gm -> FIIn' gm +fiInitInstRank fi = maybe (fi {fiMbInstRank = Just (fiRank fi)}) (const fi) (fiMbInstRank fi) + +fiRankEqInstRank :: FIIn' gm -> Bool +fiRankEqInstRank fi = maybe True (== fiRank fi) (fiMbInstRank fi) + +fiUpdRankByPolarity :: Polarity -> FIIn' gm -> FIIn' gm +fiUpdRankByPolarity pol fi = if polIsContravariant pol then fi {fiRank = fiRank fi + 1} else fi + +{-# LINE 174 "src/ehc/Ty/FitsInCommon2.chs" #-} +fiPlusVarMp :: VarMp -> FIIn' gm -> FIIn' gm +fiPlusVarMp c fi = fi {fiVarMpLoc = c |+> fiVarMpLoc fi} + +fiSetVarMp :: VarMp -> FIIn' gm -> FIIn' gm +fiSetVarMp c fi = fi {fiVarMpLoc = c} + +fiBindTyVar :: TyVarId -> Ty -> FIIn' gm -> FIIn' gm +fiBindTyVar v t = fiPlusVarMp (v `varmpTyUnit` t) + +{-# LINE 185 "src/ehc/Ty/FitsInCommon2.chs" #-} +fiBindImplsVar :: ImplsVarId -> Impls -> FIIn' gm -> FIIn' gm +fiBindImplsVar v i = fiPlusVarMp (v `varmpImplsUnit` i) + diff --git a/src/UHC/Light/Compiler/Ty/Ftv.hs b/src/UHC/Light/Compiler/Ty/Ftv.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Ftv.hs @@ -0,0 +1,618 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Ftv.ag) +module UHC.Light.Compiler.Ty.Ftv(tyFtv +, tyFtvMp +, implsFtvMp) where + +import Data.List +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import qualified Data.Map as Map + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + +tyFtv :: Ty -> Set.Set TyVarId +tyFtv = Map.keysSet . Map.filter (\i -> tvpurposeIsTy (tvinfoPurpose i)) . tyFtvMp + + + +tyFtvMp :: Ty -> TvCatMp +tyFtvMp ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf) + in tvMp_Syn_TyAGItf t + + + +implsFtvMp :: Impls -> TvCatMp +implsFtvMp i = tyFtvMp (Ty_Impls i) + +-- Impls ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + tvMp : TvCatMp + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + alternative Nil: +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = ( TvCatMp) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (case (iv_ `Map.singleton` mkTvInfoPlain TvPurpose_Impls) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (case (tl_) of + { ( _tlItvMp) -> + (case (pr_) of + { ( _prItvMp) -> + (case (_prItvMp `Map.union` _tlItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (case (Map.empty) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +-- Label ------------------------------------------------------- +{- + alternatives: + alternative Lab: + child nm : {HsName} + alternative Var: + child lv : {LabelVarId} +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( ) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + ( ) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + ( ) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + tvMp : TvCatMp + alternatives: + alternative Class: + child ty : Ty + alternative Pred: + child ty : Ty + alternative Lacks: + child ty : Ty + child lab : Label + alternative Arrow: + child args : PredSeq + child res : Pred + alternative Eq: + child tyL : Ty + child tyR : Ty + alternative Var: + child pv : {TyVarId} + alternative Preds: + child seq : PredSeq +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = ( TvCatMp) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (case (res_) of + { ( _resItvMp) -> + (case (args_) of + { ( _argsItvMp) -> + (case (_argsItvMp `Map.union` _resItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (case (tyR_) of + { ( _tyRItvMp) -> + (case (tyL_) of + { ( _tyLItvMp) -> + (case (_tyLItvMp `Map.union` _tyRItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (case (pv_ `Map.singleton` mkTvInfoPlain TvPurpose_Pred) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (case (seq_) of + { ( _seqItvMp) -> + (case (_seqItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + tvMp : TvCatMp + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + alternative Nil: + alternative Var: + child av : {TyVarId} +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = ( TvCatMp) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (case (tl_) of + { ( _tlItvMp) -> + (case (hd_) of + { ( _hdItvMp) -> + (case (_hdItvMp `Map.union` _tlItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (case (Map.empty) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (case (av_ `Map.singleton` mkTvInfoTy TyVarCateg_Plain) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +-- Ty ---------------------------------------------------------- +{- + visit 0: + synthesized attribute: + tvMp : TvCatMp + alternatives: + alternative Con: + child nm : {HsName} + alternative App: + child func : Ty + child arg : Ty + alternative Ann: + child ann : TyAnn + child ty : Ty + alternative Dbg: + child info : {String} + alternative Any: + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + alternative Pred: + child pr : Pred + alternative Lam: + child tv : {TyVarId} + child ty : Ty + alternative Impls: + child impls : Impls +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = ( TvCatMp) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (case (Map.empty) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (case (arg_) of + { ( _argItvMp) -> + (case (func_) of + { ( _funcItvMp) -> + (case (_funcItvMp `Map.union` _argItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (case (Map.empty) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (case (Map.empty) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (case (categ_) of + { ( _categIself) -> + (case (tv_ `Map.singleton` mkTvInfoTy _categIself) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (tv_ `Map.delete` _tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (case (extTy_) of + { ( _extTyItvMp) -> + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp `Map.union` _extTyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) }) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (case (pr_) of + { ( _prItvMp) -> + (case (_prItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (tv_ `Map.delete` _tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (case (impls_) of + { ( _implsItvMp) -> + (case (_implsItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + synthesized attribute: + tvMp : TvCatMp + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = ( TvCatMp) +data Inh_TyAGItf = Inh_TyAGItf {} +data Syn_TyAGItf = Syn_TyAGItf {tvMp_Syn_TyAGItf :: !(TvCatMp)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf) = + (let ( _lhsOtvMp) = sem + in (Syn_TyAGItf _lhsOtvMp)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (case (ty_) of + { ( _tyItvMp) -> + (case (_tyItvMp) of + { _lhsOtvMp -> + ( _lhsOtvMp) }) }) +-- TyAnn ------------------------------------------------------- +{- + alternatives: + alternative Empty: + alternative Strictness: + child s : {Strictness} + alternative Mono: +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( ) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + ( ) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + ( ) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + ( ) +-- TyQu -------------------------------------------------------- +{- + alternatives: + alternative Forall: + child mlev : {MetaLev} + alternative Exists: + child mlev : {MetaLev} + alternative Plain: + child mlev : {MetaLev} +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( ) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + ( ) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + ( ) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + ( ) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local self : _ + alternative Fixed: + visit 0: + local self : _ + alternative Meta: + visit 0: + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (case (TyVarCateg_Plain) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (case (TyVarCateg_Fixed) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (case (TyVarCateg_Meta) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) diff --git a/src/UHC/Light/Compiler/Ty/Parser.hs b/src/UHC/Light/Compiler/Ty/Parser.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Parser.hs @@ -0,0 +1,75 @@ +module UHC.Light.Compiler.Ty.Parser +( pTy', pTy ) +where +import UU.Parsing +import UHC.Util.ParseUtils +import UHC.Light.Compiler.Base.Parser +import UHC.Util.ScanUtils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Scanner.Common +import UHC.Light.Compiler.Scanner.Scanner +import UHC.Light.Compiler.Ty + +{-# LINE 21 "src/ehc/Ty/Parser.chs" #-} +-- type P p = PlainParser Token p + +{-# LINE 25 "src/ehc/Ty/Parser.chs" #-} +pTy :: P Ty +pTy = pTy' pDollNm + +pTy' :: P HsName -> P Ty +pTy' pNm = pT + where +{- + pPred :: P Pred + pPred + = pOIMPL + *> (pT + <**> ( (flip Pred_Lacks) <$ pLAM <*> (Label_Lab <$> pNm <|> Label_Var <$> pUIDHI) + <|> pSucceed Pred_Class + ) ) + <* pCIMPL +-} + + pTyBase :: P Ty + pTyBase + = appCon <$> pNm + <|> pParens pT + <|> pBracks pT + <|> pRow + <|> mkTyVar <$> pUID +{- + <|> Ty_Any <$ pQUESTQUEST + <|> mkTyPr <$> pPred +-} + where pRow :: P Ty + pRow + = pOROWROW + *> ( foldl (\r (l,e) -> Ty_Ext r l e) + <$> pRow <* pVBAR + <*> pList1Sep pCOMMA ((,) <$> (pNm <|> mkHNmPos <$> pInt) <* pDCOLON <*> pT) + <|> pSucceed (appCon hsnRowEmpty) + ) + <* pCROWROW + + pTyApp :: P Ty + pTyApp + = appTopApp <$> pList1 pTyBase + + pT :: P Ty + pT + = pTyApp <**> + ( flip app1Arr <$ pRARROW <*> pT + <|> pSucceed id + ) +{- + <|> Ty_TBind + <$> ((TyQu_Forall <$ pFORALL <|> TyQu_Exists <$ pEXISTS) <*> pMaybe 0 id (pSTAR *> pMaybe 1 id pInt)) + <*> pUIDHI + <*> pMaybe kiStar id (pParens pT) + <* pDOT + <*> pT + <|> Ty_Lam <$ pLAM <*> pUIDHI <* pRARROW <*> pT +-} diff --git a/src/UHC/Light/Compiler/Ty/Pretty.hs b/src/UHC/Light/Compiler/Ty/Pretty.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Pretty.hs @@ -0,0 +1,2670 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Pretty.ag) +module UHC.Light.Compiler.Ty.Pretty(ppTyWithCfg', ppTyWithCfg, ppTy +, CfgPPTy +, ppTyPr +, ppImplsWithCfg +, ppPredOccId' +, ppTyDt +, cfgPPTyDT) where + +import UHC.Util.Utils +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.Char +import UHC.Light.Compiler.Base.CfgPP + + + +data TyQuCtxt = TyQuCtxtArrow | TyQuCtxtProd | TyQuCtxtOnTop | TyQuCtxtOther deriving (Show,Eq) + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + + + + + +ppTyWithCfg' :: CfgPP x => x -> Ty -> PP_Doc +ppTyWithCfg' x ty = pp_Syn_TyAGItf $ synTyWithCfg (cfgPPTy x) ty + +synTyWithCfg :: CfgPPTy -> Ty -> Syn_TyAGItf +synTyWithCfg c ty + = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf {cfg_Inh_TyAGItf = c}) + +ppTyWithCfg :: CfgPPTy -> Ty -> PP_Doc +ppTyWithCfg c ty = pp_Syn_TyAGItf $ synTyWithCfg c ty + +ppTy :: Ty -> PP_Doc +ppTy = ppTyWithCfg cfgPPTyDflt + + + +ppImplsWithCfg :: CfgPPTy -> Impls -> PP_Doc +ppImplsWithCfg c i = ppTyWithCfg c (Ty_Impls i) + + + +ppTyDt :: Ty -> PP_Doc +ppTyDt = ppTyWithCfg cfgPPTyDT + + + +instance PP Ty where + pp t = ppTy t + + + +ppTyPr :: Ty -> PP_Doc +ppTyPr = ppTyWithCfg cfgPPTyPred + + + + +instance PP FIMode where + pp m = pp (show m) + + + +instance PP InstTo where + pp InstTo_Plain = pp "_" + pp (InstTo_Qu q v t k) = t >|< "/" >|< v >|< "@" >|< tyquMetaLev q + + + +ppPredOccId' :: CfgPP x => x -> PredOccId -> PP_Doc +ppPredOccId' x poi + = ppi (poiId poi) + where ppi = cfgppUID x + + + +ppPredOccId :: PredOccId -> PP_Doc +ppPredOccId poi = "Poi" >|< ppPredOccId' CfgPP_Plain poi + + + +instance PP TyKiKey where + pp = pp . show + + + +instance PP Pred where + pp p = ppTyWithCfg cfgPPTyPred (Ty_Pred p) + +instance PP Impls where + pp i = ppTy (Ty_Impls i) + +instance PP PredOccId where + pp = ppPredOccId + +instance PP PredOcc where + pp po = pp (poPr po) >|< "/" >|< pp (poPoi po) >|< "/" >|< pp (poScope po) + +instance PP CHRPredOccCxt where + pp (CHRPredOccCxt_Scope1 sc) = pp sc + +instance PP CHRPredOcc where + pp po = ppParensCommas + [ pp (cpoPr po), pp (cpoCxt po) + , pp (cpoRange po) + ] + +instance PP PredScope where + pp (PredScope_Lev l) = ppListSep "<" ">" "," $ rllToList l + pp (PredScope_Var v) = "|< v >|< ">" + +instance PP ImplsProveOcc where + pp o = ipoId o >|< "/" >|< ipoScope o + + + +instance PP PredSeq where + pp (PredSeq_Cons hd tl) = pp hd >#< ":" >#< pp tl + pp (PredSeq_Nil ) = pp "[]" + pp (PredSeq_Var u ) = pp u + + + +instance PP LabelOffset where + pp = pp . show + + + +instance PP Label where + pp l = pp_Syn_LabelAGItf t + where t = wrap_LabelAGItf + (sem_LabelAGItf (LabelAGItf_AGItf l)) + (Inh_LabelAGItf) + + + +data CfgPPTy + = CfgPPTy + { cfgPPTyPPHsn :: HsName -> PP_Doc + , cfgPPTyPPCon :: CfgPPTy -> HsName -> PP_Doc + , cfgPPTyPPVar :: CfgPPTy -> UID -> Int -> PP_Doc + , cfgPPTyPPVarDflt :: CfgPPTy -> String -> UID -> Maybe PP_Doc -> PP_Doc + , cfgPPTyPPImplsPred :: PP_Doc -> PP_Doc -> PP_Doc -> PP_Doc + , cfgPPTyPPImplsTailCons :: PP_Doc -> PP_Doc -> PP_Doc + , cfgPPTyPPImplsAppWrap :: (PP_Doc -> PP_Doc) -> PP_Doc -> PP_Doc + , cfgPPTyCtxt :: TyCtxt + , cfgPPTyFollowAST :: Bool + , cfgPPTyLhsSafe :: String -> String + , cfgPPTyElimEmptyImpls :: Bool + } + + + +cfgPPTy' :: CfgPP x => x -> CfgPPTy -> CfgPPTy +cfgPPTy' x c + = c { cfgPPTyPPHsn = cfgppHsName x + , cfgPPTyPPVar = \c u i -> cfgppVarHsName x Nothing (Just u) (Just i) Nothing + , cfgPPTyPPCon = \c n -> cfgppConHsName x n + , cfgPPTyFollowAST = cfgppFollowAST x + , cfgPPTyPPVarDflt = \c pre tv mbpp -> cfgppTyPPVarDflt x pre tv mbpp + } + +cfgPPTy :: CfgPP x => x -> CfgPPTy +cfgPPTy x = cfgPPTy' x cfgPPTyDflt + + + +cfgPPTyDflt :: CfgPPTy +cfgPPTyDflt + = CfgPPTy + { cfgPPTyPPHsn = pp + , cfgPPTyPPCon = \_ -> ppCon + , cfgPPTyPPVar = \c _ i -> ppTnUniq c i + , cfgPPTyPPVarDflt = \cfg pre tv mbpp -> cfgPPTyPPHsn cfg $ mkHNm $ show tv + , cfgPPTyPPImplsPred = \iv pr pv -> iv >|< "=" >|< pr >|< "/" >|< pv + , cfgPPTyPPImplsTailCons = \pr occs -> pr >|< occs + , cfgPPTyPPImplsAppWrap = ($) + , cfgPPTyCtxt = TyCtxt_Ty + , cfgPPTyFollowAST = False + , cfgPPTyLhsSafe = id + , cfgPPTyElimEmptyImpls = False + } + + + + +cfgPPTyDT :: CfgPPTy +cfgPPTyDT + = cfgPPTyDflt + { cfgPPTyPPHsn = pp . hsnQualified + , cfgPPTyPPCon = \_ -> ppCon . hsnQualified + , cfgPPTyPPImplsPred = \_ pr _ -> pr + , cfgPPTyPPImplsTailCons = \pr _ -> pr + , cfgPPTyPPImplsAppWrap = \_ pr -> pr + , cfgPPTyElimEmptyImpls = True + , cfgPPTyLhsSafe = let safe '|' = "||" + safe '@' = "@@" + safe x = [x] + in concatMap safe + } + + + +cfgPPTyPred :: CfgPPTy +cfgPPTyPred + = cfgPPTyDflt + { cfgPPTyCtxt = TyCtxt_Pred + } + + + +cfgPPTyExtraForHI :: CfgPPTy -> CfgPPTy +cfgPPTyExtraForHI c + = c { cfgPPTyPPVarDflt = \cfg pre tv mbpp -> maybe (cfgPPTyPPVar cfg cfg tv 0) id mbpp + } + + + +cfgppAside :: (PP a, PP b) => CfgPPTy -> a -> b -> PP_Doc +cfgppAside c a b = if cfgPPTyFollowAST c then a >-< b else a >#< b + + + +ppExts :: CfgPPTy -> HsName -> PP_Doc -> [PP_Doc] -> (PP_Doc,PP_Doc) +ppExts cfg appFunNm appFunPP appArgPPL + = (ppNice,ppCfg) + where ppNice = ppAppTop (hsnRow,mkPPAppFun' sep appFunNm appFunPP) + appArgPPL empty + ppCfg = if cfgPPTyFollowAST cfg + then let (e:es) = appArgPPL + in hv ([hsnORow >#< appFunPP,sep >#< e] ++ map ("," >#<) es ++ [pp hsnCRow]) + else ppNice + sep = cfgPPTyLhsSafe cfg "|" + + + +type TVarNameMap + = Map.Map TyVarId + PP_Doc + + + +tnLookupPP :: TyVarId -> TVarNameMap -> Maybe PP_Doc +tnLookupPP = Map.lookup + + + +tnMapInsert = Map.insert + + + +tnUniqRepr :: Int -> String +tnUniqRepr + = lrepr + where lrepr i = if i <= 26 + then [repr i] + else let (d,r) = i `divMod` 26 + in (repr d : lrepr r) + repr = (chr . (97+)) + + + +ppTnUniq :: CfgPPTy -> Int -> PP_Doc +ppTnUniq c = cfgPPTyPPHsn c . mkHNm . tnUniqRepr + + + +mkDefaultTvNmPP :: CfgPPTy -> String -> TyVarId -> PP_Doc +mkDefaultTvNmPP cfg pre tv = cfgPPTyPPHsn cfg $ mkHNm $ pre ++ "_" ++ show tv + + + +tvCategPrefix :: TyVarCateg -> String +tvCategPrefix TyVarCateg_Fixed = "c" +tvCategPrefix TyVarCateg_Plain = "v" +tvCategPrefix TyVarCateg_Meta = "m" + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + cfg : CfgPPTy + isAtTop : Bool + isRow : Bool + tyCtxt : TyQuCtxt + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + isEmptyImpls : Bool + pp : PP_Doc + self : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local ppIv : _ + local self : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local ppPv : _ + local ppIv : _ + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = CfgPPTy -> + Bool -> + Bool -> + TVarNameMap -> + Int -> + TyQuCtxt -> + ( Bool,PP_Doc,Impls,TVarNameMap,Int) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (cfgPPTyPPImplsTailCons _lhsIcfg + (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "i" iv_ (tnLookupPP iv_ _lhsItnMap)) + (ppBracketsCommas proveOccs_)) of + { _ppIv -> + (case (_ppIv) of + { _lhsOpp -> + (case (Impls_Tail iv_ proveOccs_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOisEmptyImpls,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (_lhsItnUniq) of + { _prOtnUniq -> + (case (_lhsItyCtxt) of + { _prOtyCtxt -> + (case (_lhsItnMap) of + { _prOtnMap -> + (case (_lhsIisRow) of + { _prOisRow -> + (case (_lhsIisAtTop) of + { _prOisAtTop -> + (case (_lhsIcfg) of + { _prOcfg -> + (case (pr_ _prOcfg _prOisAtTop _prOisRow _prOtnMap _prOtnUniq _prOtyCtxt) of + { ( _prIpp,_prIself,_prItnMap,_prItnUniq) -> + (case (_prItnUniq) of + { _tlOtnUniq -> + (case (_prItnMap) of + { _tlOtnMap -> + (case (_lhsIcfg) of + { _tlOcfg -> + (case (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "p" (poiId pv_) (tnLookupPP iv_ _lhsItnMap)) of + { _ppPv -> + (case (cfgPPTyPPImplsTailCons _lhsIcfg + (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "i" iv_ (tnLookupPP iv_ _lhsItnMap)) + (ppBracketsCommas proveOccs_)) of + { _ppIv -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (tl_ _tlOcfg _tlOisAtTop _tlOisRow _tlOtnMap _tlOtnUniq _tlOtyCtxt) of + { ( _tlIisEmptyImpls,_tlIpp,_tlIself,_tlItnMap,_tlItnUniq) -> + (case (cfgPPTyPPImplsPred _lhsIcfg _ppIv _prIpp _ppPv >|< "," >|< _tlIpp) of + { _lhsOpp -> + (case (Impls_Cons iv_ _prIself pv_ prange_ proveOccs_ _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tlItnMap) of + { _lhsOtnMap -> + (case (_tlItnUniq) of + { _lhsOtnUniq -> + ( _lhsOisEmptyImpls,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (cfgPPTyElimEmptyImpls _lhsIcfg) of + { _lhsOisEmptyImpls -> + (case (pp "_") of + { _lhsOpp -> + (case (Impls_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOisEmptyImpls,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + inherited attribute: + cfg : CfgPPTy + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + self : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local self : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local self : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = CfgPPTy -> + TVarNameMap -> + Int -> + ( PP_Doc,Label,TVarNameMap,Int) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (cfgPPTyPPHsn _lhsIcfg nm_) of + { _lhsOpp -> + (case (Label_Lab nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "l" lv_ (tnLookupPP lv_ _lhsItnMap)) of + { _lhsOpp -> + (case (Label_Var lv_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +-- LabelAGItf -------------------------------------------------- +{- + visit 0: + synthesized attribute: + pp : PP_Doc + alternatives: + alternative AGItf: + child lab : Label + visit 0: + local tnMap : _ + local cfg : _ + local tnUniq : _ +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( PP_Doc) +data Inh_LabelAGItf = Inh_LabelAGItf {} +data Syn_LabelAGItf = Syn_LabelAGItf {pp_Syn_LabelAGItf :: !(PP_Doc)} +wrap_LabelAGItf :: T_LabelAGItf -> + Inh_LabelAGItf -> + Syn_LabelAGItf +wrap_LabelAGItf sem (Inh_LabelAGItf) = + (let ( _lhsOpp) = sem + in (Syn_LabelAGItf _lhsOpp)) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + (case (Map.empty) of + { _tnMap -> + (case (_tnMap) of + { _labOtnMap -> + (case (cfgPPTyDflt) of + { _cfg -> + (case (_cfg) of + { _labOcfg -> + (case (0) of + { _tnUniq -> + (case (_tnUniq) of + { _labOtnUniq -> + (case (lab_ _labOcfg _labOtnMap _labOtnUniq) of + { ( _labIpp,_labIself,_labItnMap,_labItnUniq) -> + (case (_labIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + cfg : CfgPPTy + isAtTop : Bool + isRow : Bool + tyCtxt : TyQuCtxt + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + self : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local positionalFldNmL : _ + local parNeedL : _ + local parNeed : _ + local cfg : _ + local appSpinePos : _ + local self : _ + alternative Pred: + child ty : Ty + visit 0: + local positionalFldNmL : _ + local parNeedL : _ + local parNeed : _ + local cfg : _ + local appSpinePos : _ + local self : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local cfg : _ + local positionalFldNmL : _ + local parNeedL : _ + local parNeed : _ + local appSpinePos : _ + local self : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local cfg : _ + local appSpinePos : _ + local self : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local positionalFldNmL : _ + local parNeedL : _ + local parNeed : _ + local cfg : _ + local appSpinePos : _ + local self : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local self : _ + alternative Preds: + child seq : PredSeq + visit 0: + local cfg : _ + local appSpinePos : _ + local self : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = CfgPPTy -> + Bool -> + Bool -> + TVarNameMap -> + Int -> + TyQuCtxt -> + ( PP_Doc,Pred,TVarNameMap,Int) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _tyOtnUniq -> + (case (_lhsItnMap) of + { _tyOtnMap -> + (case (positionalFldNames) of + { _positionalFldNmL -> + (case (_positionalFldNmL) of + { _tyOpositionalFldNmL -> + (case ([]) of + { _parNeedL -> + (case (_parNeedL) of + { _tyOparNeedL -> + (case (ParNotNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyOparNeed -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Ty }) of + { _cfg -> + (case (_cfg) of + { _tyOcfg -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyIpp) of + { _lhsOpp -> + (case (Pred_Class _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tyItnMap) of + { _lhsOtnMap -> + (case (_tyItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _tyOtnUniq -> + (case (_lhsItnMap) of + { _tyOtnMap -> + (case (positionalFldNames) of + { _positionalFldNmL -> + (case (_positionalFldNmL) of + { _tyOpositionalFldNmL -> + (case ([]) of + { _parNeedL -> + (case (_parNeedL) of + { _tyOparNeedL -> + (case (ParNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyOparNeed -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Pred }) of + { _cfg -> + (case (_cfg) of + { _tyOcfg -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyIpp) of + { _lhsOpp -> + (case (Pred_Pred _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tyItnMap) of + { _lhsOtnMap -> + (case (_tyItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _tyOtnUniq -> + (case (_lhsItnMap) of + { _tyOtnMap -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Ty }) of + { _cfg -> + (case (_cfg) of + { _tyOcfg -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (positionalFldNames) of + { _positionalFldNmL -> + (case (_positionalFldNmL) of + { _tyOpositionalFldNmL -> + (case ([]) of + { _parNeedL -> + (case (_parNeedL) of + { _tyOparNeedL -> + (case (ParNotNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyOparNeed -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyItnMap) of + { _labOtnMap -> + (case (_cfg) of + { _labOcfg -> + (case (_tyItnUniq) of + { _labOtnUniq -> + (case (lab_ _labOcfg _labOtnMap _labOtnUniq) of + { ( _labIpp,_labIself,_labItnMap,_labItnUniq) -> + (case (_tyIpp >|< "\\" >|< _labIpp) of + { _lhsOpp -> + (case (Pred_Lacks _tyIself _labIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_labItnMap) of + { _lhsOtnMap -> + (case (_labItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _argsOtnUniq -> + (case (_lhsItyCtxt) of + { _argsOtyCtxt -> + (case (_lhsItnMap) of + { _argsOtnMap -> + (case (_lhsIisRow) of + { _argsOisRow -> + (case (_lhsIisAtTop) of + { _argsOisAtTop -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Ty }) of + { _cfg -> + (case (_cfg) of + { _argsOcfg -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _argsOappSpinePos -> + (case (args_ _argsOappSpinePos _argsOcfg _argsOisAtTop _argsOisRow _argsOtnMap _argsOtnUniq _argsOtyCtxt) of + { ( _argsIpp,_argsIppL,_argsIself,_argsItnMap,_argsItnUniq) -> + (case (_argsItnUniq) of + { _resOtnUniq -> + (case (_argsItnMap) of + { _resOtnMap -> + (case (_cfg) of + { _resOcfg -> + (case (_lhsItyCtxt) of + { _resOtyCtxt -> + (case (_lhsIisRow) of + { _resOisRow -> + (case (_lhsIisAtTop) of + { _resOisAtTop -> + (case (res_ _resOcfg _resOisAtTop _resOisRow _resOtnMap _resOtnUniq _resOtyCtxt) of + { ( _resIpp,_resIself,_resItnMap,_resItnUniq) -> + (case (ppParensCommas _argsIppL >#< "=>" >#< _resIpp) of + { _lhsOpp -> + (case (Pred_Arrow _argsIself _resIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_resItnMap) of + { _lhsOtnMap -> + (case (_resItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _tyLOtnUniq -> + (case (tyL_) of + { ( _tyLIappFunNm,tyL_1) -> + (case (_lhsItyCtxt) of + { _tyLOtyCtxt -> + (case (_lhsItnMap) of + { _tyLOtnMap -> + (case (positionalFldNames) of + { _positionalFldNmL -> + (case (_positionalFldNmL) of + { _tyLOpositionalFldNmL -> + (case ([]) of + { _parNeedL -> + (case (_parNeedL) of + { _tyLOparNeedL -> + (case (ParNotNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyLOparNeed -> + (case (_lhsIisRow) of + { _tyLOisRow -> + (case (_lhsIisAtTop) of + { _tyLOisAtTop -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Ty }) of + { _cfg -> + (case (_cfg) of + { _tyLOcfg -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyLOappSpinePos -> + (case (tyL_1 _tyLOappSpinePos _tyLOcfg _tyLOisAtTop _tyLOisRow _tyLOparNeed _tyLOparNeedL _tyLOpositionalFldNmL _tyLOtnMap _tyLOtnUniq _tyLOtyCtxt) of + { ( _tyLIappArgIsEmptyImplsL,_tyLIappArgPPL,_tyLIappFunPP,_tyLIisArrow,_tyLIisEmptyImpls,_tyLIisPred,_tyLIpositionalFldNmL,_tyLIpp,_tyLIself,_tyLItnMap,_tyLItnUniq) -> + (case (_tyLItnUniq) of + { _tyROtnUniq -> + (case (_tyLItnMap) of + { _tyROtnMap -> + (case (_positionalFldNmL) of + { _tyROpositionalFldNmL -> + (case (_parNeedL) of + { _tyROparNeedL -> + (case (_parNeed) of + { _tyROparNeed -> + (case (_cfg) of + { _tyROcfg -> + (case (_appSpinePos) of + { _tyROappSpinePos -> + (case (tyR_) of + { ( _tyRIappFunNm,tyR_1) -> + (case (_lhsItyCtxt) of + { _tyROtyCtxt -> + (case (_lhsIisRow) of + { _tyROisRow -> + (case (_lhsIisAtTop) of + { _tyROisAtTop -> + (case (tyR_1 _tyROappSpinePos _tyROcfg _tyROisAtTop _tyROisRow _tyROparNeed _tyROparNeedL _tyROpositionalFldNmL _tyROtnMap _tyROtnUniq _tyROtyCtxt) of + { ( _tyRIappArgIsEmptyImplsL,_tyRIappArgPPL,_tyRIappFunPP,_tyRIisArrow,_tyRIisEmptyImpls,_tyRIisPred,_tyRIpositionalFldNmL,_tyRIpp,_tyRIself,_tyRItnMap,_tyRItnUniq) -> + (case (_tyLIpp >#< hsnEqTilde >#< _tyRIpp) of + { _lhsOpp -> + (case (Pred_Eq _tyLIself _tyRIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tyRItnMap) of + { _lhsOtnMap -> + (case (_tyRItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "p" pv_ (tnLookupPP pv_ _lhsItnMap)) of + { _lhsOpp -> + (case (Pred_Var pv_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _seqOtnUniq -> + (case (_lhsItnMap) of + { _seqOtnMap -> + (case (_lhsIcfg { cfgPPTyCtxt = TyCtxt_Ty }) of + { _cfg -> + (case (_cfg) of + { _seqOcfg -> + (case (_lhsItyCtxt) of + { _seqOtyCtxt -> + (case (_lhsIisRow) of + { _seqOisRow -> + (case (_lhsIisAtTop) of + { _seqOisAtTop -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _seqOappSpinePos -> + (case (seq_ _seqOappSpinePos _seqOcfg _seqOisAtTop _seqOisRow _seqOtnMap _seqOtnUniq _seqOtyCtxt) of + { ( _seqIpp,_seqIppL,_seqIself,_seqItnMap,_seqItnUniq) -> + (case (ppParensCommas _seqIppL) of + { _lhsOpp -> + (case (Pred_Preds _seqIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_seqItnMap) of + { _lhsOtnMap -> + (case (_seqItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + cfg : CfgPPTy + isAtTop : Bool + isRow : Bool + tyCtxt : TyQuCtxt + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + ppL : [PP_Doc] + self : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ + alternative Var: + child av : {TyVarId} + visit 0: + local self : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Int -> + CfgPPTy -> + Bool -> + Bool -> + TVarNameMap -> + Int -> + TyQuCtxt -> + ( PP_Doc,([PP_Doc]),PredSeq,TVarNameMap,Int) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsItnUniq) of + { _hdOtnUniq -> + (case (_lhsItyCtxt) of + { _hdOtyCtxt -> + (case (_lhsItnMap) of + { _hdOtnMap -> + (case (_lhsIisRow) of + { _hdOisRow -> + (case (_lhsIisAtTop) of + { _hdOisAtTop -> + (case (_lhsIcfg) of + { _hdOcfg -> + (case (hd_ _hdOcfg _hdOisAtTop _hdOisRow _hdOtnMap _hdOtnUniq _hdOtyCtxt) of + { ( _hdIpp,_hdIself,_hdItnMap,_hdItnUniq) -> + (case (_hdItnUniq) of + { _tlOtnUniq -> + (case (_hdItnMap) of + { _tlOtnMap -> + (case (_lhsIcfg) of + { _tlOcfg -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (_lhsIappSpinePos + 1) of + { _tlOappSpinePos -> + (case (tl_ _tlOappSpinePos _tlOcfg _tlOisAtTop _tlOisRow _tlOtnMap _tlOtnUniq _tlOtyCtxt) of + { ( _tlIpp,_tlIppL,_tlIself,_tlItnMap,_tlItnUniq) -> + (case (_hdIpp >#< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + (case (PredSeq_Cons _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tlItnMap) of + { _lhsOtnMap -> + (case (_tlItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOppL,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + (case (PredSeq_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOppL,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (empty) of + { _lhsOpp -> + (case ([cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg "prsq" av_ (tnLookupPP av_ _lhsItnMap)]) of + { _lhsOppL -> + (case (PredSeq_Var av_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOppL,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + synthesized attribute: + appFunNm : HsName + visit 1: + inherited attributes: + appSpinePos : Int + cfg : CfgPPTy + isAtTop : Bool + isRow : Bool + parNeed : ParNeed + parNeedL : ParNeedL + tyCtxt : TyQuCtxt + chained attributes: + positionalFldNmL : [HsName] + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + appArgIsEmptyImplsL : [Bool] + appArgPPL : [PP_Doc] + appFunPP : PP_Doc + isArrow : Bool + isEmptyImpls : Bool + isPred : Bool + pp : PP_Doc + self : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 1: + local pp : _ + local self : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local appIsRec : {Bool} + local appIsLikeProd : {Bool} + local appIsArrow : {Bool} + local tyCtxt : _ + local isSpineRoot : {Bool} + local _tup3 : _ + local parNeed : _ + local isAtTop : _ + local argsParNeedL : _ + local _tup4 : _ + local appIsSum : _ + local appIsRecOrSum : _ + local argIsRow : {Bool} + local appArgIsEmptyImplsL : _ + local recSep : _ + local _tup2 : _ + local appArgPPL : _ + local appFunPP : _ + local isArrowRoot : {Bool} + local isArrowArg : {Bool} + local ppDflt : _ + local ppAppTop : _ + local ppAST : _ + local ppNice : _ + local pp : _ + local self : _ + intra appFunNm : {HsName} + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local pp : _ + local self : _ + alternative Dbg: + child info : {String} + visit 1: + local pp : _ + local self : _ + alternative Any: + visit 1: + local pp : _ + local self : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 1: + local pp : _ + local self : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 1: + inst l1' : Ty + local tnPP : _ + local tnMap : _ + local tyCtxt : _ + local tnUniq : _ + local parNeed : _ + local isRow : _ + local isAtTop : _ + local ppL1 : _ + local ppTvPost : _ + local ppQu : _ + local ppTvPre : _ + local ppTv : _ + local pp : _ + local self : _ + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local _tup6 : _ + local positionalNm : _ + local fldPP : _ + local appArgPPL : _ + local appFunPP : _ + local _tup5 : _ + local ppCfg : _ + local ppNice : _ + local isSpineRoot : _ + local pp : _ + local self : _ + intra appFunNm : {HsName} + alternative Pred: + child pr : Pred + visit 1: + local wrapPP : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local pp : _ + local self : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 1: + local tnUniq : _ + local tnPP : _ + local tnMap : _ + local parNeed : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local pp : _ + local self : _ + alternative Impls: + child impls : Impls + visit 1: + local wrapPP : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local pp : _ + local self : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = ( HsName,T_Ty_1) +type T_Ty_1 = Int -> + CfgPPTy -> + Bool -> + Bool -> + ParNeed -> + ParNeedL -> + ([HsName]) -> + TVarNameMap -> + Int -> + TyQuCtxt -> + ( ([Bool]),([PP_Doc]),PP_Doc,Bool,Bool,Bool,([HsName]),PP_Doc,Ty,TVarNameMap,Int) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (case (nm_) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Con_1 :: T_Ty_1 + sem_Ty_Con_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (if cfgPPTyCtxt _lhsIcfg == TyCtxt_Pred && hsnIsArrow nm_ + then cfgPPTyPPCon _lhsIcfg _lhsIcfg hsnPrArrow + else cfgPPTyPPCon _lhsIcfg _lhsIcfg nm_) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Con nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Con_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (case (func_) of + { ( _funcIappFunNm,func_1) -> + (case (_funcIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case ((let sem_Ty_App_1 :: T_Ty_1 + sem_Ty_App_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case (_lhsIcfg) of + { _argOcfg -> + (case (_lhsIcfg) of + { _funcOcfg -> + (case (arg_) of + { ( _argIappFunNm,arg_1) -> + (case (hsnIsRec _funcIappFunNm) of + { _appIsRec -> + (case (hsnIsProd _funcIappFunNm || _appIsRec) of + { _appIsLikeProd -> + (case (hsnIsArrow _funcIappFunNm) of + { _appIsArrow -> + (case (if _appIsArrow then TyQuCtxtArrow + else if _appIsLikeProd then TyQuCtxtProd + else TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _argOtyCtxt -> + (case (_lhsItnUniq) of + { _funcOtnUniq -> + (case (_tyCtxt) of + { _funcOtyCtxt -> + (case (_lhsItnMap) of + { _funcOtnMap -> + (case (_lhsIpositionalFldNmL) of + { _funcOpositionalFldNmL -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (if _isSpineRoot + then parNeedApp _appFunNm + else (ParNotNeeded,_lhsIparNeedL)) of + { __tup3 -> + (case (__tup3) of + { (_parNeed,_) -> + (case (_parNeed) of + { _funcOparNeed -> + (case (_lhsIisRow) of + { _funcOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _funcOisAtTop -> + (case (__tup3) of + { (_,_argsParNeedL) -> + (case (hdAndTl _argsParNeedL) of + { __tup4 -> + (case (__tup4) of + { (_,_funcOparNeedL) -> + (case (_lhsIappSpinePos + 1) of + { _funcOappSpinePos -> + (case (func_1 _funcOappSpinePos _funcOcfg _funcOisAtTop _funcOisRow _funcOparNeed _funcOparNeedL _funcOpositionalFldNmL _funcOtnMap _funcOtnUniq _funcOtyCtxt) of + { ( _funcIappArgIsEmptyImplsL,_funcIappArgPPL,_funcIappFunPP,_funcIisArrow,_funcIisEmptyImpls,_funcIisPred,_funcIpositionalFldNmL,_funcIpp,_funcIself,_funcItnMap,_funcItnUniq) -> + (case (_funcItnUniq) of + { _argOtnUniq -> + (case (_funcItnMap) of + { _argOtnMap -> + (case (_funcIpositionalFldNmL) of + { _argOpositionalFldNmL -> + (case (_lhsIparNeedL) of + { _argOparNeedL -> + (case (_isAtTop) of + { _argOisAtTop -> + (case (__tup4) of + { (_argOparNeed,_) -> + (case (0) of + { _argOappSpinePos -> + (case (hsnIsSum _funcIappFunNm) of + { _appIsSum -> + (case (_appIsRec || _appIsSum) of + { _appIsRecOrSum -> + (case (_isSpineRoot && _appIsRecOrSum) of + { _argIsRow -> + (case (_argIsRow) of + { _argOisRow -> + (case (arg_1 _argOappSpinePos _argOcfg _argOisAtTop _argOisRow _argOparNeed _argOparNeedL _argOpositionalFldNmL _argOtnMap _argOtnUniq _argOtyCtxt) of + { ( _argIappArgIsEmptyImplsL,_argIappArgPPL,_argIappFunPP,_argIisArrow,_argIisEmptyImpls,_argIisPred,_argIpositionalFldNmL,_argIpp,_argIself,_argItnMap,_argItnUniq) -> + (case (_funcIappArgIsEmptyImplsL ++ [_argIisEmptyImpls]) of + { _appArgIsEmptyImplsL -> + (case (_appArgIsEmptyImplsL) of + { _lhsOappArgIsEmptyImplsL -> + (case (cfgPPTyLhsSafe _lhsIcfg "|") of + { _recSep -> + (case (if cfgPPTyFollowAST _lhsIcfg + then (_funcIappFunPP,_funcIappArgPPL ++ [_argIpp]) + else mkExtAppPP' _recSep + (_appFunNm,_funcIappFunPP,_funcIappArgPPL) + (_argIappFunNm,_argIappFunPP,_argIappArgPPL,_argIpp)) of + { __tup2 -> + (case (__tup2) of + { (_,_appArgPPL) -> + (case (_appArgPPL) of + { _lhsOappArgPPL -> + (case (__tup2) of + { (_appFunPP,_) -> + (case (_appFunPP) of + { _lhsOappFunPP -> + (case (_appIsArrow && _isSpineRoot) of + { _isArrowRoot -> + (case (_isArrowRoot) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (_appIsArrow && _lhsIappSpinePos == 1) of + { _isArrowArg -> + (case (if _isArrowArg then _argIisPred else False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (if cfgPPTyFollowAST _lhsIcfg then ppParens _funcIpp >#< ppParens _argIpp else _funcIpp >#< _argIpp) of + { _ppDflt -> + (case (ppAppTop' (_appFunNm,_appFunPP) _appArgPPL _appArgIsEmptyImplsL _ppDflt) of + { _ppAppTop -> + (case (hv ([ppParens _appFunPP] ++ map ((" " >|<) . ppParens) _appArgPPL)) of + { _ppAST -> + (case (ppParNeed _parNeed _lhsIparNeed _ppAppTop) of + { _ppNice -> + (case (if _isSpineRoot + then if cfgPPTyFollowAST _lhsIcfg + then _ppAST + else _ppNice + else _ppDflt) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_App _funcIself _argIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_argItnMap) of + { _lhsOtnMap -> + (case (_argItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_App_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Ann_1 :: T_Ty_1 + sem_Ty_Ann_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsItnUniq) of + { _annOtnUniq -> + (case (_lhsItnMap) of + { _annOtnMap -> + (case (_lhsIcfg) of + { _annOcfg -> + (case (ann_ _annOcfg _annOtnMap _annOtnUniq) of + { ( _annIpp,_annIself,_annItnMap,_annItnUniq) -> + (case (_annItnUniq) of + { _tyOtnUniq -> + (case (_annItnMap) of + { _tyOtnMap -> + (case (_lhsIpositionalFldNmL) of + { _tyOpositionalFldNmL -> + (case (_lhsIparNeedL) of + { _tyOparNeedL -> + (case (_lhsIparNeed) of + { _tyOparNeed -> + (case (_lhsIcfg) of + { _tyOcfg -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_annIpp >#< _tyIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Ann _annIself _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_tyItnMap) of + { _lhsOtnMap -> + (case (_tyItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ann_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Dbg_1 :: T_Ty_1 + sem_Ty_Dbg_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (ppParens $ "DBG<<<" >#< info_ >#< ">>>") of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Dbg info_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Dbg_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Any_1 :: T_Ty_1 + sem_Ty_Any_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (pp hsnUnknown) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Any) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Any_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Var_1 :: T_Ty_1 + sem_Ty_Var_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsItnUniq) of + { _categOtnUniq -> + (case (_lhsItnMap) of + { _categOtnMap -> + (case (_lhsIcfg) of + { _categOcfg -> + (case (categ_ _categOcfg _categOtnMap _categOtnUniq) of + { ( _categIpp,_categIself,_categItnMap,_categItnUniq) -> + (case (cfgPPTyPPVarDflt _lhsIcfg _lhsIcfg (tvCategPrefix _categIself) tv_ (tnLookupPP tv_ _lhsItnMap)) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Var tv_ _categIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_categItnMap) of + { _lhsOtnMap -> + (case (_categItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Var_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_TBind_1 :: T_Ty_1 + sem_Ty_TBind_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (l1_) of + { l1'_val_ -> + (case ((sem_Ty l1'_val_)) of + { l1'_inst_ -> + (case (cfgPPTyPPVar _lhsIcfg _lhsIcfg tv_ _lhsItnUniq) of + { _tnPP -> + (case (tnMapInsert tv_ _tnPP _lhsItnMap) of + { _tnMap -> + (case (_tnMap) of + { _l1'OtnMap -> + (case (_lhsIpositionalFldNmL) of + { _tyOpositionalFldNmL -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItnUniq + 1) of + { _tnUniq -> + (case (_tnUniq) of + { _tyOtnUniq -> + (case (_tnMap) of + { _tyOtnMap -> + (case (_lhsIparNeedL) of + { _tyOparNeedL -> + (case (ParNotNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyOparNeed -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (_lhsIcfg) of + { _tyOcfg -> + (case (0) of + { _tyOappSpinePos -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyIpositionalFldNmL) of + { _l1'OpositionalFldNmL -> + (case (_lhsIparNeedL) of + { _l1'OparNeedL -> + (case (_parNeed) of + { _l1'OparNeed -> + (case (_lhsIcfg) of + { _l1'Ocfg -> + (case (_lhsIappSpinePos) of + { _l1'OappSpinePos -> + (case (_tnUniq) of + { _l1'OtnUniq -> + (case (l1'_inst_) of + { ( _l1'IappFunNm,l1'_1) -> + (case (_tyCtxt) of + { _l1'OtyCtxt -> + (case (_isRow) of + { _l1'OisRow -> + (case (_isAtTop) of + { _l1'OisAtTop -> + (case (l1'_1 _l1'OappSpinePos _l1'Ocfg _l1'OisAtTop _l1'OisRow _l1'OparNeed _l1'OparNeedL _l1'OpositionalFldNmL _l1'OtnMap _l1'OtnUniq _l1'OtyCtxt) of + { ( _l1'IappArgIsEmptyImplsL,_l1'IappArgPPL,_l1'IappFunPP,_l1'IisArrow,_l1'IisEmptyImpls,_l1'IisPred,_l1'IpositionalFldNmL,_l1'Ipp,_l1'Iself,_l1'ItnMap,_l1'ItnUniq) -> + (case (_l1'Ipp) of + { _ppL1 -> + (case (if maybe False (== hsnKindStar) $ tyMbCon l1_ then empty else ppParens _ppL1) of + { _ppTvPost -> + (case (_tnUniq) of + { _quOtnUniq -> + (case (_tnMap) of + { _quOtnMap -> + (case (_lhsIcfg) of + { _quOcfg -> + (case (qu_ _quOcfg _quOtnMap _quOtnUniq) of + { ( _quIpp,_quIself,_quItnMap,_quItnUniq) -> + (case (_quIpp) of + { _ppQu -> + (case (empty) of + { _ppTvPre -> + (case (_tnPP) of + { _ppTv -> + (case (ppParNeed _parNeed _lhsIparNeed + (cfgppAside _lhsIcfg (_ppQu >#< _ppTvPre >|< _ppTv >|< _ppTvPost) ("." >#< _tyIpp))) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_TBind _quIself tv_ l1_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (Map.filterWithKey (\v _ -> v /= tv_) _tyItnMap) of + { _lhsOtnMap -> + (case (_tnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_TBind_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_tyIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Ext_1 :: T_Ty_1 + sem_Ty_Ext_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case (_lhsItnUniq) of + { _tyOtnUniq -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItnMap) of + { _tyOtnMap -> + (case (_lhsIpositionalFldNmL) of + { _tyOpositionalFldNmL -> + (case (_lhsIparNeedL) of + { _tyOparNeedL -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (_lhsIcfg) of + { _tyOcfg -> + (case (ParNotNeeded) of + { _tyOparNeed -> + (case (_lhsIappSpinePos + 1) of + { _tyOappSpinePos -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyItnUniq) of + { _extTyOtnUniq -> + (case (_tyItnMap) of + { _extTyOtnMap -> + (case (_lhsIparNeedL) of + { _extTyOparNeedL -> + (case (_lhsIcfg) of + { _extTyOcfg -> + (case (ParNotNeeded) of + { _extTyOparNeed -> + (case (positionalFldNames) of + { _extTyOpositionalFldNmL -> + (case (hdAndTl _tyIpositionalFldNmL) of + { __tup6 -> + (case (__tup6) of + { (_positionalNm,_) -> + (case (0) of + { _extTyOappSpinePos -> + (case (extTy_) of + { ( _extTyIappFunNm,extTy_1) -> + (case (_tyCtxt) of + { _extTyOtyCtxt -> + (case (_isRow) of + { _extTyOisRow -> + (case (_isAtTop) of + { _extTyOisAtTop -> + (case (extTy_1 _extTyOappSpinePos _extTyOcfg _extTyOisAtTop _extTyOisRow _extTyOparNeed _extTyOparNeedL _extTyOpositionalFldNmL _extTyOtnMap _extTyOtnUniq _extTyOtyCtxt) of + { ( _extTyIappArgIsEmptyImplsL,_extTyIappArgPPL,_extTyIappFunPP,_extTyIisArrow,_extTyIisEmptyImpls,_extTyIisPred,_extTyIpositionalFldNmL,_extTyIpp,_extTyIself,_extTyItnMap,_extTyItnUniq) -> + (case (let pn = if cfgPPTyFollowAST _lhsIcfg then Nothing else Just _positionalNm + in ppFld "::" pn nm_ (cfgPPTyPPHsn _lhsIcfg nm_) _extTyIpp) of + { _fldPP -> + (case (_tyIappArgPPL ++ [_fldPP]) of + { _appArgPPL -> + (case (_appArgPPL) of + { _lhsOappArgPPL -> + (case (_tyIappFunPP) of + { _appFunPP -> + (case (_appFunPP) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (__tup6) of + { (_,_lhsOpositionalFldNmL) -> + (case (ppExts _lhsIcfg _appFunNm _appFunPP _appArgPPL) of + { __tup5 -> + (case (__tup5) of + { (_,_ppCfg) -> + (case (__tup5) of + { (_ppNice,_) -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (if _isSpineRoot then _ppCfg else _ppNice) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Ext _tyIself nm_ _extTyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_extTyItnMap) of + { _lhsOtnMap -> + (case (_extTyItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ext_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Pred_1 :: T_Ty_1 + sem_Ty_Pred_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsItnUniq) of + { _prOtnUniq -> + (case (_lhsItnMap) of + { _prOtnMap -> + (case (_lhsIcfg) of + { _prOcfg -> + (case (if cfgPPTyCtxt _lhsIcfg == TyCtxt_Pred then id else (\pp -> hsnOImpl >#< pp >#< hsnCImpl)) of + { _wrapPP -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _prOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _prOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _prOisAtTop -> + (case (pr_ _prOcfg _prOisAtTop _prOisRow _prOtnMap _prOtnUniq _prOtyCtxt) of + { ( _prIpp,_prIself,_prItnMap,_prItnUniq) -> + (case (cfgPPTyPPImplsAppWrap _lhsIcfg _wrapPP _prIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (True) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Pred _prIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_prItnMap) of + { _lhsOtnMap -> + (case (_prItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Pred_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Lam_1 :: T_Ty_1 + sem_Ty_Lam_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsItnUniq + 1) of + { _tnUniq -> + (case (_tnUniq) of + { _tyOtnUniq -> + (case (cfgPPTyPPVar _lhsIcfg _lhsIcfg tv_ _lhsItnUniq) of + { _tnPP -> + (case (tnMapInsert tv_ _tnPP _lhsItnMap) of + { _tnMap -> + (case (_tnMap) of + { _tyOtnMap -> + (case (_lhsIpositionalFldNmL) of + { _tyOpositionalFldNmL -> + (case (_lhsIparNeedL) of + { _tyOparNeedL -> + (case (ParNotNeeded) of + { _parNeed -> + (case (_parNeed) of + { _tyOparNeed -> + (case (_lhsIcfg) of + { _tyOcfg -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (ppParNeed _parNeed _lhsIparNeed + (cfgppAside _lhsIcfg ("\\" >|< _tnPP) ("->" >#< _tyIpp))) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisEmptyImpls -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Lam tv_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (Map.filterWithKey (\v _ -> v /= tv_) _tyItnMap) of + { _lhsOtnMap -> + (case (_tnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Lam_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Impls_1 :: T_Ty_1 + sem_Ty_Impls_1 = + (\ _lhsIappSpinePos + _lhsIcfg + _lhsIisAtTop + _lhsIisRow + _lhsIparNeed + _lhsIparNeedL + _lhsIpositionalFldNmL + _lhsItnMap + _lhsItnUniq + _lhsItyCtxt -> + (case ([]) of + { _lhsOappArgIsEmptyImplsL -> + (case ([]) of + { _lhsOappArgPPL -> + (case (_lhsItnUniq) of + { _implsOtnUniq -> + (case (_lhsItnMap) of + { _implsOtnMap -> + (case (_lhsIcfg) of + { _implsOcfg -> + (case (if cfgPPTyCtxt _lhsIcfg == TyCtxt_Pred then id else (\pp -> hsnOImpl >#< pp >#< hsnCImpl)) of + { _wrapPP -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _implsOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _implsOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _implsOisAtTop -> + (case (impls_ _implsOcfg _implsOisAtTop _implsOisRow _implsOtnMap _implsOtnUniq _implsOtyCtxt) of + { ( _implsIisEmptyImpls,_implsIpp,_implsIself,_implsItnMap,_implsItnUniq) -> + (case (cfgPPTyPPImplsAppWrap _lhsIcfg _wrapPP _implsIpp) of + { _pp -> + (case (_pp) of + { _lhsOappFunPP -> + (case (False) of + { _lhsOisArrow -> + (case (_implsIisEmptyImpls) of + { _lhsOisEmptyImpls -> + (case (True) of + { _lhsOisPred -> + (case (_lhsIpositionalFldNmL) of + { _lhsOpositionalFldNmL -> + (case (_pp) of + { _lhsOpp -> + (case (Ty_Impls _implsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_implsItnMap) of + { _lhsOtnMap -> + (case (_implsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOappArgIsEmptyImplsL,_lhsOappArgPPL,_lhsOappFunPP,_lhsOisArrow,_lhsOisEmptyImpls,_lhsOisPred,_lhsOpositionalFldNmL,_lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Impls_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + cfg : CfgPPTy + synthesized attribute: + pp : PP_Doc + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = CfgPPTy -> + ( PP_Doc) +data Inh_TyAGItf = Inh_TyAGItf {cfg_Inh_TyAGItf :: !(CfgPPTy)} +data Syn_TyAGItf = Syn_TyAGItf {pp_Syn_TyAGItf :: !(PP_Doc)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIcfg) = + (let ( _lhsOpp) = sem _lhsIcfg + in (Syn_TyAGItf _lhsOpp)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIcfg -> + (case (_lhsIcfg) of + { _tyOcfg -> + (case ([]) of + { _tyOparNeedL -> + (case (ParNotNeeded) of + { _tyOparNeed -> + (case (positionalFldNames) of + { _tyOpositionalFldNmL -> + (case (Map.empty) of + { _tyOtnMap -> + (case (0) of + { _tyOtnUniq -> + (case (0) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOnTop) of + { _tyOtyCtxt -> + (case (False) of + { _tyOisRow -> + (case (True) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOcfg _tyOisAtTop _tyOisRow _tyOparNeed _tyOparNeedL _tyOpositionalFldNmL _tyOtnMap _tyOtnUniq _tyOtyCtxt) of + { ( _tyIappArgIsEmptyImplsL,_tyIappArgPPL,_tyIappFunPP,_tyIisArrow,_tyIisEmptyImpls,_tyIisPred,_tyIpositionalFldNmL,_tyIpp,_tyIself,_tyItnMap,_tyItnUniq) -> + (case (_tyIpp) of + { _lhsOpp -> + ( _lhsOpp) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + inherited attribute: + cfg : CfgPPTy + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + self : TyAnn + alternatives: + alternative Empty: + visit 0: + local pp : _ + local self : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local pp : _ + local self : _ + alternative Mono: + visit 0: + local pp : _ + local self : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = CfgPPTy -> + TVarNameMap -> + Int -> + ( PP_Doc,TyAnn,TVarNameMap,Int) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (empty) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (TyAnn_Empty) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case ("@" >|< show s_) of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (TyAnn_Strictness s_) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (pp "MONO ") of + { _pp -> + (case (_pp) of + { _lhsOpp -> + (case (TyAnn_Mono) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) }) })) +-- TyQu -------------------------------------------------------- +{- + visit 0: + inherited attribute: + cfg : CfgPPTy + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + self : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local self : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local self : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local self : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = CfgPPTy -> + TVarNameMap -> + Int -> + ( PP_Doc,TyQu,TVarNameMap,Int) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (TyQu_Forall mlev_) of + { _self -> + (case (text (showTyQu _self)) of + { _lhsOpp -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (TyQu_Exists mlev_) of + { _self -> + (case (text (showTyQu _self)) of + { _lhsOpp -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (TyQu_Plain mlev_) of + { _self -> + (case (text (showTyQu _self)) of + { _lhsOpp -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + inherited attribute: + cfg : CfgPPTy + chained attributes: + tnMap : TVarNameMap + tnUniq : Int + synthesized attributes: + pp : PP_Doc + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local self : _ + alternative Fixed: + visit 0: + local self : _ + alternative Meta: + visit 0: + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = CfgPPTy -> + TVarNameMap -> + Int -> + ( PP_Doc,TyVarCateg,TVarNameMap,Int) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (empty) of + { _lhsOpp -> + (case (TyVarCateg_Plain) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (empty) of + { _lhsOpp -> + (case (TyVarCateg_Fixed) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (\ _lhsIcfg + _lhsItnMap + _lhsItnUniq -> + (case (empty) of + { _lhsOpp -> + (case (TyVarCateg_Meta) of + { _self -> + (case (_self) of + { _lhsOself -> + (case (_lhsItnMap) of + { _lhsOtnMap -> + (case (_lhsItnUniq) of + { _lhsOtnUniq -> + ( _lhsOpp,_lhsOself,_lhsOtnMap,_lhsOtnUniq) }) }) }) }) })) diff --git a/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs b/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs @@ -0,0 +1,1816 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/TreeTrieKey) +module UHC.Light.Compiler.Ty.TreeTrieKey where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import Data.List as Lst +import UHC.Util.FastSeq as Seq +import UHC.Light.Compiler.Base.TreeTrie +import UHC.Light.Compiler.CHR.Key + + + +data TyQuCtxt = TyQuCtxtArrow | TyQuCtxtProd | TyQuCtxtOnTop | TyQuCtxtOther deriving (Show,Eq) + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + +tyTreeTrieKey :: TTKeyableOpts -> Ty -> TreeTrieKey Key +tyTreeTrieKey opts ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf {opts_Inh_TyAGItf = opts}) + in (key_Syn_TyAGItf t) + + + +instance TTKeyable Ty where + toTTKey' o = tyTreeTrieKey o + +instance TTKeyable Pred where + toTTKey' o pr = tyTreeTrieKey o $ mkTyPr pr + +instance TTKeyable PredScope where + toTTKey' o (PredScope_Var v) | ttkoptsVarsAsWild o = ttkSingleton TT1K_Any + | otherwise = ttkSingleton (TT1K_One $ Key_UID v) + toTTKey' o (PredScope_Lev l) = ttkSingleton $ TT1K_One $ Key_Str $ show l + +instance TTKeyable CHRPredOccCxt where + toTTKey' o (CHRPredOccCxt_Scope1 sc) = toTTKey' o sc -- for now + +instance TTKeyable PredOcc where + toTTKey' o po = toTTKey' o (poPr po) + +instance TTKeyable CHRPredOcc where + -- toTTKey' o po = ttkAdd (TT1K_One $ Key_Str "occ") [toTTKey' o (cpoCxt po), toTTKey' o (cpoPr po)] + toTTKeyParentChildren' o po = (TT1K_One $ Key_Str "occ", ttkChildren [toTTKey' o (cpoCxt po), toTTKey' o (cpoPr po)]) + + + + +instance TTKeyable PredOccId where + toTTKey' o (PredOccId i) = ttkSingleton $ TT1K_One $ Key_UID i + + + +labelTreeTrieKey :: TTKeyableOpts -> Label -> TreeTrieKey Key +labelTreeTrieKey opts label + = let t = wrap_LabelAGItf + (sem_LabelAGItf (LabelAGItf_AGItf label)) + (Inh_LabelAGItf {opts_Inh_LabelAGItf = opts}) + in (key_Syn_LabelAGItf t) + + + +instance TTKeyable LabelOffset where + toTTKey' o (LabelOffset_Var v) | ttkoptsVarsAsWild o = ttkSingleton TT1K_Any + | otherwise = ttkSingleton (TT1K_One $ Key_UID v) + toTTKey' o (LabelOffset_Off l) = ttkSingleton $ TT1K_One $ Key_Str $ show l + +instance TTKeyable Label where + toTTKey' = labelTreeTrieKey + + + +(_,u1,u2,u3,u4) = mkNewLevUID4 uidStart +v1 = mkTyVar u1 +v2 = mkTyVar u2 +v3 = mkTyVar u3 +v4 = mkTyVar u4 + +t1 = tyInt +t2 = appArr [t1] t1 +t3 = appArr [t2] t2 +t4 = appArr [v1] v2 +t5 = appArr [v3] v4 +t6 = appArr [t4] t5 +t7 = appArr [v1] t5 +t8 = appArr [t4] v3 +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + isRow : Bool + opts : TTKeyableOpts + tyCtxt : TyQuCtxt + synthesized attribute: + self : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local self : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local self : _ + alternative Nil: + visit 0: + local self : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = Bool -> + Bool -> + TTKeyableOpts -> + TyQuCtxt -> + ( Impls) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (Impls_Tail iv_ proveOccs_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (tl_ _tlOisAtTop _tlOisRow _tlOopts _tlOtyCtxt) of + { ( _tlIself) -> + (case (_lhsItyCtxt) of + { _prOtyCtxt -> + (case (_lhsIopts) of + { _prOopts -> + (case (_lhsIisRow) of + { _prOisRow -> + (case (_lhsIisAtTop) of + { _prOisAtTop -> + (case (pr_ _prOisAtTop _prOisRow _prOopts _prOtyCtxt) of + { ( _prIkey,_prIself) -> + (case (Impls_Cons iv_ _prIself pv_ prange_ proveOccs_ _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (Impls_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : TTKeyableOpts + synthesized attributes: + bkey : TreeTrie1Key Key + key : TreeTrieKey Key + self : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local bkey : _ + local key : _ + local self : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local bkey : _ + local key : _ + local self : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = TTKeyableOpts -> + ( (TreeTrie1Key Key),(TreeTrieKey Key),Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (\ _lhsIopts -> + (case (TT1K_One (Key_HNm nm_)) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Label_Lab nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOkey,_lhsOself) }) }) }) }) }) })) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (\ _lhsIopts -> + (case (if ttkoptsVarsAsWild _lhsIopts + then TT1K_Any + else TT1K_One (Key_UID lv_)) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Label_Var lv_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOkey,_lhsOself) }) }) }) }) }) })) +-- LabelAGItf -------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : TTKeyableOpts + synthesized attribute: + key : TreeTrieKey Key + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = TTKeyableOpts -> + ( (TreeTrieKey Key)) +data Inh_LabelAGItf = Inh_LabelAGItf {opts_Inh_LabelAGItf :: !(TTKeyableOpts)} +data Syn_LabelAGItf = Syn_LabelAGItf {key_Syn_LabelAGItf :: !((TreeTrieKey Key))} +wrap_LabelAGItf :: T_LabelAGItf -> + Inh_LabelAGItf -> + Syn_LabelAGItf +wrap_LabelAGItf sem (Inh_LabelAGItf _lhsIopts) = + (let ( _lhsOkey) = sem _lhsIopts + in (Syn_LabelAGItf _lhsOkey)) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _labOopts -> + (case (lab_ _labOopts) of + { ( _labIbkey,_labIkey,_labIself) -> + (case (_labIkey) of + { _lhsOkey -> + ( _lhsOkey) }) }) })) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + isRow : Bool + opts : TTKeyableOpts + tyCtxt : TyQuCtxt + synthesized attributes: + key : TreeTrieKey Key + self : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local appSpinePos : _ + local self : _ + alternative Pred: + child ty : Ty + visit 0: + local appSpinePos : _ + local self : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local appSpinePos : _ + local bkey : _ + local key : _ + local self : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local appSpinePos : _ + local bkey : _ + local key : _ + local self : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local appSpinePos : _ + local bkey : _ + local key : _ + local self : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local bkey : _ + local key : _ + local self : _ + alternative Preds: + child seq : PredSeq + visit 0: + local appSpinePos : _ + local bkey : _ + local key : _ + local self : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = Bool -> + Bool -> + TTKeyableOpts -> + TyQuCtxt -> + ( (TreeTrieKey Key),Pred) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _tyOopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (_tyIkey) of + { _lhsOkey -> + (case (Pred_Class _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _tyOopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (_tyIkey) of + { _lhsOkey -> + (case (Pred_Pred _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _labOopts -> + (case (_lhsIopts) of + { _tyOopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (TT1K_One (Key_Str "\\")) of + { _bkey -> + (case (lab_ _labOopts) of + { ( _labIbkey,_labIkey,_labIself) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (ttkAdd _bkey [ttkAdd _labIbkey _tyIchildKeyL]) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Pred_Lacks _tyIself _labIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _argsOopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _argsOappSpinePos -> + (case (TT1K_One (Key_Str "=>")) of + { _bkey -> + (case (_lhsItyCtxt) of + { _argsOtyCtxt -> + (case (_lhsIisRow) of + { _argsOisRow -> + (case (_lhsIisAtTop) of + { _argsOisAtTop -> + (case (args_ _argsOappSpinePos _argsOisAtTop _argsOisRow _argsOopts _argsOtyCtxt) of + { ( _argsIchildKeyL,_argsIkey,_argsIself) -> + (case (ttkAdd _bkey [_argsIkey]) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (_lhsItyCtxt) of + { _resOtyCtxt -> + (case (_lhsIopts) of + { _resOopts -> + (case (_lhsIisRow) of + { _resOisRow -> + (case (_lhsIisAtTop) of + { _resOisAtTop -> + (case (res_ _resOisAtTop _resOisRow _resOopts _resOtyCtxt) of + { ( _resIkey,_resIself) -> + (case (Pred_Arrow _argsIself _resIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _tyROopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyROappSpinePos -> + (case (_lhsIopts) of + { _tyLOopts -> + (case (_appSpinePos) of + { _tyLOappSpinePos -> + (case (TT1K_One (Key_HNm hsnEqTilde)) of + { _bkey -> + (case (tyR_) of + { ( _tyRIappFunNm,tyR_1) -> + (case (_lhsItyCtxt) of + { _tyROtyCtxt -> + (case (_lhsIisRow) of + { _tyROisRow -> + (case (_lhsIisAtTop) of + { _tyROisAtTop -> + (case (tyR_1 _tyROappSpinePos _tyROisAtTop _tyROisRow _tyROopts _tyROtyCtxt) of + { ( _tyRIbkey,_tyRIchildKeyL,_tyRIisArrow,_tyRIisFixed,_tyRIisPred,_tyRIkey,_tyRIself) -> + (case (tyL_) of + { ( _tyLIappFunNm,tyL_1) -> + (case (_lhsItyCtxt) of + { _tyLOtyCtxt -> + (case (_lhsIisRow) of + { _tyLOisRow -> + (case (_lhsIisAtTop) of + { _tyLOisAtTop -> + (case (tyL_1 _tyLOappSpinePos _tyLOisAtTop _tyLOisRow _tyLOopts _tyLOtyCtxt) of + { ( _tyLIbkey,_tyLIchildKeyL,_tyLIisArrow,_tyLIisFixed,_tyLIisPred,_tyLIkey,_tyLIself) -> + (case (ttkAdd _bkey [_tyLIkey,_tyRIkey]) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Pred_Eq _tyLIself _tyRIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (if ttkoptsVarsAsWild _lhsIopts + then TT1K_Any + else TT1K_One (Key_UID pv_)) of + { _bkey -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Pred_Var pv_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _seqOopts -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _seqOappSpinePos -> + (case (TT1K_One (Key_Str "seq")) of + { _bkey -> + (case (_lhsItyCtxt) of + { _seqOtyCtxt -> + (case (_lhsIisRow) of + { _seqOisRow -> + (case (_lhsIisAtTop) of + { _seqOisAtTop -> + (case (seq_ _seqOappSpinePos _seqOisAtTop _seqOisRow _seqOopts _seqOtyCtxt) of + { ( _seqIchildKeyL,_seqIkey,_seqIself) -> + (case (ttkAdd _bkey [_seqIkey]) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Pred_Preds _seqIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + isAtTop : Bool + isRow : Bool + opts : TTKeyableOpts + tyCtxt : TyQuCtxt + synthesized attributes: + childKeyL : [TreeTrieKey Key] + key : TreeTrieKey Key + self : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local childKeyL : _ + local bkey : _ + local isSpineRoot : {Bool} + local key : _ + local self : _ + alternative Nil: + visit 0: + local childKeyL : _ + local bkey : _ + local key : _ + local self : _ + alternative Var: + child av : {TyVarId} + visit 0: + local childKeyL : _ + local bkey : _ + local key : _ + local self : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Int -> + Bool -> + Bool -> + TTKeyableOpts -> + TyQuCtxt -> + ( ([TreeTrieKey Key]),(TreeTrieKey Key),PredSeq) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (_lhsIappSpinePos + 1) of + { _tlOappSpinePos -> + (case (tl_ _tlOappSpinePos _tlOisAtTop _tlOisRow _tlOopts _tlOtyCtxt) of + { ( _tlIchildKeyL,_tlIkey,_tlIself) -> + (case (_lhsItyCtxt) of + { _hdOtyCtxt -> + (case (_lhsIisRow) of + { _hdOisRow -> + (case (_lhsIisAtTop) of + { _hdOisAtTop -> + (case (hd_ _hdOisAtTop _hdOisRow _hdOopts _hdOtyCtxt) of + { ( _hdIkey,_hdIself) -> + (case (_hdIkey : _tlIchildKeyL) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (TT1K_One (Key_Str ":")) of + { _bkey -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (if _isSpineRoot + then ttkAdd _bkey _childKeyL + else []) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (PredSeq_Cons _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOchildKeyL,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (TT1K_One (Key_Str "[]")) of + { _bkey -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (PredSeq_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOchildKeyL,_lhsOkey,_lhsOself) }) }) }) }) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (if ttkoptsVarsAsWild _lhsIopts + then TT1K_Any + else TT1K_One (Key_UID av_)) of + { _bkey -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (PredSeq_Var av_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOchildKeyL,_lhsOkey,_lhsOself) }) }) }) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + synthesized attribute: + appFunNm : HsName + visit 1: + inherited attributes: + appSpinePos : Int + isAtTop : Bool + isRow : Bool + opts : TTKeyableOpts + tyCtxt : TyQuCtxt + synthesized attributes: + bkey : TreeTrie1Key Key + childKeyL : [TreeTrieKey Key] + isArrow : Bool + isFixed : Bool + isPred : Bool + key : TreeTrieKey Key + self : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local self : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local appIsRec : {Bool} + local appIsLikeProd : {Bool} + local appIsArrow : {Bool} + local tyCtxt : _ + local isAtTop : _ + local bkey : _ + local isSpineRoot : {Bool} + local appIsSum : _ + local appIsRecOrSum : _ + local argIsRow : {Bool} + local childKeyL : _ + local isArrowRoot : {Bool} + local isArrowArg : {Bool} + local key : _ + local self : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 1: + local bkey : _ + local childKeyL : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local self : _ + alternative Dbg: + child info : {String} + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local self : _ + alternative Any: + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local self : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local self : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 1: + local bkey : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local childKeyL : _ + local key : _ + local self : _ + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local self : _ + local isSpineRoot : _ + local bkey : _ + local childKeyL : _ + local key : _ + alternative Pred: + child pr : Pred + visit 1: + local bkey : _ + local childKeyL : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local self : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local self : _ + alternative Impls: + child impls : Impls + visit 1: + local bkey : _ + local childKeyL : _ + local key : _ + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local self : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = ( HsName,T_Ty_1) +type T_Ty_1 = Int -> + Bool -> + Bool -> + TTKeyableOpts -> + TyQuCtxt -> + ( (TreeTrie1Key Key),([TreeTrieKey Key]),Bool,Bool,Bool,(TreeTrieKey Key),Ty) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (case (nm_) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Con_1 :: T_Ty_1 + sem_Ty_Con_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_One (Key_HNm nm_)) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_Con nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Con_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (case (func_) of + { ( _funcIappFunNm,func_1) -> + (case (_funcIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case ((let sem_Ty_App_1 :: T_Ty_1 + sem_Ty_App_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsIappSpinePos + 1) of + { _funcOappSpinePos -> + (case (hsnIsRec _funcIappFunNm) of + { _appIsRec -> + (case (hsnIsProd _funcIappFunNm || _appIsRec) of + { _appIsLikeProd -> + (case (hsnIsArrow _funcIappFunNm) of + { _appIsArrow -> + (case (if _appIsArrow then TyQuCtxtArrow + else if _appIsLikeProd then TyQuCtxtProd + else TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _funcOtyCtxt -> + (case (_lhsIisRow) of + { _funcOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _funcOisAtTop -> + (case (func_1 _funcOappSpinePos _funcOisAtTop _funcOisRow _funcOopts _funcOtyCtxt) of + { ( _funcIbkey,_funcIchildKeyL,_funcIisArrow,_funcIisFixed,_funcIisPred,_funcIkey,_funcIself) -> + (case (_funcIbkey) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case (_lhsIopts) of + { _argOopts -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (0) of + { _argOappSpinePos -> + (case (arg_) of + { ( _argIappFunNm,arg_1) -> + (case (_tyCtxt) of + { _argOtyCtxt -> + (case (_isAtTop) of + { _argOisAtTop -> + (case (hsnIsSum _funcIappFunNm) of + { _appIsSum -> + (case (_appIsRec || _appIsSum) of + { _appIsRecOrSum -> + (case (_isSpineRoot && _appIsRecOrSum) of + { _argIsRow -> + (case (_argIsRow) of + { _argOisRow -> + (case (arg_1 _argOappSpinePos _argOisAtTop _argOisRow _argOopts _argOtyCtxt) of + { ( _argIbkey,_argIchildKeyL,_argIisArrow,_argIisFixed,_argIisPred,_argIkey,_argIself) -> + (case (let cs = _argIkey : _funcIchildKeyL + in if _isSpineRoot + then reverse cs + else cs) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (_appIsArrow && _isSpineRoot) of + { _isArrowRoot -> + (case (_isArrowRoot) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (_appIsArrow && _lhsIappSpinePos == 1) of + { _isArrowArg -> + (case (if _isArrowArg then _argIisPred else False) of + { _lhsOisPred -> + (case (if _isSpineRoot + then ttkAdd _bkey _childKeyL + else []) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_App _funcIself _argIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_App_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Ann_1 :: T_Ty_1 + sem_Ty_Ann_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIopts) of + { _tyOopts -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (_tyIkey) of + { _lhsOkey -> + (case (ann_) of + { ( _annIself) -> + (case (Ty_Ann _annIself _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ann_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Dbg_1 :: T_Ty_1 + sem_Ty_Dbg_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_Dbg info_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Dbg_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Any_1 :: T_Ty_1 + sem_Ty_Any_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_Any) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Any_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Var_1 :: T_Ty_1 + sem_Ty_Var_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (categ_) of + { ( _categIself) -> + (case (if tvCatIsFixed _categIself || not (ttkoptsVarsAsWild _lhsIopts) + then TT1K_One (Key_UID tv_) + else TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_Var tv_ _categIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Var_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_TBind_1 :: T_Ty_1 + sem_Ty_TBind_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (qu_) of + { ( _quIself) -> + (case (TT1K_One (Key_TyQu _quIself)) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case (_lhsIopts) of + { _tyOopts -> + (case (0) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case ([_tyIkey]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkAdd _bkey _childKeyL) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (Ty_TBind _quIself tv_ l1_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_TBind_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (_tyIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Ext_1 :: T_Ty_1 + sem_Ty_Ext_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (extTy_) of + { ( _extTyIappFunNm,extTy_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _extTyOtyCtxt -> + (case (_lhsIopts) of + { _extTyOopts -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _extTyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _extTyOisAtTop -> + (case (0) of + { _extTyOappSpinePos -> + (case (extTy_1 _extTyOappSpinePos _extTyOisAtTop _extTyOisRow _extTyOopts _extTyOtyCtxt) of + { ( _extTyIbkey,_extTyIchildKeyL,_extTyIisArrow,_extTyIisFixed,_extTyIisPred,_extTyIkey,_extTyIself) -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIopts) of + { _tyOopts -> + (case (_isRow) of + { _tyOisRow -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (_lhsIappSpinePos + 1) of + { _tyOappSpinePos -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (Ty_Ext _tyIself nm_ _extTyIself) of + { _self -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (if _isSpineRoot && _tyIisFixed + then let (_,exts) = recUnRowExts _self + in TT1K_One (Key_Str $ concat $ intersperse "," $ Lst.map show $ assocLKeys exts) + else TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case (let cs = _extTyIkey : _tyIchildKeyL + in if _isSpineRoot + then reverse cs + else cs) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (_tyIisFixed) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (if _isSpineRoot + then ttkAdd _bkey _childKeyL + else []) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ext_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Pred_1 :: T_Ty_1 + sem_Ty_Pred_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (True) of + { _lhsOisPred -> + (case (_lhsIopts) of + { _prOopts -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _prOtyCtxt -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _prOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _prOisAtTop -> + (case (pr_ _prOisAtTop _prOisRow _prOopts _prOtyCtxt) of + { ( _prIkey,_prIself) -> + (case (_prIkey) of + { _lhsOkey -> + (case (Ty_Pred _prIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Pred_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Lam_1 :: T_Ty_1 + sem_Ty_Lam_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (False) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsIopts) of + { _tyOopts -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (Ty_Lam tv_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Lam_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ((let sem_Ty_Impls_1 :: T_Ty_1 + sem_Ty_Impls_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt -> + (case (TT1K_Any) of + { _bkey -> + (case (_bkey) of + { _lhsObkey -> + (case ([]) of + { _childKeyL -> + (case (_childKeyL) of + { _lhsOchildKeyL -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisFixed -> + (case (True) of + { _lhsOisPred -> + (case (ttkSingleton _bkey) of + { _key -> + (case (_key) of + { _lhsOkey -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _implsOtyCtxt -> + (case (_lhsIopts) of + { _implsOopts -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _implsOisRow -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _implsOisAtTop -> + (case (impls_ _implsOisAtTop _implsOisRow _implsOopts _implsOtyCtxt) of + { ( _implsIself) -> + (case (Ty_Impls _implsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsObkey,_lhsOchildKeyL,_lhsOisArrow,_lhsOisFixed,_lhsOisPred,_lhsOkey,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Impls_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : TTKeyableOpts + synthesized attribute: + key : TreeTrieKey Key + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = TTKeyableOpts -> + ( (TreeTrieKey Key)) +data Inh_TyAGItf = Inh_TyAGItf {opts_Inh_TyAGItf :: !(TTKeyableOpts)} +data Syn_TyAGItf = Syn_TyAGItf {key_Syn_TyAGItf :: !((TreeTrieKey Key))} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIopts) = + (let ( _lhsOkey) = sem _lhsIopts + in (Syn_TyAGItf _lhsOkey)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tyOopts -> + (case (0) of + { _tyOappSpinePos -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) -> + (case (TyQuCtxtOnTop) of + { _tyOtyCtxt -> + (case (False) of + { _tyOisRow -> + (case (True) of + { _tyOisAtTop -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt) of + { ( _tyIbkey,_tyIchildKeyL,_tyIisArrow,_tyIisFixed,_tyIisPred,_tyIkey,_tyIself) -> + (case (_tyIkey) of + { _lhsOkey -> + ( _lhsOkey) }) }) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : TyAnn + alternatives: + alternative Empty: + visit 0: + local self : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local self : _ + alternative Mono: + visit 0: + local self : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (case (TyAnn_Empty) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (case (TyAnn_Strictness s_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (case (TyAnn_Mono) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +-- TyQu -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local self : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local self : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local self : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (case (TyQu_Forall mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (case (TyQu_Exists mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (case (TyQu_Plain mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attribute: + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local self : _ + alternative Fixed: + visit 0: + local self : _ + alternative Meta: + visit 0: + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (case (TyVarCateg_Plain) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (case (TyVarCateg_Fixed) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (case (TyVarCateg_Meta) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOself) }) }) diff --git a/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs b/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs @@ -0,0 +1,203 @@ +module UHC.Light.Compiler.Ty.Trf.BetaReduce +( TyBetaRedOut, mkDfltTyBetaRedOut, TyBetaRedOut' (..) +, emptyTyBetaRedOut', emptyTyBetaRedOut +, betaRedIsOkFitsinCombi +, TyBetaRedLkup, betaRedTyLookup +, tyBetaRed, tyBetaRedAndInit +, tyBetaRedFullMb +, tyBetaRedFull ) +where +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Gam.Full +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.VarMp +import Data.Maybe +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Debug + +{-# LINE 34 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +data TyBetaRedOut' x + = TyBetaRedOut + { tbroutRes :: x + , tbroutVarMp :: VarMp + , tbroutTracePPL :: [PP_Doc] + , tbroutExpandedTo :: Maybe TyBetaRedLookAheadExpansion -- 1 expansion step lookahead type function + args + } + +type TyBetaRedOut = TyBetaRedOut' Ty + +mkDfltTyBetaRedOut :: x -> TyBetaRedOut' x +mkDfltTyBetaRedOut = emptyTyBetaRedOut' + +{-# LINE 49 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +emptyTyBetaRedOut' :: x -> TyBetaRedOut' x +emptyTyBetaRedOut' x = TyBetaRedOut x emptyVarMp [] Nothing + +emptyTyBetaRedOut :: TyBetaRedOut' Ty +emptyTyBetaRedOut = emptyTyBetaRedOut' Ty_Any + +{-# LINE 61 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +-- | expansion lookahead info +type TyBetaRedLookAheadExpansion + = ( Ty -- type function + , [Ty] -- arguments + , Maybe TyBetaRedOut -- function in ty looked up as if it were to be used for expansion + ) + + +{-# LINE 74 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +-- | check for a valid combi using lookahead info of next expansion. +-- Basically prevent synonyms and lambdas from being bound, but forced to be expanded +betaRedIsOkFitsinCombi :: (Ty -> Bool) -> TyBetaRedOut -> TyBetaRedOut -> Bool +betaRedIsOkFitsinCombi isBoundable + (TyBetaRedOut {tbroutExpandedTo = Just (fl,al,_ )}) -- a tvar + (TyBetaRedOut {tbroutExpandedTo = Just (fr,ar,mbExp)}) -- cannot be bound/matched against non expanded synonym/lambda + | isBoundable fl && not (null ar || null al) && (tyIsLam fr || isJust mbExp) + = False +{- +betaRedIsOkFitsinCombi isBoundable + (TyBetaRedExtra {tybetaredextraExpandedTo = Just (fl,al,mbExp)}) + (TyBetaRedExtra {tybetaredextraExpandedTo = Just (fr,ar,_ )}) + | isBoundable fr && not (null ar || null al) && (tyIsLam fl || isJust mbExp) + = False +-} +betaRedIsOkFitsinCombi _ _ _ + = True + +{-# LINE 98 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +type TyBetaRedLkup gm = TyBetaRedEnv gm -> HsName -> Maybe TyBetaRedOut + +betaRedTyLookup :: TyBetaRedLkup gm +betaRedTyLookup fi nm = fmap (mkDfltTyBetaRedOut . tgiTy) $ tyGamLookup nm $ feTyGam $ fiEnv $ tbredFI fi + +{-# LINE 105 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +-- | lookup the type used as if in function position of type application +betaRedTyFunLookup :: TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty -> Maybe TyBetaRedOut +betaRedTyFunLookup fi lkup funTy + = do nm <- tyMbCon funTy + t' <- lkup fi nm + case tbroutRes t' of + Ty_Con nm' | nm == nm' -> Nothing + f -> Just (mkDfltTyBetaRedOut f) + +{-# LINE 116 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +-- | get the lookahead for reduction +betaRedTyLookAhead :: VarLookup gm TyVarId VarMpInfo => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty -> TyBetaRedLookAheadExpansion +betaRedTyLookAhead renv lkup ty + = unpack ty + where unpack t = (f', as, betaRedTyFunLookup renv lkup f') + where (f,as) = tyAppFunArgsWithLkup (fiLookupTyVarCyc fi) t + f' = tyUnAnn $ fiLookupReplaceTyCyc fi f + fi = tbredFI renv + +{-# LINE 127 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +-- | one expansion step of type level beta reduction +tyBetaRed1 + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Either Ty TyBetaRedLookAheadExpansion + -> Maybe TyBetaRedOut +tyBetaRed1 renv lkup tyOrFunAndArgs + = eval (either (betaRedTyLookAhead renv lkup) id tyOrFunAndArgs) + where -- lambda expression: take body and substitute arguments + eval (lam@(Ty_Lam fa b), args, f) + | isJust mbEtaRed + = mkres (appTopApp (fromJust mbEtaRed : args)) + | lamLen <= argLen + = mkres (appTopApp (subst `varUpd` lamBody : drop lamLen args)) + | otherwise + = Nothing + where mbEtaRed = tyLamEtaRed lam + (lamArgs,lamBody) = tyLamArgsRes lam + lamLen = length lamArgs + argLen = length args + subst = assocTyLToVarMp (zip lamArgs args) + -- normalization for polarity types + -- * removes double negations + -- * removes negation on 'basic' polarities + eval (Ty_Con nm, [arg], _) + | nm == hsnPolNegation + = case tyUnAnn $ fiLookupReplaceTyCyc fi fun' of + Ty_Con nm + | nm == hsnPolNegation -> mkres (head args') + | otherwise -> mkres (polOpp arg) + _ -> Nothing + where + (fun',args') = tyAppFunArgsWithLkup (fiLookupTyVarCyc fi) arg + + -- looked up in the environment + eval (_, args, Just funExp) + = mkres $ appTopApp $ tbroutRes funExp : args + + -- no expansion possible + eval _ = Nothing + + -- utils + mkres t = Just ( (emptyTyBetaRedOut' t) + { tbroutExpandedTo = Just $ betaRedTyLookAhead renv lkup t + , tbroutTracePPL = [trfitIn "tylam" ("from:" >#< ppTyWithFI fi (pack tyOrFunAndArgs) >-< "to :" >#< ppTyWithFI fi t)] + } + ) + pack = either id (\(f,as,_) -> appTopApp (f:as)) + fi = tbredFI renv + +{-# LINE 180 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +tyBetaRed' + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Either Ty TyBetaRedLookAheadExpansion + -> [TyBetaRedOut] +tyBetaRed' renv lkup tyOrFunArgs + = case tyBetaRed1 renv lkup tyOrFunArgs of + Just re -> re : tyBetaRed' renv lkup (maybe (Left (tbroutRes re)) Right $ tbroutExpandedTo re) + _ -> [] + +tyBetaRed + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty + -> [TyBetaRedOut] +tyBetaRed renv lkup ty = tyBetaRed' renv lkup (Left ty) + +tyBetaRedAndInit + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty + -> [TyBetaRedOut] +tyBetaRedAndInit renv lkup ty + = ((emptyTyBetaRedOut' ty) {tbroutExpandedTo = Just l}) : tyBetaRed' renv lkup (Right l) + where l = betaRedTyLookAhead renv lkup ty + +{-# LINE 210 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +tyBetaRedFullMb + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> TyBetaRedLkup gm -> (Ty -> Maybe TyBetaRedOut) -> Ty + -> Maybe TyBetaRedOut +tyBetaRedFullMb renv lkup redSub ty + = fmap reda $ choose ty $ redl ty + where env = fiEnv $ tbredFI renv + lim = ehcOptTyBetaRedCutOffAt $ feEHCOpts env + redl ty = take lim $ tyBetaRed renv lkup ty + reda re = if null (catMaybes as') + then mkDfltTyBetaRedOut ty + else let as'' = zipWith (\t mt -> maybe (mkDfltTyBetaRedOut t) id mt) as as' + in emptyTyBetaRedOut {tbroutRes = mk f $ map tbroutRes as'', tbroutVarMp = varmpUnions $ map tbroutVarMp as''} + where (f,as,mk) = tyDecomposeMk ty + as' = map redSub as + ty = tbroutRes re + choose a [] = Nothing + choose a as = Just (last as) + +{-# LINE 233 "src/ehc/Ty/Trf/BetaReduce.chs" #-} +tyBetaRedFull + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> VarMp -> Ty + -> Ty +tyBetaRedFull renv varmp ty + = maybe ty tbroutRes $ sub ty + where fi = tbredFI renv + fi' = fi {fiVarMp = varmp} + sub = \t -> tyBetaRedFullMb (renv {tbredFI = fi'}) betaRedTyLookup sub $ varmp `varUpd` t + diff --git a/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs b/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs @@ -0,0 +1,2062 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/Canonic) +module UHC.Light.Compiler.Ty.Trf.Canonic(TyCanonicOut +, TyCanonicOpts (..), emptyTyCanonicOpts +, tyCanonic +, tyCanonicFFI' +, tyCanonicFFI +, predCanonic +, tyCanonic' +, predCanonic') where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty.FitsInCommon2 +import Data.Maybe +import qualified Data.Set as Set +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.Ty.Trf.BetaReduce +import UHC.Util.Utils +import UHC.Light.Compiler.Gam.Full +import UHC.Util.Debug +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.HsName.Builtin +import Control.Applicative + + +data TyQuCtxt = TyQuCtxtArrow | TyQuCtxtProd | TyQuCtxtOnTop | TyQuCtxtOther deriving (Show,Eq) + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + + + + + + + + + +type TyCanonicOut' x = TyBetaRedOut' x +type TyCanonicOut = TyBetaRedOut + +mkCanonicOut x y = emptyTyBetaRedOut {tbroutRes = x, tbroutVarMp = y} + +mkDfltTyCanonicOut :: x -> TyCanonicOut' x +mkDfltTyCanonicOut = mkDfltTyBetaRedOut + + + +data TyCanonicOpts + = TyCanonicOpts + { tcoTyBetaRedFullMb :: Ty -> Maybe TyCanonicOut + } + +emptyTyCanonicOpts :: TyCanonicOpts +emptyTyCanonicOpts + = TyCanonicOpts + { tcoTyBetaRedFullMb = \t -> Nothing + } + + + +tcoTyBetaRedFull :: TyCanonicOpts -> Ty -> TyCanonicOut +tcoTyBetaRedFull tco ty = maybe (mkDfltTyCanonicOut ty) id $ tcoTyBetaRedFullMb tco ty + + + +tyCanonicMb' :: TyCanonicOpts -> Ty -> Maybe TyCanonicOut +tyCanonicMb' opts ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf + { opts_Inh_TyAGItf = opts + } + ) + in if isReplaced_Syn_TyAGItf t then Just (mkCanonicOut (repl_Syn_TyAGItf t) (varMp_Syn_TyAGItf t)) else Nothing + +tyCanonic' :: TyCanonicOpts -> Ty -> TyCanonicOut +tyCanonic' opts ty = maybe (mkDfltTyCanonicOut ty) id $ tyCanonicMb' opts ty + + + +predCanonic' :: TyCanonicOpts -> Pred -> (Pred,VarMp) +predCanonic' opts pr + = case tyCanonicMb' opts $ mkTyPr pr of + -- Just (Ty_Pred pr',m) -> (pr', m) + Just (r@(TyBetaRedOut {tbroutRes = Ty_Pred pr'})) -> (pr', tbroutVarMp r) + _ -> (pr, emptyVarMp) + + + +tyCanonic + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> Ty + -> Ty +tyCanonic fi + = tbroutRes . tyCanonic' opts + where opts = emptyTyCanonicOpts + {tcoTyBetaRedFullMb = tyBetaRedFullMb fi canonLkupTy (tyCanonicMb' opts)} + + + +tyCanonicFFI' + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => Bool -- expand newtypes + -> TyBetaRedEnv gm + -> Ty + -> Ty +tyCanonicFFI' expNewtype renv + = tbroutRes . tyCanonic' opts + where opts = emptyTyCanonicOpts + {tcoTyBetaRedFullMb = tyBetaRedFullMb renv canonLkupTy' (tyCanonicMb' opts)} + canonLkupTy' renv nm = -- tr "tyCanonicFFI" (pp nm) $ + newtypeLamLkup <|> canonLkupTy renv nm + where newtypeLamLkup | not expNewtype = Nothing + | ehcOptBuiltin ehcopts ehbnIO == nm + = Nothing + | otherwise = fmap mkDfltTyCanonicOut (dgiMbNewtype $? dataGamLookup nm $ feDataGam fe) + fe = fiEnv fi + fi = tbredFI renv + ehcopts = feEHCOpts fe + + + +tyCanonicFFI + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm + -> Ty + -> Ty +tyCanonicFFI = tyCanonicFFI' False + + + +predCanonic + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + => TyBetaRedEnv gm -> Pred + -> (Pred,VarMp) +predCanonic renv + = predCanonic' opts + where opts = emptyTyCanonicOpts + {tcoTyBetaRedFullMb = tyBetaRedFullMb renv canonLkupTy (tyCanonicMb' opts)} + + + +canonLkupTy :: TyBetaRedLkup gm +canonLkupTy = betaRedTyLookup + + + +type MbPredL = Maybe [Pred] + +mbPredLCmb :: MbPredL -> MbPredL -> MbPredL +mbPredLCmb Nothing Nothing = Nothing +mbPredLCmb m1 m2 = Just $ concat $ maybeToList m1 ++ maybeToList m2 + + + +extr :: TyCanonicOut -> (Ty,VarMp) +extr o = (tbroutRes o, tbroutVarMp o) + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + isRow : Bool + opts : TyCanonicOpts + tyCtxt : TyQuCtxt + chained attribute: + varMp : VarMp + synthesized attributes: + isReplaced : Bool + mbPredL : MbPredL + repl : Impls + self : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local repl : _ + local self : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local repl : _ + local self : _ + alternative Nil: + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = Bool -> + Bool -> + TyCanonicOpts -> + TyQuCtxt -> + VarMp -> + ( Bool,MbPredL,Impls,Impls,VarMp) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Just []) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Impls_Tail iv_ proveOccs_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Impls_Tail iv_ proveOccs_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (varmpImplsUnit iv_ Impls_Nil `varUpd` _lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _prOopts | _prOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _prOvarMp | _prOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _prOtyCtxt | _prOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _prOisRow | _prOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _prOisAtTop | _prOisAtTop `seq` (True) -> + (case (pr_ _prOisAtTop _prOisRow _prOopts _prOtyCtxt _prOvarMp) of + { ( _prIisReplaced,_prImbPredL,_prIrepl,_prIself,_prIvarMp) | True -> + (case (_prIvarMp) of + { _tlOvarMp | _tlOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt | _tlOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tlOisRow | _tlOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tlOisAtTop | _tlOisAtTop `seq` (True) -> + (case (tl_ _tlOisAtTop _tlOisRow _tlOopts _tlOtyCtxt _tlOvarMp) of + { ( _tlIisReplaced,_tlImbPredL,_tlIrepl,_tlIself,_tlIvarMp) | True -> + (case (_prIisReplaced || _tlIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_prImbPredL `mbPredLCmb` _tlImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Impls_Cons iv_ _prIrepl pv_ prange_ proveOccs_ _tlIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Impls_Cons iv_ _prIself pv_ prange_ proveOccs_ _tlIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tlIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Nothing) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Impls_Nil) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Impls_Nil) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + isReplaced : Bool + repl : Label + self : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local repl : _ + local self : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( Bool,Label,Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Label_Lab nm_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Label_Lab nm_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Label_Var lv_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Label_Var lv_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + isRow : Bool + opts : TyCanonicOpts + tyCtxt : TyQuCtxt + chained attribute: + varMp : VarMp + synthesized attributes: + isReplaced : Bool + mbPredL : MbPredL + repl : Pred + self : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ + alternative Pred: + child ty : Ty + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local repl : _ + local self : _ + alternative Preds: + child seq : PredSeq + visit 0: + local appSpinePos : _ + local repl : _ + local self : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = Bool -> + Bool -> + TyCanonicOpts -> + TyQuCtxt -> + VarMp -> + ( Bool,MbPredL,Pred,Pred,VarMp) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Class _tyIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Class _tyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Pred _tyIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Pred _tyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (lab_) of + { ( _labIisReplaced,_labIrepl,_labIself) | True -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIisReplaced || _labIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Lacks _tyIrepl _labIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Lacks _tyIself _labIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _resOopts | _resOopts `seq` (True) -> + (case (_lhsIopts) of + { _argsOopts | _argsOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _argsOvarMp | _argsOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _argsOtyCtxt | _argsOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _argsOisRow | _argsOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _argsOisAtTop | _argsOisAtTop `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _argsOappSpinePos | _argsOappSpinePos `seq` (True) -> + (case (args_ _argsOappSpinePos _argsOisAtTop _argsOisRow _argsOopts _argsOtyCtxt _argsOvarMp) of + { ( _argsIisReplaced,_argsIrepl,_argsIself,_argsIvarMp) | True -> + (case (_argsIvarMp) of + { _resOvarMp | _resOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _resOtyCtxt | _resOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _resOisRow | _resOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _resOisAtTop | _resOisAtTop `seq` (True) -> + (case (res_ _resOisAtTop _resOisRow _resOopts _resOtyCtxt _resOvarMp) of + { ( _resIisReplaced,_resImbPredL,_resIrepl,_resIself,_resIvarMp) | True -> + (case (_argsIisReplaced || _resIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Arrow _argsIrepl _resIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Arrow _argsIself _resIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_resIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tyROopts | _tyROopts `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _tyROappSpinePos | _tyROappSpinePos `seq` (True) -> + (case (_lhsIopts) of + { _tyLOopts | _tyLOopts `seq` (True) -> + (case (_appSpinePos) of + { _tyLOappSpinePos | _tyLOappSpinePos `seq` (True) -> + (case (tyR_) of + { ( _tyRIappFunNm,tyR_1) | True -> + (case (_lhsIvarMp) of + { _tyLOvarMp | _tyLOvarMp `seq` (True) -> + (case (tyL_) of + { ( _tyLIappFunNm,tyL_1) | True -> + (case (_lhsItyCtxt) of + { _tyLOtyCtxt | _tyLOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tyLOisRow | _tyLOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tyLOisAtTop | _tyLOisAtTop `seq` (True) -> + (case (tyL_1 _tyLOappSpinePos _tyLOisAtTop _tyLOisRow _tyLOopts _tyLOtyCtxt _tyLOvarMp) of + { ( _tyLIappArgReplL,_tyLIisArrow,_tyLIisPred,_tyLIisReplaced,_tyLImbPredL,_tyLIrepl,_tyLIself,_tyLIvarMp) | True -> + (case (_tyLIvarMp) of + { _tyROvarMp | _tyROvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tyROtyCtxt | _tyROtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tyROisRow | _tyROisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tyROisAtTop | _tyROisAtTop `seq` (True) -> + (case (tyR_1 _tyROappSpinePos _tyROisAtTop _tyROisRow _tyROopts _tyROtyCtxt _tyROvarMp) of + { ( _tyRIappArgReplL,_tyRIisArrow,_tyRIisPred,_tyRIisReplaced,_tyRImbPredL,_tyRIrepl,_tyRIself,_tyRIvarMp) | True -> + (case (_tyLIisReplaced || _tyRIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Eq _tyLIrepl _tyRIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Eq _tyLIself _tyRIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyRIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Var pv_) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Var pv_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _seqOopts | _seqOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _seqOvarMp | _seqOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _seqOtyCtxt | _seqOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _seqOisRow | _seqOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _seqOisAtTop | _seqOisAtTop `seq` (True) -> + (case (0) of + { _appSpinePos | _appSpinePos `seq` (True) -> + (case (_appSpinePos) of + { _seqOappSpinePos | _seqOappSpinePos `seq` (True) -> + (case (seq_ _seqOappSpinePos _seqOisAtTop _seqOisRow _seqOopts _seqOtyCtxt _seqOvarMp) of + { ( _seqIisReplaced,_seqIrepl,_seqIself,_seqIvarMp) | True -> + (case (_seqIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Pred_Preds _seqIrepl) of + { _repl | _repl `seq` (True) -> + (case (Just [_repl]) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Pred_Preds _seqIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_seqIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + isAtTop : Bool + isRow : Bool + opts : TyCanonicOpts + tyCtxt : TyQuCtxt + chained attribute: + varMp : VarMp + synthesized attributes: + isReplaced : Bool + repl : PredSeq + self : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local repl : _ + local self : _ + alternative Nil: + visit 0: + local repl : _ + local self : _ + alternative Var: + child av : {TyVarId} + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Int -> + Bool -> + Bool -> + TyCanonicOpts -> + TyQuCtxt -> + VarMp -> + ( Bool,PredSeq,PredSeq,VarMp) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tlOopts | _tlOopts `seq` (True) -> + (case (_lhsIopts) of + { _hdOopts | _hdOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _hdOvarMp | _hdOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _hdOtyCtxt | _hdOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _hdOisRow | _hdOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _hdOisAtTop | _hdOisAtTop `seq` (True) -> + (case (hd_ _hdOisAtTop _hdOisRow _hdOopts _hdOtyCtxt _hdOvarMp) of + { ( _hdIisReplaced,_hdImbPredL,_hdIrepl,_hdIself,_hdIvarMp) | True -> + (case (_hdIvarMp) of + { _tlOvarMp | _tlOvarMp `seq` (True) -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt | _tlOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _tlOisRow | _tlOisRow `seq` (True) -> + (case (_lhsIisAtTop) of + { _tlOisAtTop | _tlOisAtTop `seq` (True) -> + (case (_lhsIappSpinePos + 1) of + { _tlOappSpinePos | _tlOappSpinePos `seq` (True) -> + (case (tl_ _tlOappSpinePos _tlOisAtTop _tlOisRow _tlOopts _tlOtyCtxt _tlOvarMp) of + { ( _tlIisReplaced,_tlIrepl,_tlIself,_tlIvarMp) | True -> + (case (_hdIisReplaced || _tlIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (PredSeq_Cons _hdIrepl _tlIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (PredSeq_Cons _hdIself _tlIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tlIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (PredSeq_Nil) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (PredSeq_Nil) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (PredSeq_Var av_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (PredSeq_Var av_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + synthesized attribute: + appFunNm : HsName + visit 1: + inherited attributes: + appSpinePos : Int + isAtTop : Bool + isRow : Bool + opts : TyCanonicOpts + tyCtxt : TyQuCtxt + chained attribute: + varMp : VarMp + synthesized attributes: + appArgReplL : [Ty] + isArrow : Bool + isPred : Bool + isReplaced : Bool + mbPredL : MbPredL + repl : Ty + self : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 1: + local repl : _ + local mbRepl : _ + local isReplaced : _ + local _tup1 : _ + local self : _ + local replVarMp : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local appIsRec : {Bool} + local appIsLikeProd : {Bool} + local appIsArrow : {Bool} + local tyCtxt : _ + local isAtTop : _ + local isSpineRoot : {Bool} + local appIsSum : _ + local appIsRecOrSum : _ + local argIsRow : {Bool} + local appArgReplL : _ + local isArrowRoot : {Bool} + local isArrowArg : {Bool} + local repl : _ + local mbReplNoImplNil : _ + local replNoImplNil : _ + local mbRepl : _ + local isReplaced : _ + local _tup2 : _ + local self : _ + local replVarMp : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local isReplaced : _ + local self : _ + alternative Dbg: + child info : {String} + visit 1: + local repl : _ + local self : _ + alternative Any: + visit 1: + local repl : _ + local self : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 1: + local repl : _ + local self : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local repl : _ + local self : _ + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local appFunNm : {HsName} + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local repl : _ + local isSpineRoot : _ + local mbRepl : _ + local isReplaced : _ + local self : _ + alternative Pred: + child pr : Pred + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local repl : _ + local self : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local repl : _ + local self : _ + alternative Impls: + child impls : Impls + visit 1: + local tyCtxt : _ + local isRow : _ + local isAtTop : _ + local repl : _ + local self : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = ( HsName,T_Ty_1) +type T_Ty_1 = Int -> + Bool -> + Bool -> + TyCanonicOpts -> + TyQuCtxt -> + VarMp -> + ( ([Ty]),Bool,Bool,Bool,MbPredL,Ty,Ty,VarMp) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (case (nm_) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Con_1 :: T_Ty_1 + sem_Ty_Con_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (Ty_Con nm_) of + { _repl | _repl `seq` (True) -> + (case (tcoTyBetaRedFullMb _lhsIopts _repl) of + { _mbRepl | _mbRepl `seq` (True) -> + (case (isJust _mbRepl) of + { _isReplaced | _isReplaced `seq` (True) -> + (case (_isReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Nothing) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (maybe (_repl,emptyVarMp) extr _mbRepl) of + { __tup1 | __tup1 `seq` (True) -> + (case (__tup1) of + { (_lhsOrepl,_) | _lhsOrepl `seq` (True) -> + (case (Ty_Con nm_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (__tup1) of + { (_,_replVarMp) | _replVarMp `seq` (True) -> + (case (_replVarMp `varUpd` _lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Con_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (case (func_) of + { ( _funcIappFunNm,func_1) | True -> + (case (_funcIappFunNm) of + { _appFunNm | _appFunNm `seq` (True) -> + (case (_appFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_App_1 :: T_Ty_1 + sem_Ty_App_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _argOopts | _argOopts `seq` (True) -> + (case (_lhsIopts) of + { _funcOopts | _funcOopts `seq` (True) -> + (case (0) of + { _argOappSpinePos | _argOappSpinePos `seq` (True) -> + (case (arg_) of + { ( _argIappFunNm,arg_1) | True -> + (case (_lhsIvarMp) of + { _funcOvarMp | _funcOvarMp `seq` (True) -> + (case (_lhsIappSpinePos + 1) of + { _funcOappSpinePos | _funcOappSpinePos `seq` (True) -> + (case (hsnIsRec _funcIappFunNm) of + { _appIsRec | _appIsRec `seq` (True) -> + (case (hsnIsProd _funcIappFunNm || _appIsRec) of + { _appIsLikeProd | _appIsLikeProd `seq` (True) -> + (case (hsnIsArrow _funcIappFunNm) of + { _appIsArrow | _appIsArrow `seq` (True) -> + (case (if _appIsArrow then TyQuCtxtArrow + else if _appIsLikeProd then TyQuCtxtProd + else TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _funcOtyCtxt | _funcOtyCtxt `seq` (True) -> + (case (_lhsIisRow) of + { _funcOisRow | _funcOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _funcOisAtTop | _funcOisAtTop `seq` (True) -> + (case (func_1 _funcOappSpinePos _funcOisAtTop _funcOisRow _funcOopts _funcOtyCtxt _funcOvarMp) of + { ( _funcIappArgReplL,_funcIisArrow,_funcIisPred,_funcIisReplaced,_funcImbPredL,_funcIrepl,_funcIself,_funcIvarMp) | True -> + (case (_funcIvarMp) of + { _argOvarMp | _argOvarMp `seq` (True) -> + (case (_tyCtxt) of + { _argOtyCtxt | _argOtyCtxt `seq` (True) -> + (case (_isAtTop) of + { _argOisAtTop | _argOisAtTop `seq` (True) -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot | _isSpineRoot `seq` (True) -> + (case (hsnIsSum _funcIappFunNm) of + { _appIsSum | _appIsSum `seq` (True) -> + (case (_appIsRec || _appIsSum) of + { _appIsRecOrSum | _appIsRecOrSum `seq` (True) -> + (case (_isSpineRoot && _appIsRecOrSum) of + { _argIsRow | _argIsRow `seq` (True) -> + (case (_argIsRow) of + { _argOisRow | _argOisRow `seq` (True) -> + (case (arg_1 _argOappSpinePos _argOisAtTop _argOisRow _argOopts _argOtyCtxt _argOvarMp) of + { ( _argIappArgReplL,_argIisArrow,_argIisPred,_argIisReplaced,_argImbPredL,_argIrepl,_argIself,_argIvarMp) | True -> + (case (_argIrepl : _funcIappArgReplL) of + { _appArgReplL | _appArgReplL `seq` (True) -> + (case (_appArgReplL) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (_appIsArrow && _isSpineRoot) of + { _isArrowRoot | _isArrowRoot `seq` (True) -> + (case (_isArrowRoot) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (_appIsArrow && _lhsIappSpinePos == 1) of + { _isArrowArg | _isArrowArg `seq` (True) -> + (case (if _isArrowArg then _argIisPred else False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (Ty_App _funcIrepl _argIrepl) of + { _repl | _repl `seq` (True) -> + (case (let r = _argIrepl + in case _funcImbPredL of + Nothing | _funcIisPred -> Just r + Just [] | _funcIisPred -> Just r + _ + | otherwise -> Nothing) of + { _mbReplNoImplNil | _mbReplNoImplNil `seq` (True) -> + (case (maybe _repl id _mbReplNoImplNil) of + { _replNoImplNil | _replNoImplNil `seq` (True) -> + (case (if _isSpineRoot + then tcoTyBetaRedFullMb _lhsIopts _replNoImplNil + else Nothing) of + { _mbRepl | _mbRepl `seq` (True) -> + (case (isJust _mbReplNoImplNil || isJust _mbRepl) of + { _isReplaced | _isReplaced `seq` (True) -> + (case (_isReplaced || _funcIisReplaced || _argIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_funcImbPredL `mbPredLCmb` _argImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (maybe (_replNoImplNil,emptyVarMp) extr _mbRepl) of + { __tup2 | __tup2 `seq` (True) -> + (case (__tup2) of + { (_lhsOrepl,_) | _lhsOrepl `seq` (True) -> + (case (Ty_App _funcIself _argIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (__tup2) of + { (_,_replVarMp) | _replVarMp `seq` (True) -> + (case (_replVarMp `varUpd` _argIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_App_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Ann_1 :: T_Ty_1 + sem_Ty_Ann_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIappArgReplL) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (True) of + { _isReplaced | _isReplaced `seq` (True) -> + (case (_isReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_tyImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (_tyIrepl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (ann_) of + { ( _annIisReplaced,_annIrepl,_annIself) | True -> + (case (Ty_Ann _annIself _tyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ann_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Dbg_1 :: T_Ty_1 + sem_Ty_Dbg_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Nothing) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Dbg info_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Dbg info_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Dbg_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Any_1 :: T_Ty_1 + sem_Ty_Any_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Nothing) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Any) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Any) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Any_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Var_1 :: T_Ty_1 + sem_Ty_Var_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (categ_) of + { ( _categIisReplaced,_categIrepl,_categIself) | True -> + (case (_categIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (Nothing) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Var tv_ _categIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Var tv_ _categIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_lhsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Var_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_TBind_1 :: T_Ty_1 + sem_Ty_TBind_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (qu_) of + { ( _quIisReplaced,_quIrepl,_quIself) | True -> + (case (_quIisReplaced || _tyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_tyImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_TBind _quIrepl tv_ l1_ _tyIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_TBind _quIself tv_ l1_ _tyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_TBind_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_tyIappFunNm) of + { _appFunNm | _appFunNm `seq` (True) -> + (case (_appFunNm) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Ext_1 :: T_Ty_1 + sem_Ty_Ext_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (_lhsIopts) of + { _extTyOopts | _extTyOopts `seq` (True) -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _extTyOappSpinePos | _extTyOappSpinePos `seq` (True) -> + (case (_lhsIappSpinePos + 1) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (extTy_) of + { ( _extTyIappFunNm,extTy_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIvarMp) of + { _extTyOvarMp | _extTyOvarMp `seq` (True) -> + (case (_tyCtxt) of + { _extTyOtyCtxt | _extTyOtyCtxt `seq` (True) -> + (case (_isRow) of + { _extTyOisRow | _extTyOisRow `seq` (True) -> + (case (_isAtTop) of + { _extTyOisAtTop | _extTyOisAtTop `seq` (True) -> + (case (extTy_1 _extTyOappSpinePos _extTyOisAtTop _extTyOisRow _extTyOopts _extTyOtyCtxt _extTyOvarMp) of + { ( _extTyIappArgReplL,_extTyIisArrow,_extTyIisPred,_extTyIisReplaced,_extTyImbPredL,_extTyIrepl,_extTyIself,_extTyIvarMp) | True -> + (case (Ty_Ext _tyIrepl nm_ _extTyIrepl) of + { _repl | _repl `seq` (True) -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot | _isSpineRoot `seq` (True) -> + (case (if _isSpineRoot + then let (row,exts) = tyRowExtsUnAnn $ recUnRowExts _repl + in if tyRowIsCanonOrdered exts + then Nothing + else Just $ mkDfltTyCanonicOut $ recRow row $ rowCanonOrder exts + else Nothing) of + { _mbRepl | _mbRepl `seq` (True) -> + (case (isJust _mbRepl) of + { _isReplaced | _isReplaced `seq` (True) -> + (case (_isReplaced || _tyIisReplaced || _extTyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_tyImbPredL `mbPredLCmb` _extTyImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (maybe _repl tbroutRes _mbRepl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Ext _tyIself nm_ _extTyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_extTyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ext_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) }) }) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Pred_1 :: T_Ty_1 + sem_Ty_Pred_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (True) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (_lhsIopts) of + { _prOopts | _prOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _prOvarMp | _prOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _prOtyCtxt | _prOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _prOisRow | _prOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _prOisAtTop | _prOisAtTop `seq` (True) -> + (case (pr_ _prOisAtTop _prOisRow _prOopts _prOtyCtxt _prOvarMp) of + { ( _prIisReplaced,_prImbPredL,_prIrepl,_prIself,_prIvarMp) | True -> + (case (_prIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_prImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Pred _prIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Pred _prIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_prIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Pred_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Lam_1 :: T_Ty_1 + sem_Ty_Lam_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (False) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (_lhsIvarMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_tyImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Lam tv_ _tyIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Lam tv_ _tyIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_tyIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Lam_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (case (hsnUnknown) of + { _lhsOappFunNm | _lhsOappFunNm `seq` (True) -> + (case ((let sem_Ty_Impls_1 :: T_Ty_1 + sem_Ty_Impls_1 = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIisRow + _lhsIopts + _lhsItyCtxt + _lhsIvarMp -> + (case ([]) of + { _lhsOappArgReplL | _lhsOappArgReplL `seq` (True) -> + (case (False) of + { _lhsOisArrow | _lhsOisArrow `seq` (True) -> + (case (True) of + { _lhsOisPred | _lhsOisPred `seq` (True) -> + (case (_lhsIopts) of + { _implsOopts | _implsOopts `seq` (True) -> + (case (_lhsIvarMp) of + { _implsOvarMp | _implsOvarMp `seq` (True) -> + (case (TyQuCtxtOther) of + { _tyCtxt | _tyCtxt `seq` (True) -> + (case (_tyCtxt) of + { _implsOtyCtxt | _implsOtyCtxt `seq` (True) -> + (case (False) of + { _isRow | _isRow `seq` (True) -> + (case (_isRow) of + { _implsOisRow | _implsOisRow `seq` (True) -> + (case (False) of + { _isAtTop | _isAtTop `seq` (True) -> + (case (_isAtTop) of + { _implsOisAtTop | _implsOisAtTop `seq` (True) -> + (case (impls_ _implsOisAtTop _implsOisRow _implsOopts _implsOtyCtxt _implsOvarMp) of + { ( _implsIisReplaced,_implsImbPredL,_implsIrepl,_implsIself,_implsIvarMp) | True -> + (case (_implsIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_implsImbPredL) of + { _lhsOmbPredL | _lhsOmbPredL `seq` (True) -> + (case (Ty_Impls _implsIrepl) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (Ty_Impls _implsIself) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + (case (_implsIvarMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOappArgReplL,_lhsOisArrow,_lhsOisPred,_lhsOisReplaced,_lhsOmbPredL,_lhsOrepl,_lhsOself,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Impls_1)) of + { ( sem_Ty_1) | True -> + ( _lhsOappFunNm,sem_Ty_1) }) }) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + opts : TyCanonicOpts + synthesized attributes: + isReplaced : Bool + repl : Ty + varMp : VarMp + alternatives: + alternative AGItf: + child ty : Ty + visit 0: + local varMp : _ +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = TyCanonicOpts -> + ( Bool,Ty,VarMp) +data Inh_TyAGItf = Inh_TyAGItf {opts_Inh_TyAGItf :: !(TyCanonicOpts)} +data Syn_TyAGItf = Syn_TyAGItf {isReplaced_Syn_TyAGItf :: !(Bool),repl_Syn_TyAGItf :: !(Ty),varMp_Syn_TyAGItf :: !(VarMp)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIopts) = + (let ( _lhsOisReplaced,_lhsOrepl,_lhsOvarMp) | True = sem _lhsIopts + in (Syn_TyAGItf _lhsOisReplaced _lhsOrepl _lhsOvarMp)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIopts -> + (case (_lhsIopts) of + { _tyOopts | _tyOopts `seq` (True) -> + (case (0) of + { _tyOappSpinePos | _tyOappSpinePos `seq` (True) -> + (case (ty_) of + { ( _tyIappFunNm,ty_1) | True -> + (case (emptyVarMp) of + { _varMp | _varMp `seq` (True) -> + (case (_varMp) of + { _tyOvarMp | _tyOvarMp `seq` (True) -> + (case (TyQuCtxtOnTop) of + { _tyOtyCtxt | _tyOtyCtxt `seq` (True) -> + (case (False) of + { _tyOisRow | _tyOisRow `seq` (True) -> + (case (True) of + { _tyOisAtTop | _tyOisAtTop `seq` (True) -> + (case (ty_1 _tyOappSpinePos _tyOisAtTop _tyOisRow _tyOopts _tyOtyCtxt _tyOvarMp) of + { ( _tyIappArgReplL,_tyIisArrow,_tyIisPred,_tyIisReplaced,_tyImbPredL,_tyIrepl,_tyIself,_tyIvarMp) | True -> + (case (_tyIisReplaced) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (_tyIrepl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (_varMp) of + { _lhsOvarMp | _lhsOvarMp `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOvarMp) }) }) }) }) }) }) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + isReplaced : Bool + repl : TyAnn + self : TyAnn + alternatives: + alternative Empty: + visit 0: + local repl : _ + local self : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local repl : _ + local self : _ + alternative Mono: + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( Bool,TyAnn,TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyAnn_Empty) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyAnn_Empty) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyAnn_Strictness s_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyAnn_Strictness s_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyAnn_Mono) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyAnn_Mono) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +-- TyQu -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + isReplaced : Bool + repl : TyQu + self : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local repl : _ + local self : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local repl : _ + local self : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( Bool,TyQu,TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyQu_Forall mlev_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyQu_Forall mlev_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyQu_Exists mlev_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyQu_Exists mlev_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyQu_Plain mlev_) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyQu_Plain mlev_) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attributes: + isReplaced : Bool + repl : TyVarCateg + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local repl : _ + local self : _ + alternative Fixed: + visit 0: + local repl : _ + local self : _ + alternative Meta: + visit 0: + local repl : _ + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( Bool,TyVarCateg,TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyVarCateg_Plain) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyVarCateg_Plain) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyVarCateg_Fixed) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyVarCateg_Fixed) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (case (False) of + { _lhsOisReplaced | _lhsOisReplaced `seq` (True) -> + (case (TyVarCateg_Meta) of + { _repl | _repl `seq` (True) -> + (case (_repl) of + { _lhsOrepl | _lhsOrepl `seq` (True) -> + (case (TyVarCateg_Meta) of + { _self | _self `seq` (True) -> + (case (_self) of + { _lhsOself | _lhsOself `seq` (True) -> + ( _lhsOisReplaced,_lhsOrepl,_lhsOself) }) }) }) }) }) diff --git a/src/UHC/Light/Compiler/Ty/Trf/FreshVar.hs b/src/UHC/Light/Compiler/Ty/Trf/FreshVar.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/FreshVar.hs @@ -0,0 +1,1153 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/FreshVa) +module UHC.Light.Compiler.Ty.Trf.FreshVar(tyFreshVar) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + +tyFreshVar' :: (TyVarId -> Bool) -> UID -> VarMp -> Ty -> (Ty,VarMp) +tyFreshVar' allowFresh uniq tvVarMp ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf {tvVarMp_Inh_TyAGItf = tvVarMp, allowFresh_Inh_TyAGItf = allowFresh, gUniq_Inh_TyAGItf = uniq}) + in (repl_Syn_TyAGItf t,tvVarMp_Syn_TyAGItf t) + +tyFreshVar :: (TyVarId -> Bool) -> UID -> Ty -> Ty +tyFreshVar allowFresh uniq ty = fst $ tyFreshVar' allowFresh uniq emptyVarMp ty + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + chained attributes: + gUniq : UID + tvVarMp : VarMp + synthesized attribute: + repl : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local repl : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = (TyVarId -> Bool) -> + UID -> + VarMp -> + ( UID,Impls,VarMp) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Impls_Tail iv_ proveOccs_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _prOgUniq -> + (case (_lhsItvVarMp) of + { _prOtvVarMp -> + (case (_lhsIallowFresh) of + { _prOallowFresh -> + (case (pr_ _prOallowFresh _prOgUniq _prOtvVarMp) of + { ( _prIgUniq,_prIrepl,_prItvVarMp) -> + (case (_prIgUniq) of + { _tlOgUniq -> + (case (_prItvVarMp) of + { _tlOtvVarMp -> + (case (_lhsIallowFresh) of + { _tlOallowFresh -> + (case (tl_ _tlOallowFresh _tlOgUniq _tlOtvVarMp) of + { ( _tlIgUniq,_tlIrepl,_tlItvVarMp) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (Impls_Cons iv_ _prIrepl pv_ prange_ proveOccs_ _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tlItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Impls_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + synthesized attribute: + repl : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local repl : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local repl : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = (TyVarId -> Bool) -> + ( Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (\ _lhsIallowFresh -> + (case (Label_Lab nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (\ _lhsIallowFresh -> + (case (Label_Var lv_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + chained attributes: + gUniq : UID + tvVarMp : VarMp + synthesized attribute: + repl : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local repl : _ + alternative Pred: + child ty : Ty + visit 0: + local repl : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local repl : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local repl : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local repl : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local repl : _ + alternative Preds: + child seq : PredSeq + visit 0: + local repl : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = (TyVarId -> Bool) -> + UID -> + VarMp -> + ( UID,Pred,VarMp) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (Pred_Class _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (Pred_Pred _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_lhsIallowFresh) of + { _labOallowFresh -> + (case (lab_ _labOallowFresh) of + { ( _labIrepl) -> + (case (Pred_Lacks _tyIrepl _labIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _argsOgUniq -> + (case (_lhsItvVarMp) of + { _argsOtvVarMp -> + (case (_lhsIallowFresh) of + { _argsOallowFresh -> + (case (args_ _argsOallowFresh _argsOgUniq _argsOtvVarMp) of + { ( _argsIgUniq,_argsIrepl,_argsItvVarMp) -> + (case (_argsIgUniq) of + { _resOgUniq -> + (case (_argsItvVarMp) of + { _resOtvVarMp -> + (case (_lhsIallowFresh) of + { _resOallowFresh -> + (case (res_ _resOallowFresh _resOgUniq _resOtvVarMp) of + { ( _resIgUniq,_resIrepl,_resItvVarMp) -> + (case (_resIgUniq) of + { _lhsOgUniq -> + (case (Pred_Arrow _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_resItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyLOgUniq -> + (case (_lhsItvVarMp) of + { _tyLOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyLOallowFresh -> + (case (tyL_ _tyLOallowFresh _tyLOgUniq _tyLOtvVarMp) of + { ( _tyLIgUniq,_tyLIrepl,_tyLItvVarMp) -> + (case (_tyLIgUniq) of + { _tyROgUniq -> + (case (_tyLItvVarMp) of + { _tyROtvVarMp -> + (case (_lhsIallowFresh) of + { _tyROallowFresh -> + (case (tyR_ _tyROallowFresh _tyROgUniq _tyROtvVarMp) of + { ( _tyRIgUniq,_tyRIrepl,_tyRItvVarMp) -> + (case (_tyRIgUniq) of + { _lhsOgUniq -> + (case (Pred_Eq _tyLIrepl _tyRIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyRItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Pred_Var pv_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _seqOgUniq -> + (case (_lhsItvVarMp) of + { _seqOtvVarMp -> + (case (_lhsIallowFresh) of + { _seqOallowFresh -> + (case (seq_ _seqOallowFresh _seqOgUniq _seqOtvVarMp) of + { ( _seqIgUniq,_seqIrepl,_seqItvVarMp) -> + (case (_seqIgUniq) of + { _lhsOgUniq -> + (case (Pred_Preds _seqIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_seqItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + chained attributes: + gUniq : UID + tvVarMp : VarMp + synthesized attribute: + repl : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ + alternative Var: + child av : {TyVarId} + visit 0: + local repl : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = (TyVarId -> Bool) -> + UID -> + VarMp -> + ( UID,PredSeq,VarMp) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsItvVarMp) of + { _hdOtvVarMp -> + (case (_lhsIallowFresh) of + { _hdOallowFresh -> + (case (hd_ _hdOallowFresh _hdOgUniq _hdOtvVarMp) of + { ( _hdIgUniq,_hdIrepl,_hdItvVarMp) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_hdItvVarMp) of + { _tlOtvVarMp -> + (case (_lhsIallowFresh) of + { _tlOallowFresh -> + (case (tl_ _tlOallowFresh _tlOgUniq _tlOtvVarMp) of + { ( _tlIgUniq,_tlIrepl,_tlItvVarMp) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (PredSeq_Cons _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tlItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (PredSeq_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (PredSeq_Var av_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + chained attributes: + gUniq : UID + tvVarMp : VarMp + synthesized attribute: + repl : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 0: + local repl : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local repl : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 0: + local repl : _ + alternative Dbg: + child info : {String} + visit 0: + local repl : _ + alternative Any: + visit 0: + local repl : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 0: + local _tup1 : _ + local repl : _ + local lUniq : _ + local _tup2 : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 0: + local repl : _ + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local repl : _ + alternative Pred: + child pr : Pred + visit 0: + local repl : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 0: + local repl : _ + alternative Impls: + child impls : Impls + visit 0: + local repl : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = (TyVarId -> Bool) -> + UID -> + VarMp -> + ( UID,Ty,VarMp) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Ty_Con nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _funcOgUniq -> + (case (_lhsItvVarMp) of + { _funcOtvVarMp -> + (case (_lhsIallowFresh) of + { _funcOallowFresh -> + (case (func_ _funcOallowFresh _funcOgUniq _funcOtvVarMp) of + { ( _funcIgUniq,_funcIrepl,_funcItvVarMp) -> + (case (_funcIgUniq) of + { _argOgUniq -> + (case (_funcItvVarMp) of + { _argOtvVarMp -> + (case (_lhsIallowFresh) of + { _argOallowFresh -> + (case (arg_ _argOallowFresh _argOgUniq _argOtvVarMp) of + { ( _argIgUniq,_argIrepl,_argItvVarMp) -> + (case (_argIgUniq) of + { _lhsOgUniq -> + (case (Ty_App _funcIrepl _argIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_argItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_lhsIallowFresh) of + { _annOallowFresh -> + (case (ann_ _annOallowFresh) of + { ( _annIrepl) -> + (case (Ty_Ann _annIrepl _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Ty_Dbg info_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (Ty_Any) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_lhsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) })) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (mkNewUID _lhsIgUniq) of + { __tup1 -> + (case (__tup1) of + { (_lhsOgUniq,_) -> + (case (_lhsIallowFresh) of + { _categOallowFresh -> + (case (categ_ _categOallowFresh) of + { ( _categIrepl) -> + (case (Ty_Var tv_ _categIrepl) of + { _repl -> + (case (__tup1) of + { (_,_lUniq) -> + (case (if _lhsIallowFresh tv_ + then case varmpTyLookup tv_ _lhsItvVarMp of + Just t -> (t,_lhsItvVarMp) + Nothing -> (t,(tv_ `varmpTyUnit` t) `varUpd` _lhsItvVarMp) + where t = Ty_Var _lUniq _categIrepl + else (_repl,_lhsItvVarMp)) of + { __tup2 -> + (case (__tup2) of + { (_lhsOrepl,_) -> + (case (__tup2) of + { (_,_lhsOtvVarMp) -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) })) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (\v -> v /= tv_ && _lhsIallowFresh v) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_lhsIallowFresh) of + { _quOallowFresh -> + (case (qu_ _quOallowFresh) of + { ( _quIrepl) -> + (case (Ty_TBind _quIrepl tv_ l1_ _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _extTyOgUniq -> + (case (_tyItvVarMp) of + { _extTyOtvVarMp -> + (case (_lhsIallowFresh) of + { _extTyOallowFresh -> + (case (extTy_ _extTyOallowFresh _extTyOgUniq _extTyOtvVarMp) of + { ( _extTyIgUniq,_extTyIrepl,_extTyItvVarMp) -> + (case (_extTyIgUniq) of + { _lhsOgUniq -> + (case (Ty_Ext _tyIrepl nm_ _extTyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_extTyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _prOgUniq -> + (case (_lhsItvVarMp) of + { _prOtvVarMp -> + (case (_lhsIallowFresh) of + { _prOallowFresh -> + (case (pr_ _prOallowFresh _prOgUniq _prOtvVarMp) of + { ( _prIgUniq,_prIrepl,_prItvVarMp) -> + (case (_prIgUniq) of + { _lhsOgUniq -> + (case (Ty_Pred _prIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_prItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (Ty_Lam tv_ _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsIgUniq) of + { _implsOgUniq -> + (case (_lhsItvVarMp) of + { _implsOtvVarMp -> + (case (_lhsIallowFresh) of + { _implsOallowFresh -> + (case (impls_ _implsOallowFresh _implsOgUniq _implsOtvVarMp) of + { ( _implsIgUniq,_implsIrepl,_implsItvVarMp) -> + (case (_implsIgUniq) of + { _lhsOgUniq -> + (case (Ty_Impls _implsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_implsItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOgUniq,_lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allowFresh : TyVarId -> Bool + gUniq : UID + chained attribute: + tvVarMp : VarMp + synthesized attribute: + repl : Ty + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = (TyVarId -> Bool) -> + UID -> + VarMp -> + ( Ty,VarMp) +data Inh_TyAGItf = Inh_TyAGItf {allowFresh_Inh_TyAGItf :: !((TyVarId -> Bool)),gUniq_Inh_TyAGItf :: !(UID),tvVarMp_Inh_TyAGItf :: !(VarMp)} +data Syn_TyAGItf = Syn_TyAGItf {repl_Syn_TyAGItf :: !(Ty),tvVarMp_Syn_TyAGItf :: !(VarMp)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIallowFresh _lhsIgUniq _lhsItvVarMp) = + (let ( _lhsOrepl,_lhsOtvVarMp) = sem _lhsIallowFresh _lhsIgUniq _lhsItvVarMp + in (Syn_TyAGItf _lhsOrepl _lhsOtvVarMp)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIallowFresh + _lhsIgUniq + _lhsItvVarMp -> + (case (_lhsItvVarMp) of + { _tyOtvVarMp -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIallowFresh) of + { _tyOallowFresh -> + (case (ty_ _tyOallowFresh _tyOgUniq _tyOtvVarMp) of + { ( _tyIgUniq,_tyIrepl,_tyItvVarMp) -> + (case (_tyIrepl) of + { _lhsOrepl -> + (case (_tyItvVarMp) of + { _lhsOtvVarMp -> + ( _lhsOrepl,_lhsOtvVarMp) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + synthesized attribute: + repl : TyAnn + alternatives: + alternative Empty: + visit 0: + local repl : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local repl : _ + alternative Mono: + visit 0: + local repl : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = (TyVarId -> Bool) -> + ( TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (\ _lhsIallowFresh -> + (case (TyAnn_Empty) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (\ _lhsIallowFresh -> + (case (TyAnn_Strictness s_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (\ _lhsIallowFresh -> + (case (TyAnn_Mono) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- TyQu -------------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + synthesized attribute: + repl : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local repl : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = (TyVarId -> Bool) -> + ( TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (\ _lhsIallowFresh -> + (case (TyQu_Forall mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (\ _lhsIallowFresh -> + (case (TyQu_Exists mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (\ _lhsIallowFresh -> + (case (TyQu_Plain mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + inherited attribute: + allowFresh : TyVarId -> Bool + synthesized attribute: + repl : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local repl : _ + alternative Fixed: + visit 0: + local repl : _ + alternative Meta: + visit 0: + local repl : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = (TyVarId -> Bool) -> + ( TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (\ _lhsIallowFresh -> + (case (TyVarCateg_Plain) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (\ _lhsIallowFresh -> + (case (TyVarCateg_Fixed) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (\ _lhsIallowFresh -> + (case (TyVarCateg_Meta) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) diff --git a/src/UHC/Light/Compiler/Ty/Trf/Instantiate.hs b/src/UHC/Light/Compiler/Ty/Trf/Instantiate.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/Instantiate.hs @@ -0,0 +1,1742 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/Instant) +module UHC.Light.Compiler.Ty.Trf.Instantiate(tyInst1Quants, tyInst1Exists, instCoConst, instContra, instCo +, tyInstToL) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import Data.List +import qualified Data.Set as Set + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + + + + + +tyInst :: UID -> Bool -> HowToInst -> Ty -> (Ty,TyVarIdL,[InstTo]) +tyInst uniq onlyExists howToInst ty + = (repl_Syn_TyAGItf t, replTvL_Syn_TyAGItf t, instToL_Syn_TyAGItf t) + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf + { gUniq_Inh_TyAGItf = uniq + , onlyExists_Inh_TyAGItf = onlyExists + , howToInst_Inh_TyAGItf = howToInst + }) + +tyInst1Quants :: UID -> HowToInst -> Ty -> (Ty,TyVarIdL,[InstTo]) +tyInst1Quants uniq howToInst ty = tyInst uniq False howToInst ty + + + +-- | Instantiate, with the purpose of obtaining [InstTo] only +tyInstToL :: Ty -> [InstTo] +tyInstToL ty + = il + where (_,_,il) = tyInst1Quants uidStart instCoConst ty + + + +tyInst1Exists :: UID -> Ty -> Ty +tyInst1Exists uniq ty + = t + where (t,_,_) = tyInst uniq True instCoConst ty + + + +type HowToInst = TyQu -> TyVarId -> Ty + +instCoConst, instContra, instCo :: HowToInst +instCoConst q v = if tyquIsForall q then Ty_Var v TyVarCateg_Plain else appCon (mkHNm $ "C_" ++ show v) +instContra q v = if tyquIsForall q then Ty_Var v TyVarCateg_Fixed else Ty_Var v TyVarCateg_Plain +instCo q v = if tyquIsForall q then Ty_Var v TyVarCateg_Plain else Ty_Var v TyVarCateg_Fixed + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + allow : Bool + howToInst : HowToInst + mbQ : Maybe TyQu + onlyExists : Bool + chained attributes: + gUniq : UID + gathSubst : VarMp + visit 1: + inherited attribute: + replSubst : VarMp + synthesized attribute: + repl : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 1: + local repl : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 1: + local repl : _ + alternative Nil: + visit 1: + local repl : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = Bool -> + UID -> + VarMp -> + HowToInst -> + (Maybe TyQu) -> + Bool -> + ( UID,VarMp,T_Impls_1) +type T_Impls_1 = VarMp -> + ( Impls) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Impls_Tail_1 :: T_Impls_1 + sem_Impls_Tail_1 = + (\ _lhsIreplSubst -> + (case (Impls_Tail iv_ proveOccs_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) + in sem_Impls_Tail_1)) of + { ( sem_Impls_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Impls_1) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _prOgUniq -> + (case (_lhsIonlyExists) of + { _prOonlyExists -> + (case (_lhsImbQ) of + { _prOmbQ -> + (case (_lhsIhowToInst) of + { _prOhowToInst -> + (case (_lhsIgathSubst) of + { _prOgathSubst -> + (case (_lhsIallow) of + { _prOallow -> + (case (pr_ _prOallow _prOgUniq _prOgathSubst _prOhowToInst _prOmbQ _prOonlyExists) of + { ( _prIgUniq,_prIgathSubst,pr_1) -> + (case (_prIgUniq) of + { _tlOgUniq -> + (case (_lhsIonlyExists) of + { _tlOonlyExists -> + (case (_lhsImbQ) of + { _tlOmbQ -> + (case (_lhsIhowToInst) of + { _tlOhowToInst -> + (case (_prIgathSubst) of + { _tlOgathSubst -> + (case (_lhsIallow) of + { _tlOallow -> + (case (tl_ _tlOallow _tlOgUniq _tlOgathSubst _tlOhowToInst _tlOmbQ _tlOonlyExists) of + { ( _tlIgUniq,_tlIgathSubst,tl_1) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_tlIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Impls_Cons_1 :: T_Impls_1 + sem_Impls_Cons_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tlOreplSubst -> + (case (_lhsIreplSubst) of + { _prOreplSubst -> + (case (tl_1 _tlOreplSubst) of + { ( _tlIrepl) -> + (case (pr_1 _prOreplSubst) of + { ( _prIrepl) -> + (case (Impls_Cons iv_ _prIrepl pv_ prange_ proveOccs_ _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) + in sem_Impls_Cons_1)) of + { ( sem_Impls_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Impls_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Impls_Nil_1 :: T_Impls_1 + sem_Impls_Nil_1 = + (\ _lhsIreplSubst -> + (case (Impls_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) + in sem_Impls_Nil_1)) of + { ( sem_Impls_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Impls_1) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + repl : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local repl : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local repl : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (case (Label_Lab nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (case (Label_Var lv_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + allow : Bool + howToInst : HowToInst + mbQ : Maybe TyQu + onlyExists : Bool + chained attributes: + gUniq : UID + gathSubst : VarMp + visit 1: + inherited attribute: + replSubst : VarMp + synthesized attribute: + repl : Pred + alternatives: + alternative Class: + child ty : Ty + visit 1: + local repl : _ + alternative Pred: + child ty : Ty + visit 1: + local repl : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 1: + local repl : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 1: + local repl : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 1: + local repl : _ + alternative Var: + child pv : {TyVarId} + visit 1: + local repl : _ + alternative Preds: + child seq : PredSeq + visit 1: + local repl : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = Bool -> + UID -> + VarMp -> + HowToInst -> + (Maybe TyQu) -> + Bool -> + ( UID,VarMp,T_Pred_1) +type T_Pred_1 = VarMp -> + ( Pred) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (_lhsIallow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Class_1 :: T_Pred_1 + sem_Pred_Class_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (Pred_Class _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) + in sem_Pred_Class_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (_lhsIallow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Pred_1 :: T_Pred_1 + sem_Pred_Pred_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (Pred_Pred _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) + in sem_Pred_Pred_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (_lhsIallow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Lacks_1 :: T_Pred_1 + sem_Pred_Lacks_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (lab_) of + { ( _labIrepl) -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (Pred_Lacks _tyIrepl _labIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) })) + in sem_Pred_Lacks_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _argsOgUniq -> + (case (_lhsIonlyExists) of + { _argsOonlyExists -> + (case (_lhsImbQ) of + { _argsOmbQ -> + (case (_lhsIhowToInst) of + { _argsOhowToInst -> + (case (_lhsIgathSubst) of + { _argsOgathSubst -> + (case (_lhsIallow) of + { _argsOallow -> + (case (args_ _argsOallow _argsOgUniq _argsOgathSubst _argsOhowToInst _argsOmbQ _argsOonlyExists) of + { ( _argsIgUniq,_argsIgathSubst,args_1) -> + (case (_argsIgUniq) of + { _resOgUniq -> + (case (_lhsIonlyExists) of + { _resOonlyExists -> + (case (_lhsImbQ) of + { _resOmbQ -> + (case (_lhsIhowToInst) of + { _resOhowToInst -> + (case (_argsIgathSubst) of + { _resOgathSubst -> + (case (_lhsIallow) of + { _resOallow -> + (case (res_ _resOallow _resOgUniq _resOgathSubst _resOhowToInst _resOmbQ _resOonlyExists) of + { ( _resIgUniq,_resIgathSubst,res_1) -> + (case (_resIgUniq) of + { _lhsOgUniq -> + (case (_resIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Arrow_1 :: T_Pred_1 + sem_Pred_Arrow_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _resOreplSubst -> + (case (_lhsIreplSubst) of + { _argsOreplSubst -> + (case (res_1 _resOreplSubst) of + { ( _resIrepl) -> + (case (args_1 _argsOreplSubst) of + { ( _argsIrepl) -> + (case (Pred_Arrow _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) + in sem_Pred_Arrow_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyLOgUniq -> + (case (_lhsIonlyExists) of + { _tyLOonlyExists -> + (case (_lhsImbQ) of + { _tyLOmbQ -> + (case (_lhsIhowToInst) of + { _tyLOhowToInst -> + (case (_lhsIgathSubst) of + { _tyLOgathSubst -> + (case (_lhsIallow) of + { _tyLOallow -> + (case (tyL_ _tyLOallow _tyLOgUniq _tyLOgathSubst _tyLOhowToInst _tyLOmbQ _tyLOonlyExists) of + { ( _tyLIgUniq,_tyLIgathSubst,tyL_1) -> + (case (_tyLIgUniq) of + { _tyROgUniq -> + (case (_lhsIonlyExists) of + { _tyROonlyExists -> + (case (_lhsImbQ) of + { _tyROmbQ -> + (case (_lhsIhowToInst) of + { _tyROhowToInst -> + (case (_tyLIgathSubst) of + { _tyROgathSubst -> + (case (_lhsIallow) of + { _tyROallow -> + (case (tyR_ _tyROallow _tyROgUniq _tyROgathSubst _tyROhowToInst _tyROmbQ _tyROonlyExists) of + { ( _tyRIgUniq,_tyRIgathSubst,tyR_1) -> + (case (_tyRIgUniq) of + { _lhsOgUniq -> + (case (_tyRIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Eq_1 :: T_Pred_1 + sem_Pred_Eq_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyROreplSubst -> + (case (_lhsIreplSubst) of + { _tyLOreplSubst -> + (case (tyR_1 _tyROreplSubst) of + { ( _tyRIinstToL,_tyRIrepl,_tyRIreplTvL) -> + (case (tyL_1 _tyLOreplSubst) of + { ( _tyLIinstToL,_tyLIrepl,_tyLIreplTvL) -> + (case (Pred_Eq _tyLIrepl _tyRIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) + in sem_Pred_Eq_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Var_1 :: T_Pred_1 + sem_Pred_Var_1 = + (\ _lhsIreplSubst -> + (case (Pred_Var pv_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) + in sem_Pred_Var_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _seqOgUniq -> + (case (_lhsIonlyExists) of + { _seqOonlyExists -> + (case (_lhsImbQ) of + { _seqOmbQ -> + (case (_lhsIhowToInst) of + { _seqOhowToInst -> + (case (_lhsIgathSubst) of + { _seqOgathSubst -> + (case (_lhsIallow) of + { _seqOallow -> + (case (seq_ _seqOallow _seqOgUniq _seqOgathSubst _seqOhowToInst _seqOmbQ _seqOonlyExists) of + { ( _seqIgUniq,_seqIgathSubst,seq_1) -> + (case (_seqIgUniq) of + { _lhsOgUniq -> + (case (_seqIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Pred_Preds_1 :: T_Pred_1 + sem_Pred_Preds_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _seqOreplSubst -> + (case (seq_1 _seqOreplSubst) of + { ( _seqIrepl) -> + (case (Pred_Preds _seqIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) + in sem_Pred_Preds_1)) of + { ( sem_Pred_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Pred_1) }) }) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + allow : Bool + howToInst : HowToInst + mbQ : Maybe TyQu + onlyExists : Bool + chained attributes: + gUniq : UID + gathSubst : VarMp + visit 1: + inherited attribute: + replSubst : VarMp + synthesized attribute: + repl : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 1: + local repl : _ + alternative Nil: + visit 1: + local repl : _ + alternative Var: + child av : {TyVarId} + visit 1: + local repl : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Bool -> + UID -> + VarMp -> + HowToInst -> + (Maybe TyQu) -> + Bool -> + ( UID,VarMp,T_PredSeq_1) +type T_PredSeq_1 = VarMp -> + ( PredSeq) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _hdOgUniq -> + (case (_lhsIonlyExists) of + { _hdOonlyExists -> + (case (_lhsImbQ) of + { _hdOmbQ -> + (case (_lhsIhowToInst) of + { _hdOhowToInst -> + (case (_lhsIgathSubst) of + { _hdOgathSubst -> + (case (_lhsIallow) of + { _hdOallow -> + (case (hd_ _hdOallow _hdOgUniq _hdOgathSubst _hdOhowToInst _hdOmbQ _hdOonlyExists) of + { ( _hdIgUniq,_hdIgathSubst,hd_1) -> + (case (_hdIgUniq) of + { _tlOgUniq -> + (case (_lhsIonlyExists) of + { _tlOonlyExists -> + (case (_lhsImbQ) of + { _tlOmbQ -> + (case (_lhsIhowToInst) of + { _tlOhowToInst -> + (case (_hdIgathSubst) of + { _tlOgathSubst -> + (case (_lhsIallow) of + { _tlOallow -> + (case (tl_ _tlOallow _tlOgUniq _tlOgathSubst _tlOhowToInst _tlOmbQ _tlOonlyExists) of + { ( _tlIgUniq,_tlIgathSubst,tl_1) -> + (case (_tlIgUniq) of + { _lhsOgUniq -> + (case (_tlIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_PredSeq_Cons_1 :: T_PredSeq_1 + sem_PredSeq_Cons_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tlOreplSubst -> + (case (_lhsIreplSubst) of + { _hdOreplSubst -> + (case (tl_1 _tlOreplSubst) of + { ( _tlIrepl) -> + (case (hd_1 _hdOreplSubst) of + { ( _hdIrepl) -> + (case (PredSeq_Cons _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) }) }) })) + in sem_PredSeq_Cons_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_PredSeq_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_PredSeq_Nil_1 :: T_PredSeq_1 + sem_PredSeq_Nil_1 = + (\ _lhsIreplSubst -> + (case (PredSeq_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) + in sem_PredSeq_Nil_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_PredSeq_1) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_PredSeq_Var_1 :: T_PredSeq_1 + sem_PredSeq_Var_1 = + (\ _lhsIreplSubst -> + (case (PredSeq_Var av_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) })) + in sem_PredSeq_Var_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_PredSeq_1) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attributes: + allow : Bool + howToInst : HowToInst + mbQ : Maybe TyQu + onlyExists : Bool + chained attributes: + gUniq : UID + gathSubst : VarMp + visit 1: + inherited attribute: + replSubst : VarMp + synthesized attributes: + instToL : [InstTo] + repl : Ty + replTvL : TyVarIdL + alternatives: + alternative Con: + child nm : {HsName} + visit 1: + local repl : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local allow : _ + visit 1: + local repl : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 0: + local allow : _ + visit 1: + local repl : _ + alternative Dbg: + child info : {String} + visit 1: + local repl : _ + alternative Any: + visit 1: + local repl : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 1: + local repl : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 0: + local _tup1 : _ + local allow : {Bool} + local lUniq : _ + local tvNew : {UID} + local _tup2 : _ + visit 1: + local repl : _ + local l1Subst : _ + local instTo : _ + local _tup3 : _ + intra tvNew : {UID} + intra allow : {Bool} + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local allow : _ + visit 1: + local repl : _ + alternative Pred: + child pr : Pred + visit 0: + local allow : _ + visit 1: + local repl : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 0: + local allow : _ + visit 1: + local repl : _ + alternative Impls: + child impls : Impls + visit 0: + local allow : _ + visit 1: + local repl : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = Bool -> + UID -> + VarMp -> + HowToInst -> + (Maybe TyQu) -> + Bool -> + ( UID,VarMp,T_Ty_1) +type T_Ty_1 = VarMp -> + ( ([InstTo]),Ty,TyVarIdL) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Con_1 :: T_Ty_1 + sem_Ty_Con_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (Ty_Con nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) })) + in sem_Ty_Con_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) })) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _funcOgUniq -> + (case (_lhsIonlyExists) of + { _funcOonlyExists -> + (case (_lhsImbQ) of + { _funcOmbQ -> + (case (_lhsIhowToInst) of + { _funcOhowToInst -> + (case (_lhsIgathSubst) of + { _funcOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _funcOallow -> + (case (func_ _funcOallow _funcOgUniq _funcOgathSubst _funcOhowToInst _funcOmbQ _funcOonlyExists) of + { ( _funcIgUniq,_funcIgathSubst,func_1) -> + (case (_funcIgUniq) of + { _argOgUniq -> + (case (_lhsIonlyExists) of + { _argOonlyExists -> + (case (_lhsImbQ) of + { _argOmbQ -> + (case (_lhsIhowToInst) of + { _argOhowToInst -> + (case (_funcIgathSubst) of + { _argOgathSubst -> + (case (_allow) of + { _argOallow -> + (case (arg_ _argOallow _argOgUniq _argOgathSubst _argOhowToInst _argOmbQ _argOonlyExists) of + { ( _argIgUniq,_argIgathSubst,arg_1) -> + (case (_argIgUniq) of + { _lhsOgUniq -> + (case (_argIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_App_1 :: T_Ty_1 + sem_Ty_App_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _argOreplSubst -> + (case (_lhsIreplSubst) of + { _funcOreplSubst -> + (case (arg_1 _argOreplSubst) of + { ( _argIinstToL,_argIrepl,_argIreplTvL) -> + (case (func_1 _funcOreplSubst) of + { ( _funcIinstToL,_funcIrepl,_funcIreplTvL) -> + (case (_funcIinstToL ++ _argIinstToL) of + { _lhsOinstToL -> + (case (Ty_App _funcIrepl _argIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_funcIreplTvL ++ _argIreplTvL) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) }) }) })) + in sem_Ty_App_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Ann_1 :: T_Ty_1 + sem_Ty_Ann_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (_tyIinstToL) of + { _lhsOinstToL -> + (case (ann_) of + { ( _annIrepl) -> + (case (Ty_Ann _annIrepl _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyIreplTvL) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) }) })) + in sem_Ty_Ann_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Dbg_1 :: T_Ty_1 + sem_Ty_Dbg_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (Ty_Dbg info_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) })) + in sem_Ty_Dbg_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) })) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Any_1 :: T_Ty_1 + sem_Ty_Any_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (Ty_Any) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) })) + in sem_Ty_Any_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) })) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _lhsOgUniq -> + (case (_lhsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Var_1 :: T_Ty_1 + sem_Ty_Var_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (categ_) of + { ( _categIrepl) -> + (case (Ty_Var tv_ _categIrepl) of + { _repl -> + (case (maybe _repl id (varmpTyLookup tv_ _lhsIreplSubst)) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) })) + in sem_Ty_Var_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) })) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (mkNewUID _lhsIgUniq) of + { __tup1 -> + (case (__tup1) of + { (_tyOgUniq,_) -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (qu_) of + { ( _quIrepl) -> + (case (_lhsIallow + && not (tyquIsForall _quIrepl && _lhsIonlyExists) + && maybe True (== _quIrepl) _lhsImbQ) of + { _allow -> + (case (_allow) of + { _tyOallow -> + (case (__tup1) of + { (_,_lUniq) -> + (case (_lUniq) of + { _tvNew -> + (case (if _allow + then let t = _lhsIhowToInst _quIrepl _tvNew + in ( t + , (varmpMetaLevTyUnit (tyquMetaLev _quIrepl) tv_ t) + `varmpPlus` _lhsIgathSubst + ) + else (Ty_Any,_lhsIgathSubst)) of + { __tup2 -> + (case (__tup2) of + { (_,_tyOgathSubst) -> + (case (Just _quIrepl) of + { _tyOmbQ -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_TBind_1 :: T_Ty_1 + sem_Ty_TBind_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (Ty_TBind _quIrepl tv_ l1_ _tyIrepl) of + { _repl -> + (case (varmpDecMetaLev _lhsIreplSubst `varUpd` l1_) of + { _l1Subst -> + (case (InstTo_Qu _quIrepl tv_ _tvNew _l1Subst) of + { _instTo -> + (case (if _allow + then (_tyIrepl,_tvNew : _tyIreplTvL, _instTo : _tyIinstToL) + else (_repl,[],[])) of + { __tup3 -> + (case (__tup3) of + { (_,_,_lhsOinstToL) -> + (case (__tup3) of + { (_lhsOrepl,_,_) -> + (case (__tup3) of + { (_,_lhsOreplTvL,_) -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) }) }) }) })) + in sem_Ty_TBind_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _extTyOgUniq -> + (case (_lhsIonlyExists) of + { _extTyOonlyExists -> + (case (_lhsImbQ) of + { _extTyOmbQ -> + (case (_lhsIhowToInst) of + { _extTyOhowToInst -> + (case (_tyIgathSubst) of + { _extTyOgathSubst -> + (case (_allow) of + { _extTyOallow -> + (case (extTy_ _extTyOallow _extTyOgUniq _extTyOgathSubst _extTyOhowToInst _extTyOmbQ _extTyOonlyExists) of + { ( _extTyIgUniq,_extTyIgathSubst,extTy_1) -> + (case (_extTyIgUniq) of + { _lhsOgUniq -> + (case (_extTyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Ext_1 :: T_Ty_1 + sem_Ty_Ext_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _extTyOreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (extTy_1 _extTyOreplSubst) of + { ( _extTyIinstToL,_extTyIrepl,_extTyIreplTvL) -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (_tyIinstToL ++ _extTyIinstToL) of + { _lhsOinstToL -> + (case (Ty_Ext _tyIrepl nm_ _extTyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyIreplTvL ++ _extTyIreplTvL) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) }) }) })) + in sem_Ty_Ext_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _prOgUniq -> + (case (_lhsIonlyExists) of + { _prOonlyExists -> + (case (_lhsImbQ) of + { _prOmbQ -> + (case (_lhsIhowToInst) of + { _prOhowToInst -> + (case (_lhsIgathSubst) of + { _prOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _prOallow -> + (case (pr_ _prOallow _prOgUniq _prOgathSubst _prOhowToInst _prOmbQ _prOonlyExists) of + { ( _prIgUniq,_prIgathSubst,pr_1) -> + (case (_prIgUniq) of + { _lhsOgUniq -> + (case (_prIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Pred_1 :: T_Ty_1 + sem_Ty_Pred_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (_lhsIreplSubst) of + { _prOreplSubst -> + (case (pr_1 _prOreplSubst) of + { ( _prIrepl) -> + (case (Ty_Pred _prIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) })) + in sem_Ty_Pred_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsImbQ) of + { _tyOmbQ -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgathSubst) of + { _tyOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgUniq) of + { _lhsOgUniq -> + (case (_tyIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Lam_1 :: T_Ty_1 + sem_Ty_Lam_1 = + (\ _lhsIreplSubst -> + (case (_lhsIreplSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (_tyIinstToL) of + { _lhsOinstToL -> + (case (Ty_Lam tv_ _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case (_tyIreplTvL) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) })) + in sem_Ty_Lam_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsIallow + _lhsIgUniq + _lhsIgathSubst + _lhsIhowToInst + _lhsImbQ + _lhsIonlyExists -> + (case (_lhsIgUniq) of + { _implsOgUniq -> + (case (_lhsIonlyExists) of + { _implsOonlyExists -> + (case (_lhsImbQ) of + { _implsOmbQ -> + (case (_lhsIhowToInst) of + { _implsOhowToInst -> + (case (_lhsIgathSubst) of + { _implsOgathSubst -> + (case (False) of + { _allow -> + (case (_allow) of + { _implsOallow -> + (case (impls_ _implsOallow _implsOgUniq _implsOgathSubst _implsOhowToInst _implsOmbQ _implsOonlyExists) of + { ( _implsIgUniq,_implsIgathSubst,impls_1) -> + (case (_implsIgUniq) of + { _lhsOgUniq -> + (case (_implsIgathSubst) of + { _lhsOgathSubst -> + (case ((let sem_Ty_Impls_1 :: T_Ty_1 + sem_Ty_Impls_1 = + (\ _lhsIreplSubst -> + (case ([]) of + { _lhsOinstToL -> + (case (_lhsIreplSubst) of + { _implsOreplSubst -> + (case (impls_1 _implsOreplSubst) of + { ( _implsIrepl) -> + (case (Ty_Impls _implsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + (case ([]) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) })) + in sem_Ty_Impls_1)) of + { ( sem_Ty_1) -> + ( _lhsOgUniq,_lhsOgathSubst,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attributes: + gUniq : UID + howToInst : HowToInst + onlyExists : Bool + synthesized attributes: + instToL : [InstTo] + repl : Ty + replTvL : TyVarIdL + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = UID -> + HowToInst -> + Bool -> + ( ([InstTo]),Ty,TyVarIdL) +data Inh_TyAGItf = Inh_TyAGItf {gUniq_Inh_TyAGItf :: !(UID),howToInst_Inh_TyAGItf :: !(HowToInst),onlyExists_Inh_TyAGItf :: !(Bool)} +data Syn_TyAGItf = Syn_TyAGItf {instToL_Syn_TyAGItf :: !(([InstTo])),repl_Syn_TyAGItf :: !(Ty),replTvL_Syn_TyAGItf :: !(TyVarIdL)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIgUniq _lhsIhowToInst _lhsIonlyExists) = + (let ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) = sem _lhsIgUniq _lhsIhowToInst _lhsIonlyExists + in (Syn_TyAGItf _lhsOinstToL _lhsOrepl _lhsOreplTvL)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIgUniq + _lhsIhowToInst + _lhsIonlyExists -> + (case (_lhsIonlyExists) of + { _tyOonlyExists -> + (case (_lhsIhowToInst) of + { _tyOhowToInst -> + (case (_lhsIgUniq) of + { _tyOgUniq -> + (case (emptyVarMp) of + { _tyOgathSubst -> + (case (Nothing) of + { _tyOmbQ -> + (case (True) of + { _tyOallow -> + (case (ty_ _tyOallow _tyOgUniq _tyOgathSubst _tyOhowToInst _tyOmbQ _tyOonlyExists) of + { ( _tyIgUniq,_tyIgathSubst,ty_1) -> + (case (_tyIgathSubst) of + { _tyOreplSubst -> + (case (ty_1 _tyOreplSubst) of + { ( _tyIinstToL,_tyIrepl,_tyIreplTvL) -> + (case (_tyIinstToL) of + { _lhsOinstToL -> + (case (_tyIrepl) of + { _lhsOrepl -> + (case (_tyIreplTvL) of + { _lhsOreplTvL -> + ( _lhsOinstToL,_lhsOrepl,_lhsOreplTvL) }) }) }) }) }) }) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + synthesized attribute: + repl : TyAnn + alternatives: + alternative Empty: + visit 0: + local repl : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local repl : _ + alternative Mono: + visit 0: + local repl : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (case (TyAnn_Empty) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (case (TyAnn_Strictness s_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (case (TyAnn_Mono) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +-- TyQu -------------------------------------------------------- +{- + visit 0: + synthesized attribute: + repl : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local repl : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (case (TyQu_Forall mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (case (TyQu_Exists mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (case (TyQu_Plain mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attribute: + repl : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local repl : _ + alternative Fixed: + visit 0: + local repl : _ + alternative Meta: + visit 0: + local repl : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (case (TyVarCateg_Plain) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (case (TyVarCateg_Fixed) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (case (TyVarCateg_Meta) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) diff --git a/src/UHC/Light/Compiler/Ty/Trf/MergePreds.hs b/src/UHC/Light/Compiler/Ty/Trf/MergePreds.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/MergePreds.hs @@ -0,0 +1,4283 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePr) +module UHC.Light.Compiler.Ty.Trf.MergePreds(tyMergePreds +, TyMergePredOut (..) +, TQOGam) where + +import UHC.Util.Utils +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Gam +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List as List +import Data.Maybe +import UHC.Util.Pretty + + + +tvarSOccurCount :: [TyVarIdS] -> AssocL TyVarId Int +tvarSOccurCount = map (\vl@(v:_) -> (v,length vl)) . group . sort . concat . map Set.toList + +tvarSOccurGE2 :: [TyVarIdS] -> TyVarIdS +tvarSOccurGE2 = Set.fromList . map fst . filter ((>1).snd) . tvarSOccurCount + + + +data TyQuCtxt = TyQuCtxtArrow | TyQuCtxtProd | TyQuCtxtOnTop | TyQuCtxtOther deriving (Show,Eq) + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + +tyMergePreds :: [PredOcc] -> Ty -> TyMergePredOut +tyMergePreds prL ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf { prLL_Inh_TyAGItf = [prL] + }) + in TyMergePredOut + { tmpoTy = prTy_Syn_TyAGItf t + , tmpoInsPrIdSet = insPrIdSet_Syn_TyAGItf t + , tmpoImplsVarMp = assocImplsLToVarMp (prImpls_Syn_TyAGItf t) + , tmpoImplsPrvReq = prvReqs_Syn_TyAGItf t + } + + + +type InsPrPrvOcc = Assoc PredOcc [ImplsProveOcc] +type PrvReqs = [InsPrPrvOcc] + +data TyMergePredOut + = TyMergePredOut + { tmpoTy :: Ty -- resulting ty + , tmpoInsPrIdSet :: Set.Set PredOccId -- idents of merged predicates + , tmpoImplsVarMp :: VarMp -- additional bindings, for implicits + , tmpoImplsPrvReq :: PrvReqs -- additional occurrences of predicate occurrences, arising from implicits + } + +instance Show TyMergePredOut where + show _ = "" + +instance PP TyMergePredOut where + pp tmpo = pp (tmpoImplsVarMp tmpo) >-< ppAssocLV (assocLMapElt ppBracketsCommas $ tmpoImplsPrvReq tmpo) + + + +type TQOGam = Gam HsName TyMergePredOut + + + +prLLArrowSplit :: TyVarIdS -> [[PredOcc]] -> ([PredOcc],[[PredOcc]]) +prLLArrowSplit frTvS prLL + = let (h,r) = partition (all (`Set.member` frTvS) . varFree) . concat $ prLL + in (h,[r]) + + + +toInsPrPrvOcc :: [PredOcc] -> [ImplsProveOcc] -> [InsPrPrvOcc] +toInsPrPrvOcc ps ipos = [ (p,ipos) | p <- ps ] + + + +prOccLImpls :: Maybe Impls -> [InsPrPrvOcc] -> AssocL ImplsVarId Impls +prOccLImpls mbI prL + = case mbI of + Just i -> [( implsTailVar i + , foldr (\(p,_) im + -> Impls_Cons (poId p) (poPr p) (poPoi p) + (poRange p) + [] im + ) Impls_Nil prL)] + _ -> [] + + + +prOccLPrvReqs :: Maybe Impls -> [InsPrPrvOcc] -> PrvReqs +prOccLPrvReqs mbI prL = maybe [] (const prL) mbI + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + fxTvM : TvCatMp + isAtTop : Bool + isRow : Bool + mbPrLoc : Maybe Impls + pol : Polarity + prLL : [[PredOcc]] + qSurrTvS : TyVarIdS + tyCtxt : TyQuCtxt + chained attribute: + prImpls : AssocL ImplsVarId Impls + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + insPrIdSet : Set.Set PredOccId + insPrL : [PredOcc] + prTy : Impls + prvReqs : PrvReqs + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + self : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local prTy : _ + local self : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local prTy : _ + local self : _ + alternative Nil: + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = TvCatMp -> + Bool -> + Bool -> + (Maybe Impls) -> + Polarity -> + (AssocL ImplsVarId Impls) -> + ([[PredOcc]]) -> + TyVarIdS -> + TyQuCtxt -> + ( ([TyVarIdS]),TvCatMp,(Set.Set PredOccId),([PredOcc]),(AssocL ImplsVarId Impls),Impls,PrvReqs,TyVarIdS,TyVarIdS,Impls) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Impls + _lhsOself :: Impls + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 32, column 17) + _lhsOfrTvSL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 133, column 17) + _lhsOqOrphanTvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Impls_Tail iv_ proveOccs_ + -- self rule + _self = + Impls_Tail iv_ proveOccs_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Impls + _lhsOself :: Impls + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _prOfxTvM :: TvCatMp + _prOisAtTop :: Bool + _prOisRow :: Bool + _prOmbPrLoc :: (Maybe Impls) + _prOpol :: Polarity + _prOprImpls :: (AssocL ImplsVarId Impls) + _prOprLL :: ([[PredOcc]]) + _prOqSurrTvS :: TyVarIdS + _prOtyCtxt :: TyQuCtxt + _tlOfxTvM :: TvCatMp + _tlOisAtTop :: Bool + _tlOisRow :: Bool + _tlOmbPrLoc :: (Maybe Impls) + _tlOpol :: Polarity + _tlOprImpls :: (AssocL ImplsVarId Impls) + _tlOprLL :: ([[PredOcc]]) + _tlOqSurrTvS :: TyVarIdS + _tlOtyCtxt :: TyQuCtxt + _prIfrTvSL :: ([TyVarIdS]) + _prIgathFxTvM :: TvCatMp + _prIinsPrIdSet :: (Set.Set PredOccId) + _prIinsPrL :: ([PredOcc]) + _prIprImpls :: (AssocL ImplsVarId Impls) + _prIprTy :: Pred + _prIprvReqs :: PrvReqs + _prIqInsideTvS :: TyVarIdS + _prIqOrphanTvS :: TyVarIdS + _prIself :: Pred + _tlIfrTvSL :: ([TyVarIdS]) + _tlIgathFxTvM :: TvCatMp + _tlIinsPrIdSet :: (Set.Set PredOccId) + _tlIinsPrL :: ([PredOcc]) + _tlIprImpls :: (AssocL ImplsVarId Impls) + _tlIprTy :: Impls + _tlIprvReqs :: PrvReqs + _tlIqInsideTvS :: TyVarIdS + _tlIqOrphanTvS :: TyVarIdS + _tlIself :: Impls + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 33, column 17) + _lhsOfrTvSL = + _prIfrTvSL ++ _tlIfrTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 132, column 25) + _lhsOqOrphanTvS = + _prIqOrphanTvS `Set.union` _tlIqOrphanTvS + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _prIgathFxTvM `Map.union` _tlIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _prIinsPrIdSet `Set.union` _tlIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _prIinsPrL ++ _tlIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _prIprvReqs ++ _tlIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _prIqInsideTvS `Set.union` _tlIqInsideTvS + -- self rule + _prTy = + Impls_Cons iv_ _prIprTy pv_ prange_ proveOccs_ _tlIprTy + -- self rule + _self = + Impls_Cons iv_ _prIself pv_ prange_ proveOccs_ _tlIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tlIprImpls + -- copy rule (down) + _prOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _prOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _prOisRow = + _lhsIisRow + -- copy rule (down) + _prOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _prOpol = + _lhsIpol + -- copy rule (down) + _prOprImpls = + _lhsIprImpls + -- copy rule (down) + _prOprLL = + _lhsIprLL + -- copy rule (down) + _prOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _prOtyCtxt = + _lhsItyCtxt + -- copy rule (down) + _tlOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tlOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tlOisRow = + _lhsIisRow + -- copy rule (down) + _tlOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tlOpol = + _lhsIpol + -- copy rule (chain) + _tlOprImpls = + _prIprImpls + -- copy rule (down) + _tlOprLL = + _lhsIprLL + -- copy rule (down) + _tlOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tlOtyCtxt = + _lhsItyCtxt + ( _prIfrTvSL,_prIgathFxTvM,_prIinsPrIdSet,_prIinsPrL,_prIprImpls,_prIprTy,_prIprvReqs,_prIqInsideTvS,_prIqOrphanTvS,_prIself) = + pr_ _prOfxTvM _prOisAtTop _prOisRow _prOmbPrLoc _prOpol _prOprImpls _prOprLL _prOqSurrTvS _prOtyCtxt + ( _tlIfrTvSL,_tlIgathFxTvM,_tlIinsPrIdSet,_tlIinsPrL,_tlIprImpls,_tlIprTy,_tlIprvReqs,_tlIqInsideTvS,_tlIqOrphanTvS,_tlIself) = + tl_ _tlOfxTvM _tlOisAtTop _tlOisRow _tlOmbPrLoc _tlOpol _tlOprImpls _tlOprLL _tlOqSurrTvS _tlOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Impls + _lhsOself :: Impls + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 32, column 17) + _lhsOfrTvSL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 133, column 17) + _lhsOqOrphanTvS = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Impls_Nil + -- self rule + _self = + Impls_Nil + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +-- Label ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + prTy : Label + self : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local prTy : _ + local self : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( Label,Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (let _lhsOprTy :: Label + _lhsOself :: Label + -- self rule + _prTy = + Label_Lab nm_ + -- self rule + _self = + Label_Lab nm_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (let _lhsOprTy :: Label + _lhsOself :: Label + -- self rule + _prTy = + Label_Var lv_ + -- self rule + _self = + Label_Var lv_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + (let _labIprTy :: Label + _labIself :: Label + ( _labIprTy,_labIself) = + lab_ + in ( )) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + fxTvM : TvCatMp + isAtTop : Bool + isRow : Bool + mbPrLoc : Maybe Impls + pol : Polarity + prLL : [[PredOcc]] + qSurrTvS : TyVarIdS + tyCtxt : TyQuCtxt + chained attribute: + prImpls : AssocL ImplsVarId Impls + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + insPrIdSet : Set.Set PredOccId + insPrL : [PredOcc] + prTy : Pred + prvReqs : PrvReqs + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + self : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Pred: + child ty : Ty + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ + alternative Preds: + child seq : PredSeq + visit 0: + local appSpinePos : _ + local prTy : _ + local self : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = TvCatMp -> + Bool -> + Bool -> + (Maybe Impls) -> + Polarity -> + (AssocL ImplsVarId Impls) -> + ([[PredOcc]]) -> + TyVarIdS -> + TyQuCtxt -> + ( ([TyVarIdS]),TvCatMp,(Set.Set PredOccId),([PredOcc]),(AssocL ImplsVarId Impls),Pred,PrvReqs,TyVarIdS,TyVarIdS,Pred) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _tyOpol :: Polarity + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _tyOappSpinePos :: Int + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 56, column 17) + _tyOpol = + polInvariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _tyIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Pred_Class _tyIprTy + -- self rule + _self = + Pred_Class _tyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _tyIqOrphanTvS + -- copy rule (from local) + _tyOappSpinePos = + _appSpinePos + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tyOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tyOisRow = + _lhsIisRow + -- copy rule (down) + _tyOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tyOtyCtxt = + _lhsItyCtxt + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _tyOpol :: Polarity + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _tyOappSpinePos :: Int + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 55, column 17) + _tyOpol = + polCovariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _tyIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Pred_Pred _tyIprTy + -- self rule + _self = + Pred_Pred _tyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _tyIqOrphanTvS + -- copy rule (from local) + _tyOappSpinePos = + _appSpinePos + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tyOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tyOisRow = + _lhsIisRow + -- copy rule (down) + _tyOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tyOtyCtxt = + _lhsItyCtxt + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _tyOappSpinePos :: Int + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOpol :: Polarity + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + _labIprTy :: Label + _labIself :: Label + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _tyIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Pred_Lacks _tyIprTy _labIprTy + -- self rule + _self = + Pred_Lacks _tyIself _labIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _tyIqOrphanTvS + -- copy rule (from local) + _tyOappSpinePos = + _appSpinePos + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tyOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tyOisRow = + _lhsIisRow + -- copy rule (down) + _tyOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tyOpol = + _lhsIpol + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tyOtyCtxt = + _lhsItyCtxt + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + ( _labIprTy,_labIself) = + lab_ + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _argsOappSpinePos :: Int + _argsOfxTvM :: TvCatMp + _argsOisAtTop :: Bool + _argsOisRow :: Bool + _argsOmbPrLoc :: (Maybe Impls) + _argsOpol :: Polarity + _argsOprImpls :: (AssocL ImplsVarId Impls) + _argsOprLL :: ([[PredOcc]]) + _argsOqSurrTvS :: TyVarIdS + _argsOtyCtxt :: TyQuCtxt + _resOfxTvM :: TvCatMp + _resOisAtTop :: Bool + _resOisRow :: Bool + _resOmbPrLoc :: (Maybe Impls) + _resOpol :: Polarity + _resOprImpls :: (AssocL ImplsVarId Impls) + _resOprLL :: ([[PredOcc]]) + _resOqSurrTvS :: TyVarIdS + _resOtyCtxt :: TyQuCtxt + _argsIfrTvSL :: ([TyVarIdS]) + _argsIgathFxTvM :: TvCatMp + _argsIinsPrIdSet :: (Set.Set PredOccId) + _argsIinsPrL :: ([PredOcc]) + _argsIprImpls :: (AssocL ImplsVarId Impls) + _argsIprTy :: PredSeq + _argsIprvReqs :: PrvReqs + _argsIqInsideTvS :: TyVarIdS + _argsIself :: PredSeq + _resIfrTvSL :: ([TyVarIdS]) + _resIgathFxTvM :: TvCatMp + _resIinsPrIdSet :: (Set.Set PredOccId) + _resIinsPrL :: ([PredOcc]) + _resIprImpls :: (AssocL ImplsVarId Impls) + _resIprTy :: Pred + _resIprvReqs :: PrvReqs + _resIqInsideTvS :: TyVarIdS + _resIqOrphanTvS :: TyVarIdS + _resIself :: Pred + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _argsIfrTvSL ++ _resIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _argsIgathFxTvM `Map.union` _resIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _argsIinsPrIdSet `Set.union` _resIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _argsIinsPrL ++ _resIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _argsIprvReqs ++ _resIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _argsIqInsideTvS `Set.union` _resIqInsideTvS + -- self rule + _prTy = + Pred_Arrow _argsIprTy _resIprTy + -- self rule + _self = + Pred_Arrow _argsIself _resIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _resIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _resIqOrphanTvS + -- copy rule (from local) + _argsOappSpinePos = + _appSpinePos + -- copy rule (down) + _argsOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _argsOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _argsOisRow = + _lhsIisRow + -- copy rule (down) + _argsOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _argsOpol = + _lhsIpol + -- copy rule (down) + _argsOprImpls = + _lhsIprImpls + -- copy rule (down) + _argsOprLL = + _lhsIprLL + -- copy rule (down) + _argsOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _argsOtyCtxt = + _lhsItyCtxt + -- copy rule (down) + _resOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _resOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _resOisRow = + _lhsIisRow + -- copy rule (down) + _resOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _resOpol = + _lhsIpol + -- copy rule (chain) + _resOprImpls = + _argsIprImpls + -- copy rule (down) + _resOprLL = + _lhsIprLL + -- copy rule (down) + _resOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _resOtyCtxt = + _lhsItyCtxt + ( _argsIfrTvSL,_argsIgathFxTvM,_argsIinsPrIdSet,_argsIinsPrL,_argsIprImpls,_argsIprTy,_argsIprvReqs,_argsIqInsideTvS,_argsIself) = + args_ _argsOappSpinePos _argsOfxTvM _argsOisAtTop _argsOisRow _argsOmbPrLoc _argsOpol _argsOprImpls _argsOprLL _argsOqSurrTvS _argsOtyCtxt + ( _resIfrTvSL,_resIgathFxTvM,_resIinsPrIdSet,_resIinsPrL,_resIprImpls,_resIprTy,_resIprvReqs,_resIqInsideTvS,_resIqOrphanTvS,_resIself) = + res_ _resOfxTvM _resOisAtTop _resOisRow _resOmbPrLoc _resOpol _resOprImpls _resOprLL _resOqSurrTvS _resOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _tyLOappSpinePos :: Int + _tyLOfxTvM :: TvCatMp + _tyLOisAtTop :: Bool + _tyLOisRow :: Bool + _tyLOmbPrLoc :: (Maybe Impls) + _tyLOpol :: Polarity + _tyLOprImpls :: (AssocL ImplsVarId Impls) + _tyLOprLL :: ([[PredOcc]]) + _tyLOqSurrTvS :: TyVarIdS + _tyLOtyCtxt :: TyQuCtxt + _tyROappSpinePos :: Int + _tyROfxTvM :: TvCatMp + _tyROisAtTop :: Bool + _tyROisRow :: Bool + _tyROmbPrLoc :: (Maybe Impls) + _tyROpol :: Polarity + _tyROprImpls :: (AssocL ImplsVarId Impls) + _tyROprLL :: ([[PredOcc]]) + _tyROqSurrTvS :: TyVarIdS + _tyROtyCtxt :: TyQuCtxt + _tyLIappFunNm :: HsName + _tyLIfrTvSL :: ([TyVarIdS]) + _tyLIgathFxTvM :: TvCatMp + _tyLIinsPrIdSet :: (Set.Set PredOccId) + _tyLIinsPrL :: ([PredOcc]) + _tyLIisArrow :: Bool + _tyLIisPred :: Bool + _tyLIisQuLoc :: Bool + _tyLImbImpls :: (Maybe Impls) + _tyLIprImpls :: (AssocL ImplsVarId Impls) + _tyLIprTy :: Ty + _tyLIprvReqs :: PrvReqs + _tyLIqInsideTvS :: TyVarIdS + _tyLIqOrphanTvS :: TyVarIdS + _tyLIself :: Ty + _tyRIappFunNm :: HsName + _tyRIfrTvSL :: ([TyVarIdS]) + _tyRIgathFxTvM :: TvCatMp + _tyRIinsPrIdSet :: (Set.Set PredOccId) + _tyRIinsPrL :: ([PredOcc]) + _tyRIisArrow :: Bool + _tyRIisPred :: Bool + _tyRIisQuLoc :: Bool + _tyRImbImpls :: (Maybe Impls) + _tyRIprImpls :: (AssocL ImplsVarId Impls) + _tyRIprTy :: Ty + _tyRIprvReqs :: PrvReqs + _tyRIqInsideTvS :: TyVarIdS + _tyRIqOrphanTvS :: TyVarIdS + _tyRIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _tyLIfrTvSL ++ _tyRIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyLIgathFxTvM `Map.union` _tyRIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyLIinsPrIdSet `Set.union` _tyRIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyLIinsPrL ++ _tyRIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyLIprvReqs ++ _tyRIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyLIqInsideTvS `Set.union` _tyRIqInsideTvS + -- self rule + _prTy = + Pred_Eq _tyLIprTy _tyRIprTy + -- self rule + _self = + Pred_Eq _tyLIself _tyRIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyRIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _tyRIqOrphanTvS + -- copy rule (from local) + _tyLOappSpinePos = + _appSpinePos + -- copy rule (down) + _tyLOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tyLOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tyLOisRow = + _lhsIisRow + -- copy rule (down) + _tyLOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tyLOpol = + _lhsIpol + -- copy rule (down) + _tyLOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyLOprLL = + _lhsIprLL + -- copy rule (down) + _tyLOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tyLOtyCtxt = + _lhsItyCtxt + -- copy rule (from local) + _tyROappSpinePos = + _appSpinePos + -- copy rule (down) + _tyROfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tyROisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tyROisRow = + _lhsIisRow + -- copy rule (down) + _tyROmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tyROpol = + _lhsIpol + -- copy rule (chain) + _tyROprImpls = + _tyLIprImpls + -- copy rule (down) + _tyROprLL = + _lhsIprLL + -- copy rule (down) + _tyROqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tyROtyCtxt = + _lhsItyCtxt + ( _tyLIappFunNm,_tyLIfrTvSL,_tyLIgathFxTvM,_tyLIinsPrIdSet,_tyLIinsPrL,_tyLIisArrow,_tyLIisPred,_tyLIisQuLoc,_tyLImbImpls,_tyLIprImpls,_tyLIprTy,_tyLIprvReqs,_tyLIqInsideTvS,_tyLIqOrphanTvS,_tyLIself) = + tyL_ _tyLOappSpinePos _tyLOfxTvM _tyLOisAtTop _tyLOisRow _tyLOmbPrLoc _tyLOpol _tyLOprImpls _tyLOprLL _tyLOqSurrTvS _tyLOtyCtxt + ( _tyRIappFunNm,_tyRIfrTvSL,_tyRIgathFxTvM,_tyRIinsPrIdSet,_tyRIinsPrL,_tyRIisArrow,_tyRIisPred,_tyRIisQuLoc,_tyRImbImpls,_tyRIprImpls,_tyRIprTy,_tyRIprvReqs,_tyRIqInsideTvS,_tyRIqOrphanTvS,_tyRIself) = + tyR_ _tyROappSpinePos _tyROfxTvM _tyROisAtTop _tyROisRow _tyROmbPrLoc _tyROpol _tyROprImpls _tyROprLL _tyROqSurrTvS _tyROtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOqOrphanTvS :: TyVarIdS + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 138, column 33) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Pred_Var pv_ + -- self rule + _self = + Pred_Var pv_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOqOrphanTvS :: TyVarIdS + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Pred + _lhsOself :: Pred + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _seqOappSpinePos :: Int + _seqOfxTvM :: TvCatMp + _seqOisAtTop :: Bool + _seqOisRow :: Bool + _seqOmbPrLoc :: (Maybe Impls) + _seqOpol :: Polarity + _seqOprImpls :: (AssocL ImplsVarId Impls) + _seqOprLL :: ([[PredOcc]]) + _seqOqSurrTvS :: TyVarIdS + _seqOtyCtxt :: TyQuCtxt + _seqIfrTvSL :: ([TyVarIdS]) + _seqIgathFxTvM :: TvCatMp + _seqIinsPrIdSet :: (Set.Set PredOccId) + _seqIinsPrL :: ([PredOcc]) + _seqIprImpls :: (AssocL ImplsVarId Impls) + _seqIprTy :: PredSeq + _seqIprvReqs :: PrvReqs + _seqIqInsideTvS :: TyVarIdS + _seqIself :: PredSeq + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 138, column 33) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 72, column 17) + _appSpinePos = + 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _seqIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _seqIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _seqIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _seqIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _seqIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _seqIqInsideTvS + -- self rule + _prTy = + Pred_Preds _seqIprTy + -- self rule + _self = + Pred_Preds _seqIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _seqIprImpls + -- copy rule (from local) + _seqOappSpinePos = + _appSpinePos + -- copy rule (down) + _seqOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _seqOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _seqOisRow = + _lhsIisRow + -- copy rule (down) + _seqOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _seqOpol = + _lhsIpol + -- copy rule (down) + _seqOprImpls = + _lhsIprImpls + -- copy rule (down) + _seqOprLL = + _lhsIprLL + -- copy rule (down) + _seqOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _seqOtyCtxt = + _lhsItyCtxt + ( _seqIfrTvSL,_seqIgathFxTvM,_seqIinsPrIdSet,_seqIinsPrL,_seqIprImpls,_seqIprTy,_seqIprvReqs,_seqIqInsideTvS,_seqIself) = + seq_ _seqOappSpinePos _seqOfxTvM _seqOisAtTop _seqOisRow _seqOmbPrLoc _seqOpol _seqOprImpls _seqOprLL _seqOqSurrTvS _seqOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + fxTvM : TvCatMp + isAtTop : Bool + isRow : Bool + mbPrLoc : Maybe Impls + pol : Polarity + prLL : [[PredOcc]] + qSurrTvS : TyVarIdS + tyCtxt : TyQuCtxt + chained attribute: + prImpls : AssocL ImplsVarId Impls + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + insPrIdSet : Set.Set PredOccId + insPrL : [PredOcc] + prTy : PredSeq + prvReqs : PrvReqs + qInsideTvS : TyVarIdS + self : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local isSpineRoot : {Bool} + local prTy : _ + local self : _ + alternative Nil: + visit 0: + local prTy : _ + local self : _ + alternative Var: + child av : {TyVarId} + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Int -> + TvCatMp -> + Bool -> + Bool -> + (Maybe Impls) -> + Polarity -> + (AssocL ImplsVarId Impls) -> + ([[PredOcc]]) -> + TyVarIdS -> + TyQuCtxt -> + ( ([TyVarIdS]),TvCatMp,(Set.Set PredOccId),([PredOcc]),(AssocL ImplsVarId Impls),PredSeq,PrvReqs,TyVarIdS,PredSeq) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _tlOappSpinePos :: Int + _isSpineRoot :: Bool + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: PredSeq + _lhsOself :: PredSeq + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _hdOfxTvM :: TvCatMp + _hdOisAtTop :: Bool + _hdOisRow :: Bool + _hdOmbPrLoc :: (Maybe Impls) + _hdOpol :: Polarity + _hdOprImpls :: (AssocL ImplsVarId Impls) + _hdOprLL :: ([[PredOcc]]) + _hdOqSurrTvS :: TyVarIdS + _hdOtyCtxt :: TyQuCtxt + _tlOfxTvM :: TvCatMp + _tlOisAtTop :: Bool + _tlOisRow :: Bool + _tlOmbPrLoc :: (Maybe Impls) + _tlOpol :: Polarity + _tlOprImpls :: (AssocL ImplsVarId Impls) + _tlOprLL :: ([[PredOcc]]) + _tlOqSurrTvS :: TyVarIdS + _tlOtyCtxt :: TyQuCtxt + _hdIfrTvSL :: ([TyVarIdS]) + _hdIgathFxTvM :: TvCatMp + _hdIinsPrIdSet :: (Set.Set PredOccId) + _hdIinsPrL :: ([PredOcc]) + _hdIprImpls :: (AssocL ImplsVarId Impls) + _hdIprTy :: Pred + _hdIprvReqs :: PrvReqs + _hdIqInsideTvS :: TyVarIdS + _hdIqOrphanTvS :: TyVarIdS + _hdIself :: Pred + _tlIfrTvSL :: ([TyVarIdS]) + _tlIgathFxTvM :: TvCatMp + _tlIinsPrIdSet :: (Set.Set PredOccId) + _tlIinsPrL :: ([PredOcc]) + _tlIprImpls :: (AssocL ImplsVarId Impls) + _tlIprTy :: PredSeq + _tlIprvReqs :: PrvReqs + _tlIqInsideTvS :: TyVarIdS + _tlIself :: PredSeq + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 75, column 17) + _tlOappSpinePos = + _lhsIappSpinePos + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 87, column 17) + _isSpineRoot = + _lhsIappSpinePos == 0 + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _hdIfrTvSL ++ _tlIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _hdIgathFxTvM `Map.union` _tlIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _hdIinsPrIdSet `Set.union` _tlIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _hdIinsPrL ++ _tlIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _hdIprvReqs ++ _tlIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _hdIqInsideTvS `Set.union` _tlIqInsideTvS + -- self rule + _prTy = + PredSeq_Cons _hdIprTy _tlIprTy + -- self rule + _self = + PredSeq_Cons _hdIself _tlIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tlIprImpls + -- copy rule (down) + _hdOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _hdOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _hdOisRow = + _lhsIisRow + -- copy rule (down) + _hdOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _hdOpol = + _lhsIpol + -- copy rule (down) + _hdOprImpls = + _lhsIprImpls + -- copy rule (down) + _hdOprLL = + _lhsIprLL + -- copy rule (down) + _hdOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _hdOtyCtxt = + _lhsItyCtxt + -- copy rule (down) + _tlOfxTvM = + _lhsIfxTvM + -- copy rule (down) + _tlOisAtTop = + _lhsIisAtTop + -- copy rule (down) + _tlOisRow = + _lhsIisRow + -- copy rule (down) + _tlOmbPrLoc = + _lhsImbPrLoc + -- copy rule (down) + _tlOpol = + _lhsIpol + -- copy rule (chain) + _tlOprImpls = + _hdIprImpls + -- copy rule (down) + _tlOprLL = + _lhsIprLL + -- copy rule (down) + _tlOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (down) + _tlOtyCtxt = + _lhsItyCtxt + ( _hdIfrTvSL,_hdIgathFxTvM,_hdIinsPrIdSet,_hdIinsPrL,_hdIprImpls,_hdIprTy,_hdIprvReqs,_hdIqInsideTvS,_hdIqOrphanTvS,_hdIself) = + hd_ _hdOfxTvM _hdOisAtTop _hdOisRow _hdOmbPrLoc _hdOpol _hdOprImpls _hdOprLL _hdOqSurrTvS _hdOtyCtxt + ( _tlIfrTvSL,_tlIgathFxTvM,_tlIinsPrIdSet,_tlIinsPrL,_tlIprImpls,_tlIprTy,_tlIprvReqs,_tlIqInsideTvS,_tlIself) = + tl_ _tlOappSpinePos _tlOfxTvM _tlOisAtTop _tlOisRow _tlOmbPrLoc _tlOpol _tlOprImpls _tlOprLL _tlOqSurrTvS _tlOtyCtxt + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOself))) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: PredSeq + _lhsOself :: PredSeq + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + PredSeq_Nil + -- self rule + _self = + PredSeq_Nil + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOself))) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: PredSeq + _lhsOself :: PredSeq + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + PredSeq_Var av_ + -- self rule + _self = + PredSeq_Var av_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOself))) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + fxTvM : TvCatMp + isAtTop : Bool + isRow : Bool + mbPrLoc : Maybe Impls + pol : Polarity + prLL : [[PredOcc]] + qSurrTvS : TyVarIdS + tyCtxt : TyQuCtxt + chained attribute: + prImpls : AssocL ImplsVarId Impls + synthesized attributes: + appFunNm : HsName + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + insPrIdSet : Set.Set PredOccId + insPrL : [PredOcc] + isArrow : Bool + isPred : Bool + isQuLoc : Bool + mbImpls : Maybe Impls + prTy : Ty + prvReqs : PrvReqs + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + self : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 0: + local frTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local prTy : _ + local self : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local _tup1 : _ + local frRowTvS : {TyVarIdS} + local frTvSL : {[TyVarIdS]} + local frTvS : {TyVarIdS} + local polArrowRes : _ + local isQuLoc : {Bool} + local qHereTvS : {TyVarIdS} + local qOrphanTvS : {TyVarIdS} + local qSurrTvS : _ + local appFunNm : {HsName} + local appIsArrow : {Bool} + local appIsOther : _ + local appIsRec : {Bool} + local appIsSum : _ + local appIsRecOrSum : _ + local appIsLikeProd : {Bool} + local isAtTop : _ + local argIsRow : {Bool} + local isSpineRoot : {Bool} + local isArrowRoot : {Bool} + local isArrowArg : {Bool} + local isProdRoot : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local _tup2 : _ + local implsPrL : _ + local mbTail : _ + local _tup3 : _ + local herePrL : _ + local candPrL : _ + local _tup4 : _ + local insHerePrL : _ + local forPrTyOccL : _ + local insPrIdSet : _ + local prTy : _ + local self : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 0: + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Dbg: + child info : {String} + visit 0: + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Any: + visit 0: + local frTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local prTy : _ + local self : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 0: + local frTvS : {TyVarIdS} + local isQuLoc : {Bool} + local qHereTvS : _ + local qSurrTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local implsPrL : _ + local _tup5 : _ + local herePrL : _ + local candPrL : _ + local _tup6 : _ + local insHerePrL : _ + local forPrTyOccL : _ + local insPrIdSet : _ + local prTy : _ + local self : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 0: + local frTvS : {TyVarIdS} + local isQuLoc : {Bool} + local qHereTvS : _ + local qSurrTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local introTVarL : _ + local introTVarS : {TyVarIdS} + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local frTvSL : _ + local qOrphanTvS : _ + local appFunNm : {HsName} + local isAtTop : _ + local isRow : _ + local isSpineRoot : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Pred: + child pr : Pred + visit 0: + local frTvS : {TyVarIdS} + local isQuLoc : {Bool} + local qHereTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 0: + local frTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local introTVarL : _ + local introTVarS : {TyVarIdS} + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ + alternative Impls: + child impls : Impls + visit 0: + local frTvS : _ + local isAtTop : _ + local isRow : _ + local tyCtxt : _ + local isQuLocExtraHook : _ + local mbPrLoc : _ + local prTy : _ + local self : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = Int -> + TvCatMp -> + Bool -> + Bool -> + (Maybe Impls) -> + Polarity -> + (AssocL ImplsVarId Impls) -> + ([[PredOcc]]) -> + TyVarIdS -> + TyQuCtxt -> + ( HsName,([TyVarIdS]),TvCatMp,(Set.Set PredOccId),([PredOcc]),Bool,Bool,Bool,(Maybe Impls),(AssocL ImplsVarId Impls),Ty,PrvReqs,TyVarIdS,TyVarIdS,Ty) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 14, column 17) + _frTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 17, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 4, column 17) + _lhsOappFunNm = + nm_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Ty_Con nm_ + -- self rule + _self = + Ty_Con nm_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _frRowTvS :: TyVarIdS + _frTvSL :: ([TyVarIdS]) + _frTvS :: TyVarIdS + _funcOpol :: Polarity + _argOpol :: Polarity + _isQuLoc :: Bool + _lhsOisQuLoc :: Bool + _qHereTvS :: TyVarIdS + _qOrphanTvS :: TyVarIdS + _lhsOqOrphanTvS :: TyVarIdS + _lhsOqInsideTvS :: TyVarIdS + _appFunNm :: HsName + _appIsArrow :: Bool + _appIsRec :: Bool + _appIsLikeProd :: Bool + _argIsRow :: Bool + _argOisRow :: Bool + _funcOappSpinePos :: Int + _argOappSpinePos :: Int + _isSpineRoot :: Bool + _isArrowRoot :: Bool + _isArrowArg :: Bool + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _argOmbPrLoc :: (Maybe Impls) + _funcOmbPrLoc :: (Maybe Impls) + _funcOprLL :: ([[PredOcc]]) + _argOprLL :: ([[PredOcc]]) + _lhsOinsPrL :: ([PredOcc]) + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOprvReqs :: PrvReqs + _lhsOgathFxTvM :: TvCatMp + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOappFunNm :: HsName + _funcOfxTvM :: TvCatMp + _funcOisAtTop :: Bool + _funcOisRow :: Bool + _funcOprImpls :: (AssocL ImplsVarId Impls) + _funcOqSurrTvS :: TyVarIdS + _funcOtyCtxt :: TyQuCtxt + _argOfxTvM :: TvCatMp + _argOisAtTop :: Bool + _argOprImpls :: (AssocL ImplsVarId Impls) + _argOqSurrTvS :: TyVarIdS + _argOtyCtxt :: TyQuCtxt + _funcIappFunNm :: HsName + _funcIfrTvSL :: ([TyVarIdS]) + _funcIgathFxTvM :: TvCatMp + _funcIinsPrIdSet :: (Set.Set PredOccId) + _funcIinsPrL :: ([PredOcc]) + _funcIisArrow :: Bool + _funcIisPred :: Bool + _funcIisQuLoc :: Bool + _funcImbImpls :: (Maybe Impls) + _funcIprImpls :: (AssocL ImplsVarId Impls) + _funcIprTy :: Ty + _funcIprvReqs :: PrvReqs + _funcIqInsideTvS :: TyVarIdS + _funcIqOrphanTvS :: TyVarIdS + _funcIself :: Ty + _argIappFunNm :: HsName + _argIfrTvSL :: ([TyVarIdS]) + _argIgathFxTvM :: TvCatMp + _argIinsPrIdSet :: (Set.Set PredOccId) + _argIinsPrL :: ([PredOcc]) + _argIisArrow :: Bool + _argIisPred :: Bool + _argIisQuLoc :: Bool + _argImbImpls :: (Maybe Impls) + _argIprImpls :: (AssocL ImplsVarId Impls) + _argIprTy :: Ty + _argIprvReqs :: PrvReqs + _argIqInsideTvS :: TyVarIdS + _argIqOrphanTvS :: TyVarIdS + _argIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 10, column 17) + _lhsOfrTvSL = + if _isSpineRoot then [_frTvS] else _frTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 23, column 17) + __tup1 = + if _argIsRow + then hdAndTl (reverse _argIfrTvSL) + else (Set.empty,_argIfrTvSL ++ _funcIfrTvSL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 23, column 17) + (_frRowTvS,_) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 23, column 17) + (_,_frTvSL) = + __tup1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 26, column 17) + _frTvS = + Set.unions (_frRowTvS : _frTvSL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 44, column 17) + _funcOpol = + _lhsIpol + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 45, column 17) + _argOpol = + if _appIsLikeProd then _lhsIpol + else if _isArrowRoot then _polArrowRes + else if _isArrowArg then polContravariant + else polInvariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 49, column 17) + _polArrowRes = + if _funcIisPred then _lhsIpol else polCovariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 64, column 17) + _isQuLoc = + ( polIsCovariant _lhsIpol + || (polIsContravariant _lhsIpol + && (_isProdRoot + || _isArrowRoot + && (not _funcIisPred || _argIisQuLoc) + ) ) + ) && _isQuLocExtraHook + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 71, column 17) + _lhsOisQuLoc = + if _isArrowArg then _argIisQuLoc else _isQuLoc + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 103, column 17) + _qHereTvS = + if _isQuLoc + then if _appIsArrow || _appIsLikeProd + then Set.unions [tvarSOccurGE2 _frTvSL, _frRowTvS, _qOrphanTvS] + else _frTvS + else Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 120, column 17) + _qOrphanTvS = + _argIqOrphanTvS `Set.union` _funcIqOrphanTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 124, column 17) + _lhsOqOrphanTvS = + if _isSpineRoot && _isQuLoc then Set.empty else _qOrphanTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 143, column 17) + _lhsOqInsideTvS = + _qHereTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 152, column 17) + _qSurrTvS = + _qHereTvS `Set.union` _lhsIqSurrTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 5, column 17) + _appFunNm = + _funcIappFunNm + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 16, column 17) + _appIsArrow = + hsnIsArrow _funcIappFunNm + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 16, column 17) + _appIsOther = + not (_appIsArrow || _appIsLikeProd) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 21, column 17) + _appIsRec = + hsnIsRec _funcIappFunNm + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 21, column 17) + _appIsSum = + hsnIsSum _funcIappFunNm + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 21, column 17) + _appIsRecOrSum = + _appIsRec || _appIsSum + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 21, column 17) + _appIsLikeProd = + hsnIsProd _funcIappFunNm || _appIsRec + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 45, column 17) + _argIsRow = + _isSpineRoot && _appIsRecOrSum + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 46, column 17) + _argOisRow = + _argIsRow + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 61, column 17) + _funcOappSpinePos = + _lhsIappSpinePos + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 62, column 17) + _argOappSpinePos = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 84, column 17) + _isSpineRoot = + _lhsIappSpinePos == 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 90, column 17) + _isArrowRoot = + _appIsArrow && _isSpineRoot + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 90, column 17) + _isArrowArg = + _appIsArrow && _lhsIappSpinePos == 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 90, column 17) + _isProdRoot = + _appIsLikeProd && _isSpineRoot + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 97, column 17) + _lhsOisArrow = + _isArrowRoot + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 103, column 17) + _tyCtxt = + if _appIsArrow then TyQuCtxtArrow + else if _appIsLikeProd then TyQuCtxtProd + else TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 115, column 17) + _lhsOisPred = + if _isArrowArg then _argIisPred else False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 84, column 17) + _lhsOmbImpls = + if _isArrowArg then _argImbImpls else Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 94, column 33) + __tup2 = + maybe ([],Nothing) implsPredsMbTail _funcImbImpls + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 94, column 33) + (_implsPrL,_) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 94, column 33) + (_,_mbTail) = + __tup2 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 95, column 17) + _argOmbPrLoc = + _mbTail + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 96, column 17) + _funcOmbPrLoc = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 112, column 17) + __tup3 = + if _isSpineRoot + then if _appIsArrow + then let (h,r) = prLLArrowSplit (_frTvSL !! 1 `Set.union` _lhsIqSurrTvS) _lhsIprLL + in (h,[],r) + else let (h,_) = prLLArrowSplit (_frTvS `Set.union` _lhsIqSurrTvS) _lhsIprLL + in (h,[],[]) + else ([],[],[]) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 112, column 17) + (_herePrL,_,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 112, column 17) + (_,_funcOprLL,_) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 112, column 17) + (_,_,_argOprLL) = + __tup3 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 128, column 17) + _candPrL = + _herePrL ++ _funcIinsPrL ++ _argIinsPrL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + __tup4 = + case _lhsImbPrLoc of + Just (Impls_Tail _ ipos) + -> (toInsPrPrvOcc _candPrL ipos,[]) + _ -> ([],_candPrL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + (_insHerePrL,_) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + (_,_lhsOinsPrL) = + __tup4 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 134, column 17) + _forPrTyOccL = + _implsPrL ++ _insHerePrL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 139, column 17) + _insPrIdSet = + Set.fromList (map (poPoi . fst) _insHerePrL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 140, column 17) + _lhsOinsPrIdSet = + _insPrIdSet `Set.union` _funcIinsPrIdSet `Set.union` _argIinsPrIdSet + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 162, column 17) + _lhsOprImpls = + prOccLImpls _lhsImbPrLoc _insHerePrL ++ _argIprImpls + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 173, column 17) + _lhsOprvReqs = + prOccLPrvReqs _lhsImbPrLoc _insHerePrL ++ _funcIprvReqs ++ _argIprvReqs + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 181, column 17) + _prTy = + mkTyImpls (map (poPr . fst) _forPrTyOccL) $ maybe (Ty_App _funcIprTy _argIprTy) (const _argIprTy) _funcImbImpls + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _funcIgathFxTvM `Map.union` _argIgathFxTvM + -- self rule + _self = + Ty_App _funcIself _argIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (from local) + _lhsOappFunNm = + _appFunNm + -- copy rule (down) + _funcOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _funcOisAtTop = + _isAtTop + -- copy rule (down) + _funcOisRow = + _lhsIisRow + -- copy rule (down) + _funcOprImpls = + _lhsIprImpls + -- copy rule (from local) + _funcOqSurrTvS = + _qSurrTvS + -- copy rule (from local) + _funcOtyCtxt = + _tyCtxt + -- copy rule (down) + _argOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _argOisAtTop = + _isAtTop + -- copy rule (chain) + _argOprImpls = + _funcIprImpls + -- copy rule (from local) + _argOqSurrTvS = + _qSurrTvS + -- copy rule (from local) + _argOtyCtxt = + _tyCtxt + ( _funcIappFunNm,_funcIfrTvSL,_funcIgathFxTvM,_funcIinsPrIdSet,_funcIinsPrL,_funcIisArrow,_funcIisPred,_funcIisQuLoc,_funcImbImpls,_funcIprImpls,_funcIprTy,_funcIprvReqs,_funcIqInsideTvS,_funcIqOrphanTvS,_funcIself) = + func_ _funcOappSpinePos _funcOfxTvM _funcOisAtTop _funcOisRow _funcOmbPrLoc _funcOpol _funcOprImpls _funcOprLL _funcOqSurrTvS _funcOtyCtxt + ( _argIappFunNm,_argIfrTvSL,_argIgathFxTvM,_argIinsPrIdSet,_argIinsPrL,_argIisArrow,_argIisPred,_argIisQuLoc,_argImbImpls,_argIprImpls,_argIprTy,_argIprvReqs,_argIqInsideTvS,_argIqOrphanTvS,_argIself) = + arg_ _argOappSpinePos _argOfxTvM _argOisAtTop _argOisRow _argOmbPrLoc _argOpol _argOprImpls _argOprLL _argOqSurrTvS _argOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _tyOappSpinePos :: Int + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOpol :: Polarity + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _annIprTy :: TyAnn + _annIself :: TyAnn + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _tyIfrTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _tyIisQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Ty_Ann _annIprTy _tyIprTy + -- self rule + _self = + Ty_Ann _annIself _tyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (down) + _tyOappSpinePos = + _lhsIappSpinePos + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _tyOisAtTop = + _isAtTop + -- copy rule (from local) + _tyOisRow = + _isRow + -- copy rule (from local) + _tyOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _tyOpol = + _lhsIpol + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _tyOtyCtxt = + _tyCtxt + ( _annIprTy,_annIself) = + ann_ + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Ty_Dbg info_ + -- self rule + _self = + Ty_Dbg info_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 14, column 17) + _frTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 17, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + Map.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + Set.empty + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Ty_Any + -- self rule + _self = + Ty_Any + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (chain) + _lhsOprImpls = + _lhsIprImpls + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _frTvS :: TyVarIdS + _lhsOfrTvSL :: ([TyVarIdS]) + _isQuLoc :: Bool + _lhsOqOrphanTvS :: TyVarIdS + _lhsOgathFxTvM :: TvCatMp + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOinsPrL :: ([PredOcc]) + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOprvReqs :: PrvReqs + _lhsOprTy :: Ty + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOisQuLoc :: Bool + _lhsOqInsideTvS :: TyVarIdS + _lhsOself :: Ty + _categIprTy :: TyVarCateg + _categIself :: TyVarCateg + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 7, column 17) + _frTvS = + if tvCatIsPlain _categIself then Set.singleton tv_ else Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 17, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 62, column 17) + _isQuLoc = + polIsCovariant _lhsIpol && _isQuLocExtraHook + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 92, column 17) + _qHereTvS = + if _isQuLoc then _frTvS else Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 125, column 17) + _lhsOqOrphanTvS = + if _isQuLoc then Set.empty else _frTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 152, column 17) + _qSurrTvS = + _qHereTvS `Set.union` _lhsIqSurrTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 158, column 17) + _lhsOgathFxTvM = + tv_ `Map.singleton` mkTvInfoTy _categIself + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 97, column 17) + _implsPrL = + [] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 111, column 33) + __tup5 = + prLLArrowSplit _qSurrTvS _lhsIprLL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 111, column 33) + (_herePrL,_) = + __tup5 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 129, column 17) + _candPrL = + _herePrL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + __tup6 = + case _lhsImbPrLoc of + Just (Impls_Tail _ ipos) + -> (toInsPrPrvOcc _candPrL ipos,[]) + _ -> ([],_candPrL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + (_insHerePrL,_) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 130, column 17) + (_,_lhsOinsPrL) = + __tup6 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 134, column 17) + _forPrTyOccL = + _implsPrL ++ _insHerePrL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 139, column 17) + _insPrIdSet = + Set.fromList (map (poPoi . fst) _insHerePrL) + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 163, column 17) + _lhsOprImpls = + prOccLImpls _lhsImbPrLoc _insHerePrL ++ _lhsIprImpls + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 174, column 17) + _lhsOprvReqs = + prOccLPrvReqs _lhsImbPrLoc _insHerePrL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 180, column 17) + _lhsOprTy = + mkTyImpls (map (poPr . fst) _forPrTyOccL) $ Ty_Var tv_ _categIprTy + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _insPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _isQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + Set.empty + -- self rule + _prTy = + Ty_Var tv_ _categIprTy + -- self rule + _self = + Ty_Var tv_ _categIself + -- self rule + _lhsOself = + _self + ( _categIprTy,_categIself) = + categ_ + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _frTvS :: TyVarIdS + _lhsOfrTvSL :: ([TyVarIdS]) + _isQuLoc :: Bool + _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _tyOappSpinePos :: Int + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _introTVarS :: TyVarIdS + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOpol :: Polarity + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _quIprTy :: TyQu + _quIself :: TyQu + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 13, column 17) + _frTvS = + head _tyIfrTvSL `Set.difference` _introTVarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 17, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 63, column 17) + _isQuLoc = + not (polIsInvariant _lhsIpol) && _isQuLocExtraHook + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 92, column 17) + _qHereTvS = + if _isQuLoc then _frTvS else Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 152, column 17) + _qSurrTvS = + _qHereTvS `Set.union` _lhsIqSurrTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 65, column 17) + _tyOappSpinePos = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 130, column 17) + _introTVarL = + [tv_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 130, column 17) + _introTVarS = + Set.singleton tv_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _isQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Ty_TBind _quIprTy tv_ l1_ _tyIprTy + -- self rule + _self = + Ty_TBind _quIself tv_ l1_ _tyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _tyOisAtTop = + _isAtTop + -- copy rule (from local) + _tyOisRow = + _isRow + -- copy rule (from local) + _tyOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _tyOpol = + _lhsIpol + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (from local) + _tyOqSurrTvS = + _qSurrTvS + -- copy rule (from local) + _tyOtyCtxt = + _tyCtxt + ( _quIprTy,_quIself) = + qu_ + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _appFunNm :: HsName + _tyOappSpinePos :: Int + _extTyOappSpinePos :: Int + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOappFunNm :: HsName + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOpol :: Polarity + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _extTyOfxTvM :: TvCatMp + _extTyOisAtTop :: Bool + _extTyOisRow :: Bool + _extTyOmbPrLoc :: (Maybe Impls) + _extTyOpol :: Polarity + _extTyOprImpls :: (AssocL ImplsVarId Impls) + _extTyOprLL :: ([[PredOcc]]) + _extTyOqSurrTvS :: TyVarIdS + _extTyOtyCtxt :: TyQuCtxt + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + _extTyIappFunNm :: HsName + _extTyIfrTvSL :: ([TyVarIdS]) + _extTyIgathFxTvM :: TvCatMp + _extTyIinsPrIdSet :: (Set.Set PredOccId) + _extTyIinsPrL :: ([PredOcc]) + _extTyIisArrow :: Bool + _extTyIisPred :: Bool + _extTyIisQuLoc :: Bool + _extTyImbImpls :: (Maybe Impls) + _extTyIprImpls :: (AssocL ImplsVarId Impls) + _extTyIprTy :: Ty + _extTyIprvReqs :: PrvReqs + _extTyIqInsideTvS :: TyVarIdS + _extTyIqOrphanTvS :: TyVarIdS + _extTyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 20, column 17) + _frTvSL = + _extTyIfrTvSL ++ _tyIfrTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 121, column 17) + _qOrphanTvS = + _extTyIqOrphanTvS `Set.union` _tyIqOrphanTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 8, column 17) + _appFunNm = + _tyIappFunNm + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 68, column 17) + _tyOappSpinePos = + _lhsIappSpinePos + 1 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 69, column 17) + _extTyOappSpinePos = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 84, column 17) + _isSpineRoot = + _lhsIappSpinePos == 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 1, column 25) + _lhsOfrTvSL = + _frTvSL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM `Map.union` _extTyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet `Set.union` _extTyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL ++ _extTyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _tyIisQuLoc && _extTyIisQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs ++ _extTyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS `Set.union` _extTyIqInsideTvS + -- self rule + _prTy = + Ty_Ext _tyIprTy nm_ _extTyIprTy + -- self rule + _self = + Ty_Ext _tyIself nm_ _extTyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (from local) + _lhsOappFunNm = + _appFunNm + -- copy rule (up) + _lhsOprImpls = + _extTyIprImpls + -- copy rule (from local) + _lhsOqOrphanTvS = + _qOrphanTvS + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _tyOisAtTop = + _isAtTop + -- copy rule (from local) + _tyOisRow = + _isRow + -- copy rule (from local) + _tyOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _tyOpol = + _lhsIpol + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _tyOtyCtxt = + _tyCtxt + -- copy rule (down) + _extTyOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _extTyOisAtTop = + _isAtTop + -- copy rule (from local) + _extTyOisRow = + _isRow + -- copy rule (from local) + _extTyOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _extTyOpol = + _lhsIpol + -- copy rule (chain) + _extTyOprImpls = + _tyIprImpls + -- copy rule (down) + _extTyOprLL = + _lhsIprLL + -- copy rule (down) + _extTyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _extTyOtyCtxt = + _tyCtxt + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + ( _extTyIappFunNm,_extTyIfrTvSL,_extTyIgathFxTvM,_extTyIinsPrIdSet,_extTyIinsPrL,_extTyIisArrow,_extTyIisPred,_extTyIisQuLoc,_extTyImbImpls,_extTyIprImpls,_extTyIprTy,_extTyIprvReqs,_extTyIqInsideTvS,_extTyIqOrphanTvS,_extTyIself) = + extTy_ _extTyOappSpinePos _extTyOfxTvM _extTyOisAtTop _extTyOisRow _extTyOmbPrLoc _extTyOpol _extTyOprImpls _extTyOprLL _extTyOqSurrTvS _extTyOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _frTvS :: TyVarIdS + _lhsOfrTvSL :: ([TyVarIdS]) + _prOpol :: Polarity + _isQuLoc :: Bool + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _prOfxTvM :: TvCatMp + _prOisAtTop :: Bool + _prOisRow :: Bool + _prOmbPrLoc :: (Maybe Impls) + _prOprImpls :: (AssocL ImplsVarId Impls) + _prOprLL :: ([[PredOcc]]) + _prOqSurrTvS :: TyVarIdS + _prOtyCtxt :: TyQuCtxt + _prIfrTvSL :: ([TyVarIdS]) + _prIgathFxTvM :: TvCatMp + _prIinsPrIdSet :: (Set.Set PredOccId) + _prIinsPrL :: ([PredOcc]) + _prIprImpls :: (AssocL ImplsVarId Impls) + _prIprTy :: Pred + _prIprvReqs :: PrvReqs + _prIqInsideTvS :: TyVarIdS + _prIqOrphanTvS :: TyVarIdS + _prIself :: Pred + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 27, column 17) + _frTvS = + Set.unions _prIfrTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 29, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 52, column 17) + _prOpol = + polInvariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 74, column 17) + _isQuLoc = + polIsCovariant _lhsIpol && _isQuLocExtraHook + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 108, column 17) + _qHereTvS = + _frTvS `Set.difference` _prIqInsideTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 114, column 17) + _lhsOisPred = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _prIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _prIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _prIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _isQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _prIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _prIqInsideTvS + -- self rule + _prTy = + Ty_Pred _prIprTy + -- self rule + _self = + Ty_Pred _prIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _prIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _prIqOrphanTvS + -- copy rule (down) + _prOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _prOisAtTop = + _isAtTop + -- copy rule (from local) + _prOisRow = + _isRow + -- copy rule (from local) + _prOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _prOprImpls = + _lhsIprImpls + -- copy rule (down) + _prOprLL = + _lhsIprLL + -- copy rule (down) + _prOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _prOtyCtxt = + _tyCtxt + ( _prIfrTvSL,_prIgathFxTvM,_prIinsPrIdSet,_prIinsPrL,_prIprImpls,_prIprTy,_prIprvReqs,_prIqInsideTvS,_prIqOrphanTvS,_prIself) = + pr_ _prOfxTvM _prOisAtTop _prOisRow _prOmbPrLoc _prOpol _prOprImpls _prOprLL _prOqSurrTvS _prOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOqOrphanTvS :: TyVarIdS + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _introTVarS :: TyVarIdS + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _tyOappSpinePos :: Int + _tyOfxTvM :: TvCatMp + _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOmbPrLoc :: (Maybe Impls) + _tyOpol :: Polarity + _tyOprImpls :: (AssocL ImplsVarId Impls) + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyOtyCtxt :: TyQuCtxt + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 13, column 17) + _frTvS = + head _tyIfrTvSL `Set.difference` _introTVarS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 17, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 129, column 17) + _lhsOqOrphanTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 117, column 17) + _lhsOisPred = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 130, column 17) + _introTVarL = + [tv_] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 130, column 17) + _introTVarS = + Set.singleton tv_ + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 86, column 17) + _lhsOmbImpls = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _tyIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _tyIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + _tyIisQuLoc + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _tyIqInsideTvS + -- self rule + _prTy = + Ty_Lam tv_ _tyIprTy + -- self rule + _self = + Ty_Lam tv_ _tyIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (down) + _tyOappSpinePos = + _lhsIappSpinePos + -- copy rule (down) + _tyOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _tyOisAtTop = + _isAtTop + -- copy rule (from local) + _tyOisRow = + _isRow + -- copy rule (from local) + _tyOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _tyOpol = + _lhsIpol + -- copy rule (down) + _tyOprImpls = + _lhsIprImpls + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (down) + _tyOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _tyOtyCtxt = + _tyCtxt + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsIappSpinePos + _lhsIfxTvM + _lhsIisAtTop + _lhsIisRow + _lhsImbPrLoc + _lhsIpol + _lhsIprImpls + _lhsIprLL + _lhsIqSurrTvS + _lhsItyCtxt -> + (let _lhsOfrTvSL :: ([TyVarIdS]) + _lhsOappFunNm :: HsName + _lhsOisArrow :: Bool + _lhsOisPred :: Bool + _lhsOmbImpls :: (Maybe Impls) + _lhsOgathFxTvM :: TvCatMp + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOinsPrL :: ([PredOcc]) + _lhsOisQuLoc :: Bool + _lhsOprvReqs :: PrvReqs + _lhsOqInsideTvS :: TyVarIdS + _lhsOprTy :: Ty + _lhsOself :: Ty + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOqOrphanTvS :: TyVarIdS + _implsOfxTvM :: TvCatMp + _implsOisAtTop :: Bool + _implsOisRow :: Bool + _implsOmbPrLoc :: (Maybe Impls) + _implsOpol :: Polarity + _implsOprImpls :: (AssocL ImplsVarId Impls) + _implsOprLL :: ([[PredOcc]]) + _implsOqSurrTvS :: TyVarIdS + _implsOtyCtxt :: TyQuCtxt + _implsIfrTvSL :: ([TyVarIdS]) + _implsIgathFxTvM :: TvCatMp + _implsIinsPrIdSet :: (Set.Set PredOccId) + _implsIinsPrL :: ([PredOcc]) + _implsIprImpls :: (AssocL ImplsVarId Impls) + _implsIprTy :: Impls + _implsIprvReqs :: PrvReqs + _implsIqInsideTvS :: TyVarIdS + _implsIqOrphanTvS :: TyVarIdS + _implsIself :: Impls + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 28, column 17) + _frTvS = + Set.unions _implsIfrTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 29, column 17) + _lhsOfrTvSL = + [_frTvS] + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 10, column 17) + _lhsOappFunNm = + hsnUnknown + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 37, column 17) + _isAtTop = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 47, column 17) + _isRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 98, column 17) + _lhsOisArrow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 106, column 17) + _tyCtxt = + TyQuCtxtOther + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 114, column 17) + _lhsOisPred = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 73, column 17) + _isQuLocExtraHook = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 83, column 17) + _lhsOmbImpls = + Just _implsIprTy + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 99, column 17) + _mbPrLoc = + Nothing + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 154, column 28) + _lhsOgathFxTvM = + _implsIgathFxTvM + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _implsIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 125, column 25) + _lhsOinsPrL = + _implsIinsPrL + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 59, column 23) + _lhsOisQuLoc = + False + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _implsIprvReqs + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 140, column 29) + _lhsOqInsideTvS = + _implsIqInsideTvS + -- self rule + _prTy = + Ty_Impls _implsIprTy + -- self rule + _self = + Ty_Impls _implsIself + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + -- copy rule (up) + _lhsOprImpls = + _implsIprImpls + -- copy rule (up) + _lhsOqOrphanTvS = + _implsIqOrphanTvS + -- copy rule (down) + _implsOfxTvM = + _lhsIfxTvM + -- copy rule (from local) + _implsOisAtTop = + _isAtTop + -- copy rule (from local) + _implsOisRow = + _isRow + -- copy rule (from local) + _implsOmbPrLoc = + _mbPrLoc + -- copy rule (down) + _implsOpol = + _lhsIpol + -- copy rule (down) + _implsOprImpls = + _lhsIprImpls + -- copy rule (down) + _implsOprLL = + _lhsIprLL + -- copy rule (down) + _implsOqSurrTvS = + _lhsIqSurrTvS + -- copy rule (from local) + _implsOtyCtxt = + _tyCtxt + ( _implsIfrTvSL,_implsIgathFxTvM,_implsIinsPrIdSet,_implsIinsPrL,_implsIprImpls,_implsIprTy,_implsIprvReqs,_implsIqInsideTvS,_implsIqOrphanTvS,_implsIself) = + impls_ _implsOfxTvM _implsOisAtTop _implsOisRow _implsOmbPrLoc _implsOpol _implsOprImpls _implsOprLL _implsOqSurrTvS _implsOtyCtxt + in ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOinsPrIdSet,_lhsOinsPrL,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOmbImpls,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs,_lhsOqInsideTvS,_lhsOqOrphanTvS,_lhsOself))) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + prLL : [[PredOcc]] + synthesized attributes: + insPrIdSet : Set.Set PredOccId + prImpls : AssocL ImplsVarId Impls + prTy : Ty + prvReqs : PrvReqs + alternatives: + alternative AGItf: + child ty : Ty + visit 0: + local frTvS : _ + local qHereTvS : _ + local qSurrTvS : _ + local fxTvM : _ +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = ([[PredOcc]]) -> + ( (Set.Set PredOccId),(AssocL ImplsVarId Impls),Ty,PrvReqs) +data Inh_TyAGItf = Inh_TyAGItf {prLL_Inh_TyAGItf :: !(([[PredOcc]]))} +data Syn_TyAGItf = Syn_TyAGItf {insPrIdSet_Syn_TyAGItf :: !((Set.Set PredOccId)),prImpls_Syn_TyAGItf :: !((AssocL ImplsVarId Impls)),prTy_Syn_TyAGItf :: !(Ty),prvReqs_Syn_TyAGItf :: !(PrvReqs)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIprLL) = + (let ( _lhsOinsPrIdSet,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs) = sem _lhsIprLL + in (Syn_TyAGItf _lhsOinsPrIdSet _lhsOprImpls _lhsOprTy _lhsOprvReqs)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIprLL -> + (let _tyOisAtTop :: Bool + _tyOisRow :: Bool + _tyOappSpinePos :: Int + _tyOtyCtxt :: TyQuCtxt + _tyOpol :: Polarity + _tyOmbPrLoc :: (Maybe Impls) + _tyOprImpls :: (AssocL ImplsVarId Impls) + _lhsOinsPrIdSet :: (Set.Set PredOccId) + _lhsOprvReqs :: PrvReqs + _lhsOprImpls :: (AssocL ImplsVarId Impls) + _lhsOprTy :: Ty + _tyOfxTvM :: TvCatMp + _tyOprLL :: ([[PredOcc]]) + _tyOqSurrTvS :: TyVarIdS + _tyIappFunNm :: HsName + _tyIfrTvSL :: ([TyVarIdS]) + _tyIgathFxTvM :: TvCatMp + _tyIinsPrIdSet :: (Set.Set PredOccId) + _tyIinsPrL :: ([PredOcc]) + _tyIisArrow :: Bool + _tyIisPred :: Bool + _tyIisQuLoc :: Bool + _tyImbImpls :: (Maybe Impls) + _tyIprImpls :: (AssocL ImplsVarId Impls) + _tyIprTy :: Ty + _tyIprvReqs :: PrvReqs + _tyIqInsideTvS :: TyVarIdS + _tyIqOrphanTvS :: TyVarIdS + _tyIself :: Ty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 4, column 17) + _frTvS = + head _tyIfrTvSL + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 89, column 17) + _qHereTvS = + Set.empty + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 148, column 17) + _qSurrTvS = + _qHereTvS + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/TyVarCommon.ag"(line 161, column 17) + _fxTvM = + _tyIgathFxTvM + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 34, column 17) + _tyOisAtTop = + True + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 42, column 17) + _tyOisRow = + False + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 58, column 17) + _tyOappSpinePos = + 0 + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/CommonAG.ag"(line 109, column 17) + _tyOtyCtxt = + TyQuCtxtOnTop + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 77, column 17) + _tyOpol = + polCovariant + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 91, column 17) + _tyOmbPrLoc = + Nothing + -- "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 159, column 17) + _tyOprImpls = + [] + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 136, column 37) + _lhsOinsPrIdSet = + _tyIinsPrIdSet + -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/MergePreds.ag"(line 170, column 34) + _lhsOprvReqs = + _tyIprvReqs + -- copy rule (up) + _lhsOprImpls = + _tyIprImpls + -- copy rule (up) + _lhsOprTy = + _tyIprTy + -- copy rule (from local) + _tyOfxTvM = + _fxTvM + -- copy rule (down) + _tyOprLL = + _lhsIprLL + -- copy rule (from local) + _tyOqSurrTvS = + _qSurrTvS + ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIinsPrIdSet,_tyIinsPrL,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyImbImpls,_tyIprImpls,_tyIprTy,_tyIprvReqs,_tyIqInsideTvS,_tyIqOrphanTvS,_tyIself) = + ty_ _tyOappSpinePos _tyOfxTvM _tyOisAtTop _tyOisRow _tyOmbPrLoc _tyOpol _tyOprImpls _tyOprLL _tyOqSurrTvS _tyOtyCtxt + in ( _lhsOinsPrIdSet,_lhsOprImpls,_lhsOprTy,_lhsOprvReqs))) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + prTy : TyAnn + self : TyAnn + alternatives: + alternative Empty: + visit 0: + local prTy : _ + local self : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local prTy : _ + local self : _ + alternative Mono: + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( TyAnn,TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (let _lhsOprTy :: TyAnn + _lhsOself :: TyAnn + -- self rule + _prTy = + TyAnn_Empty + -- self rule + _self = + TyAnn_Empty + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (let _lhsOprTy :: TyAnn + _lhsOself :: TyAnn + -- self rule + _prTy = + TyAnn_Strictness s_ + -- self rule + _self = + TyAnn_Strictness s_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (let _lhsOprTy :: TyAnn + _lhsOself :: TyAnn + -- self rule + _prTy = + TyAnn_Mono + -- self rule + _self = + TyAnn_Mono + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +-- TyQu -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + prTy : TyQu + self : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local prTy : _ + local self : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local prTy : _ + local self : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( TyQu,TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (let _lhsOprTy :: TyQu + _lhsOself :: TyQu + -- self rule + _prTy = + TyQu_Forall mlev_ + -- self rule + _self = + TyQu_Forall mlev_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (let _lhsOprTy :: TyQu + _lhsOself :: TyQu + -- self rule + _prTy = + TyQu_Exists mlev_ + -- self rule + _self = + TyQu_Exists mlev_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (let _lhsOprTy :: TyQu + _lhsOself :: TyQu + -- self rule + _prTy = + TyQu_Plain mlev_ + -- self rule + _self = + TyQu_Plain mlev_ + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attributes: + prTy : TyVarCateg + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local prTy : _ + local self : _ + alternative Fixed: + visit 0: + local prTy : _ + local self : _ + alternative Meta: + visit 0: + local prTy : _ + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( TyVarCateg,TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (let _lhsOprTy :: TyVarCateg + _lhsOself :: TyVarCateg + -- self rule + _prTy = + TyVarCateg_Plain + -- self rule + _self = + TyVarCateg_Plain + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (let _lhsOprTy :: TyVarCateg + _lhsOself :: TyVarCateg + -- self rule + _prTy = + TyVarCateg_Fixed + -- self rule + _self = + TyVarCateg_Fixed + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (let _lhsOprTy :: TyVarCateg + _lhsOself :: TyVarCateg + -- self rule + _prTy = + TyVarCateg_Meta + -- self rule + _self = + TyVarCateg_Meta + -- self rule + _lhsOprTy = + _prTy + -- self rule + _lhsOself = + _self + in ( _lhsOprTy,_lhsOself)) diff --git a/src/UHC/Light/Compiler/Ty/Trf/Quantify.hs b/src/UHC/Light/Compiler/Ty/Trf/Quantify.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/Quantify.hs @@ -0,0 +1,2977 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/Quantif) +module UHC.Light.Compiler.Ty.Trf.Quantify(tyQuantify +, TyQuOpts (..), defaultTyQuOpts +, TyQuOut (..) +, tyQuantifyOuter +, tyKiQuantify, valTyQuantify +, tyQuantifyClosed, tyQuantifyRank, tyQuantifyRank') where + +import UHC.Util.Utils +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import qualified Data.Set as Set +import qualified Data.Map as Map +import Data.List as List +import Data.Maybe +import UHC.Util.Utils +import UHC.Util.Pretty + + + +tvarSOccurCount :: [TyVarIdS] -> AssocL TyVarId Int +tvarSOccurCount = map (\vl@(v:_) -> (v,length vl)) . group . sort . concat . map Set.toList + +tvarSOccurGE2 :: [TyVarIdS] -> TyVarIdS +tvarSOccurGE2 = Set.fromList . map fst . filter ((>1).snd) . tvarSOccurCount + + + +data TyQuCtxt = TyQuCtxtArrow | TyQuCtxtProd | TyQuCtxtOnTop | TyQuCtxtOther deriving (Show,Eq) + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + + + +tyQuantifyClosed :: Ty -> Ty +tyQuantifyClosed = tyQuantifyRank [1..] + +tyQuantifyRank' :: TvIsBound -> [Int] -> Ty -> Ty +tyQuantifyRank' tvIsBound rL ty + = tqoTy (tyQuantifyWithOpts (defaultTyQuOpts {tqoptQuRanks = rL, tqoptBaseQuant = tyQu_Forall, tqoptTvIsBound = tvIsBound}) ty) + +tyQuantifyRank :: [Int] -> Ty -> Ty +tyQuantifyRank = tyQuantifyRank' (const False) + + + +tyQuantify :: TvIsBound -> Ty -> Ty +tyQuantify tvIsBound ty = tyQuantify' tvIsBound tyQu_Forall ty + + + +tyQuantifyOuter :: (TyVarId -> Ty) -> TvIsBound -> Ty -> Ty +tyQuantifyOuter tvKi tvIsBound ty + = tqoTy tqo + where tqo = tyQuantifyWithOpts + (defaultTyQuOpts + { tqoptAllowInnerQuant = False + , tqoptTvIsBound = tvIsBound + , tqoptBaseQuant = tyQu_Forall + , tqoptTvL1 = tvKi + } + ) + ty + + + +-- | Quantify kind, i.e. add universal quantifier for free tvars when kind polymorphism is allowed, otherwise just * +tyKiQuantify + :: Bool -- ^ kind polymorphism on (for inference steered by PolyKinds pragma) + -> TvIsBound + -> Ty + -> Ty +tyKiQuantify polyKinds tvIsBound ty -- = tyQuantify' tvIsBound tyQu_Forall {- tyQu_KiForall -} ty + = tqoTy $ tyQuantifyWithOpts opts ty + where opts = defaultTyQuOpts + { tqoptAllowInnerQuant = False + , tqoptTvIsBound = tvIsBound + , tqoptBaseQuant = tyQu_Forall + , tqoptQuantVarDefaultsTo = if polyKinds then Nothing else Just kiStar + } + +valTyQuantify :: (TyVarId -> Ty) -> TvIsBound -> Ty -> Ty +valTyQuantify tvKi tvIsBound ty + = tqoTy $ tyQuantifyWithOpts opts ty + where opts = defaultTyQuOpts + { tqoptAllowInnerQuant = False + , tqoptTvIsBound = tvIsBound + , tqoptTvL1 = tvKi + } + + + +tyQuantify' :: TvIsBound -> TyQu -> Ty -> Ty +tyQuantify' tvIsBound baseQuant ty + = tqoTy tqo + where tqo = tyQuantifyWithOpts + (defaultTyQuOpts + { tqoptTvIsBound = tvIsBound + , tqoptBaseQuant = baseQuant + } + ) + ty + + + +data TyQuOpts + = TyQuOpts + { tqoptTvIsBound :: TvIsBound + , tqoptQuantVarDefaultsTo :: !(Maybe Ty) -- ^ if provided, not quantification takes place but var defaults to this + , tqoptAllowInnerQuant :: !Bool + , tqoptBaseQuant :: !TyQu + , tqoptTvL1 :: TyVarId -> Ty -- ^ mapping of tvar to 1 higher metalevel ty (i.e. kind) + , tqoptQuRanks :: [Int] + } + +defaultTyQuOpts :: TyQuOpts +defaultTyQuOpts + = TyQuOpts + (const False) + Nothing + True + tyQu_Forall + (const kiStar) + [1..] + + + +data TyQuOut + = TyQuOut { tqoTy :: Ty + } + + + +tyQuantifyWithOpts :: TyQuOpts -> Ty -> TyQuOut +tyQuantifyWithOpts opts ty + = let t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf { opts_Inh_TyAGItf = opts + , baseQu_Inh_TyAGItf = tqoptBaseQuant opts + }) + in TyQuOut + { tqoTy = quTy_Syn_TyAGItf t + } + + + +type TvIsBound = TyVarId -> Bool +type TvLevIsBound = MetaLev -> TvIsBound + +tvIsBound2L :: MetaLev -> TvIsBound -> TvLevIsBound +tvIsBound2L mlev b = \mlev' -> if mlev' == mlev then b else const False + +tvIsBound2L0, tvIsBound2L1 :: TvIsBound -> TvLevIsBound +tvIsBound2L0 = tvIsBound2L 0 +tvIsBound2L1 = tvIsBound2L 1 + + + +type TyVarIdsToBind = AssocL TyVarId Ty + + + +tvBoundAddS :: MetaLev -> TyVarIdS -> TvLevIsBound -> TvLevIsBound +tvBoundAddS mlev tvS tvIsBound = \mlev' v -> (mlev == mlev' && v `Set.member` tvS) || tvIsBound mlev' v + +tvNotBound :: MetaLev -> TvLevIsBound -> TyVarIdS -> TyVarIdS +tvNotBound mlev tvIsBound = Set.filter (\tv -> not (tvIsBound mlev tv)) + + + +tvarsToQuantL1 :: TyVarIdsToBind -> TvLevIsBound -> (TyVarIdsToBind,TyVarIdS,TvLevIsBound) +tvarsToQuantL1 boundablesL tvIsBound + = (boundablesL1L,boundablesL1S,tvBoundAddS 1 boundablesL1S tvIsBound) + where boundablesL1S = tvNotBound 1 tvIsBound $ Set.unions [ varFreeSet l1 | (_,l1) <- boundablesL ] + boundablesL1L = [ (v,kiStar) | v <- Set.toList boundablesL1S ] + + + +-- | Compute bindable tvars +tvarsToQuant + :: TyQuOpts + -> Bool + -> TvCatMp + -> (TyVarId -> Bool) + -> TvLevIsBound -- ^ 'is already bound?' + -> TyVarIdS + -> ( TyVarIdsToBind -- to bind universal, on this level + , TyVarIdsToBind -- to bind existential + , TyVarIdsToBind -- to bind universal, 1 level higher + , TvLevIsBound -- updated 'is already bound?' + , VarMp -- the tvars which are defaulted + ) +tvarsToQuant opts isQuLoc _ mayQuFx tvIsBound tvS + = if isQuLoc + then let boundablesS = tvNotBound 0 tvIsBound tvS + (boundablesL,boundablesL1L,tvIsBound',defaultedVarMp) + | isJust mbDf = ([] , [] , tvIsBound, assocTyLToVarMp [ (v,df) | (v,_) <- boundablesL ]) + | otherwise = (boundablesL, b1L, isb , emptyVarMp ) + where mbDf@(~(Just df)) = tqoptQuantVarDefaultsTo opts + (b1L,_,isb) = tvarsToQuantL1 boundablesL (tvBoundAddS 0 boundablesS tvIsBound) + boundablesL = [ (v, tqoptTvL1 opts v) | v <- Set.toList boundablesS ] + in ( boundablesL + , [] + , boundablesL1L + , tvIsBound' + , defaultedVarMp + ) + else ([],[],[],tvIsBound,emptyVarMp) + + + +tvMayQuFx :: TyQu -> TvCatMp -> Bool -> TyVarId -> Bool +tvMayQuFx qu fxTvM isQuFxLoc tv + = False -- isQuFxLoc -- True + + + +mkTyQuEx :: TyQuOpts -> TyQu -> TyVarIdsToBind -> TyVarIdsToBind-> TyVarIdsToBind -> Ty -> Ty +mkTyQuEx opts q tvsL1 tvs tvsEx t + = + mkTyQu (TyQu_Forall (tyquMetaLev q + 1)) tvsL1 $ + mkTyQu q tvs $ + mkTyQu (tyquExists q) tvsEx t + + + +mkTyQuForRank :: TyQuOpts -> Bool -> TyQu -> TyVarIdsToBind -> TyVarIdsToBind -> TyVarIdsToBind -> Ty -> Ty +mkTyQuForRank opts allow q tvsL1 tvs tvsEx t + | allow = mkTyQuEx opts q tvsL1 tvs tvsEx t + | otherwise = t + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + opts : TyQuOpts + pol : Polarity + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + visit 1: + inherited attributes: + baseQu : TyQu + defaultedVarMp : VarMp + fxTvM : TvCatMp + isRow : Bool + qSurrTvS : TyVarIdS + rank : Int + tvIsBound : TvLevIsBound + tyCtxt : TyQuCtxt + synthesized attributes: + quTy : Impls + self : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 1: + local quTy : _ + local self : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 1: + local quTy : _ + local self : _ + alternative Nil: + visit 1: + local quTy : _ + local self : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = Bool -> + TyQuOpts -> + Polarity -> + ( ([TyVarIdS]),TvCatMp,TyVarIdS,TyVarIdS,T_Impls_1) +type T_Impls_1 = TyQu -> + VarMp -> + TvCatMp -> + Bool -> + TyVarIdS -> + Int -> + TvLevIsBound -> + TyQuCtxt -> + ( Impls,Impls) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Impls_Tail_1 :: T_Impls_1 + sem_Impls_Tail_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Impls_Tail iv_ proveOccs_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Impls_Tail iv_ proveOccs_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Impls_Tail_1)) of + { ( sem_Impls_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Impls_1) }) }) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIpol) of + { _tlOpol -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (tl_ _tlOisAtTop _tlOopts _tlOpol) of + { ( _tlIfrTvSL,_tlIgathFxTvM,_tlIqInsideTvS,_tlIqOrphanTvS,tl_1) -> + (case (_lhsIpol) of + { _prOpol -> + (case (_lhsIopts) of + { _prOopts -> + (case (_lhsIisAtTop) of + { _prOisAtTop -> + (case (pr_ _prOisAtTop _prOopts _prOpol) of + { ( _prIfrTvSL,_prIgathFxTvM,_prIqInsideTvS,_prIqOrphanTvS,pr_1) -> + (case (_prIfrTvSL ++ _tlIfrTvSL) of + { _lhsOfrTvSL -> + (case (_prIgathFxTvM `Map.union` _tlIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_prIqInsideTvS `Set.union` _tlIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_prIqOrphanTvS `Set.union` _tlIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Impls_Cons_1 :: T_Impls_1 + sem_Impls_Cons_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsItvIsBound) of + { _tlOtvIsBound -> + (case (_lhsIrank) of + { _tlOrank -> + (case (_lhsIfxTvM) of + { _tlOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tlOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tlObaseQu -> + (case (_lhsItyCtxt) of + { _prOtyCtxt -> + (case (_lhsItvIsBound) of + { _prOtvIsBound -> + (case (_lhsIrank) of + { _prOrank -> + (case (_lhsIfxTvM) of + { _prOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _prOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _prObaseQu -> + (case (_lhsIqSurrTvS) of + { _tlOqSurrTvS -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (tl_1 _tlObaseQu _tlOdefaultedVarMp _tlOfxTvM _tlOisRow _tlOqSurrTvS _tlOrank _tlOtvIsBound _tlOtyCtxt) of + { ( _tlIquTy,_tlIself) -> + (case (_lhsIqSurrTvS) of + { _prOqSurrTvS -> + (case (_lhsIisRow) of + { _prOisRow -> + (case (pr_1 _prObaseQu _prOdefaultedVarMp _prOfxTvM _prOisRow _prOqSurrTvS _prOrank _prOtvIsBound _prOtyCtxt) of + { ( _prIquTy,_prIself) -> + (case (Impls_Cons iv_ _prIquTy pv_ prange_ proveOccs_ _tlIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Impls_Cons iv_ _prIself pv_ prange_ proveOccs_ _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Impls_Cons_1)) of + { ( sem_Impls_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Impls_1) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Impls_Nil_1 :: T_Impls_1 + sem_Impls_Nil_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Impls_Nil) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Impls_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Impls_Nil_1)) of + { ( sem_Impls_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Impls_1) }) }) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + quTy : Label + self : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local quTy : _ + local self : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local quTy : _ + local self : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( Label,Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (case (Label_Lab nm_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Label_Lab nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (case (Label_Var lv_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Label_Var lv_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + opts : TyQuOpts + pol : Polarity + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + visit 1: + inherited attributes: + baseQu : TyQu + defaultedVarMp : VarMp + fxTvM : TvCatMp + isRow : Bool + qSurrTvS : TyVarIdS + rank : Int + tvIsBound : TvLevIsBound + tyCtxt : TyQuCtxt + synthesized attributes: + quTy : Pred + self : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local appSpinePos : _ + visit 1: + local quTy : _ + local self : _ + alternative Pred: + child ty : Ty + visit 0: + local appSpinePos : _ + visit 1: + local quTy : _ + local self : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local appSpinePos : _ + visit 1: + local quTy : _ + local self : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 1: + local appSpinePos : _ + local quTy : _ + local self : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local appSpinePos : _ + visit 1: + local quTy : _ + local self : _ + alternative Var: + child pv : {TyVarId} + visit 1: + local quTy : _ + local self : _ + alternative Preds: + child seq : PredSeq + visit 1: + local appSpinePos : _ + local quTy : _ + local self : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = Bool -> + TyQuOpts -> + Polarity -> + ( ([TyVarIdS]),TvCatMp,TyVarIdS,TyVarIdS,T_Pred_1) +type T_Pred_1 = TyQu -> + VarMp -> + TvCatMp -> + Bool -> + TyVarIdS -> + Int -> + TvLevIsBound -> + TyQuCtxt -> + ( Pred,Pred) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (_lhsIopts) of + { _tyOopts -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (polInvariant) of + { _tyOpol -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIfrTvSL) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_tyIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Class_1 :: T_Pred_1 + sem_Pred_Class_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (Pred_Class _tyIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Class _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Class_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (_lhsIopts) of + { _tyOopts -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (polCovariant) of + { _tyOpol -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIfrTvSL) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_tyIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Pred_1 :: T_Pred_1 + sem_Pred_Pred_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (Pred_Pred _tyIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Pred _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Pred_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyOappSpinePos -> + (case (_lhsIpol) of + { _tyOpol -> + (case (_lhsIopts) of + { _tyOopts -> + (case (_lhsIisAtTop) of + { _tyOisAtTop -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIfrTvSL) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_tyIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Lacks_1 :: T_Pred_1 + sem_Pred_Lacks_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (lab_) of + { ( _labIquTy,_labIself) -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (_lhsIisRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (Pred_Lacks _tyIquTy _labIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Lacks _tyIself _labIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Lacks_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIpol) of + { _resOpol -> + (case (_lhsIopts) of + { _resOopts -> + (case (_lhsIisAtTop) of + { _resOisAtTop -> + (case (res_ _resOisAtTop _resOopts _resOpol) of + { ( _resIfrTvSL,_resIgathFxTvM,_resIqInsideTvS,_resIqOrphanTvS,res_1) -> + (case (_lhsIpol) of + { _argsOpol -> + (case (_lhsIopts) of + { _argsOopts -> + (case (_lhsIisAtTop) of + { _argsOisAtTop -> + (case (args_ _argsOisAtTop _argsOopts _argsOpol) of + { ( _argsIfrTvSL,_argsIgathFxTvM,_argsIqInsideTvS,args_1) -> + (case (_argsIfrTvSL ++ _resIfrTvSL) of + { _lhsOfrTvSL -> + (case (_argsIgathFxTvM `Map.union` _resIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_argsIqInsideTvS `Set.union` _resIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_resIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Arrow_1 :: T_Pred_1 + sem_Pred_Arrow_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _resOtyCtxt -> + (case (_lhsItvIsBound) of + { _resOtvIsBound -> + (case (_lhsIrank) of + { _resOrank -> + (case (_lhsIfxTvM) of + { _resOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _resOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _resObaseQu -> + (case (_lhsItyCtxt) of + { _argsOtyCtxt -> + (case (_lhsItvIsBound) of + { _argsOtvIsBound -> + (case (_lhsIrank) of + { _argsOrank -> + (case (_lhsIfxTvM) of + { _argsOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _argsOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _argsObaseQu -> + (case (_lhsIqSurrTvS) of + { _resOqSurrTvS -> + (case (_lhsIisRow) of + { _resOisRow -> + (case (res_1 _resObaseQu _resOdefaultedVarMp _resOfxTvM _resOisRow _resOqSurrTvS _resOrank _resOtvIsBound _resOtyCtxt) of + { ( _resIquTy,_resIself) -> + (case (_lhsIqSurrTvS) of + { _argsOqSurrTvS -> + (case (_lhsIisRow) of + { _argsOisRow -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _argsOappSpinePos -> + (case (args_1 _argsOappSpinePos _argsObaseQu _argsOdefaultedVarMp _argsOfxTvM _argsOisRow _argsOqSurrTvS _argsOrank _argsOtvIsBound _argsOtyCtxt) of + { ( _argsIquTy,_argsIself) -> + (case (Pred_Arrow _argsIquTy _resIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Arrow _argsIself _resIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Arrow_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _tyROappSpinePos -> + (case (_appSpinePos) of + { _tyLOappSpinePos -> + (case (_lhsIpol) of + { _tyROpol -> + (case (_lhsIopts) of + { _tyROopts -> + (case (_lhsIisAtTop) of + { _tyROisAtTop -> + (case (tyR_ _tyROappSpinePos _tyROisAtTop _tyROopts _tyROpol) of + { ( _tyRIappFunNm,_tyRIfrTvSL,_tyRIgathFxTvM,_tyRIisArrow,_tyRIisPred,_tyRIisQuLoc,_tyRIqInsideTvS,_tyRIqOrphanTvS,tyR_1) -> + (case (_lhsIpol) of + { _tyLOpol -> + (case (_lhsIopts) of + { _tyLOopts -> + (case (_lhsIisAtTop) of + { _tyLOisAtTop -> + (case (tyL_ _tyLOappSpinePos _tyLOisAtTop _tyLOopts _tyLOpol) of + { ( _tyLIappFunNm,_tyLIfrTvSL,_tyLIgathFxTvM,_tyLIisArrow,_tyLIisPred,_tyLIisQuLoc,_tyLIqInsideTvS,_tyLIqOrphanTvS,tyL_1) -> + (case (_tyLIfrTvSL ++ _tyRIfrTvSL) of + { _lhsOfrTvSL -> + (case (_tyLIgathFxTvM `Map.union` _tyRIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_tyLIqInsideTvS `Set.union` _tyRIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_tyRIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Eq_1 :: T_Pred_1 + sem_Pred_Eq_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tyROtyCtxt -> + (case (_lhsItvIsBound) of + { _tyROtvIsBound -> + (case (_lhsIrank) of + { _tyROrank -> + (case (_lhsIfxTvM) of + { _tyROfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyROdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyRObaseQu -> + (case (_lhsItyCtxt) of + { _tyLOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyLOtvIsBound -> + (case (_lhsIrank) of + { _tyLOrank -> + (case (_lhsIfxTvM) of + { _tyLOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyLOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyLObaseQu -> + (case (_lhsIqSurrTvS) of + { _tyROqSurrTvS -> + (case (_lhsIisRow) of + { _tyROisRow -> + (case (tyR_1 _tyRObaseQu _tyROdefaultedVarMp _tyROfxTvM _tyROisRow _tyROqSurrTvS _tyROrank _tyROtvIsBound _tyROtyCtxt) of + { ( _tyRIquTy,_tyRIself) -> + (case (_lhsIqSurrTvS) of + { _tyLOqSurrTvS -> + (case (_lhsIisRow) of + { _tyLOisRow -> + (case (tyL_1 _tyLObaseQu _tyLOdefaultedVarMp _tyLOfxTvM _tyLOisRow _tyLOqSurrTvS _tyLOrank _tyLOtvIsBound _tyLOtyCtxt) of + { ( _tyLIquTy,_tyLIself) -> + (case (Pred_Eq _tyLIquTy _tyRIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Eq _tyLIself _tyRIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Eq_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Var_1 :: T_Pred_1 + sem_Pred_Var_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Pred_Var pv_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Var pv_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Pred_Var_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIpol) of + { _seqOpol -> + (case (_lhsIopts) of + { _seqOopts -> + (case (_lhsIisAtTop) of + { _seqOisAtTop -> + (case (seq_ _seqOisAtTop _seqOopts _seqOpol) of + { ( _seqIfrTvSL,_seqIgathFxTvM,_seqIqInsideTvS,seq_1) -> + (case (_seqIfrTvSL) of + { _lhsOfrTvSL -> + (case (_seqIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_seqIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Pred_Preds_1 :: T_Pred_1 + sem_Pred_Preds_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _seqOtyCtxt -> + (case (_lhsItvIsBound) of + { _seqOtvIsBound -> + (case (_lhsIrank) of + { _seqOrank -> + (case (_lhsIfxTvM) of + { _seqOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _seqOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _seqObaseQu -> + (case (_lhsIqSurrTvS) of + { _seqOqSurrTvS -> + (case (_lhsIisRow) of + { _seqOisRow -> + (case (0) of + { _appSpinePos -> + (case (_appSpinePos) of + { _seqOappSpinePos -> + (case (seq_1 _seqOappSpinePos _seqObaseQu _seqOdefaultedVarMp _seqOfxTvM _seqOisRow _seqOqSurrTvS _seqOrank _seqOtvIsBound _seqOtyCtxt) of + { ( _seqIquTy,_seqIself) -> + (case (Pred_Preds _seqIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Pred_Preds _seqIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Pred_Preds_1)) of + { ( sem_Pred_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Pred_1) }) }) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + isAtTop : Bool + opts : TyQuOpts + pol : Polarity + synthesized attributes: + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + qInsideTvS : TyVarIdS + visit 1: + inherited attributes: + appSpinePos : Int + baseQu : TyQu + defaultedVarMp : VarMp + fxTvM : TvCatMp + isRow : Bool + qSurrTvS : TyVarIdS + rank : Int + tvIsBound : TvLevIsBound + tyCtxt : TyQuCtxt + synthesized attributes: + quTy : PredSeq + self : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 1: + local quTy : _ + local self : _ + alternative Nil: + visit 1: + local quTy : _ + local self : _ + alternative Var: + child av : {TyVarId} + visit 1: + local quTy : _ + local self : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Bool -> + TyQuOpts -> + Polarity -> + ( ([TyVarIdS]),TvCatMp,TyVarIdS,T_PredSeq_1) +type T_PredSeq_1 = Int -> + TyQu -> + VarMp -> + TvCatMp -> + Bool -> + TyVarIdS -> + Int -> + TvLevIsBound -> + TyQuCtxt -> + ( PredSeq,PredSeq) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIpol) of + { _tlOpol -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIisAtTop) of + { _tlOisAtTop -> + (case (tl_ _tlOisAtTop _tlOopts _tlOpol) of + { ( _tlIfrTvSL,_tlIgathFxTvM,_tlIqInsideTvS,tl_1) -> + (case (_lhsIpol) of + { _hdOpol -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIisAtTop) of + { _hdOisAtTop -> + (case (hd_ _hdOisAtTop _hdOopts _hdOpol) of + { ( _hdIfrTvSL,_hdIgathFxTvM,_hdIqInsideTvS,_hdIqOrphanTvS,hd_1) -> + (case (_hdIfrTvSL ++ _tlIfrTvSL) of + { _lhsOfrTvSL -> + (case (_hdIgathFxTvM `Map.union` _tlIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_hdIqInsideTvS `Set.union` _tlIqInsideTvS) of + { _lhsOqInsideTvS -> + (case ((let sem_PredSeq_Cons_1 :: T_PredSeq_1 + sem_PredSeq_Cons_1 = + (\ _lhsIappSpinePos + _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (_lhsItyCtxt) of + { _tlOtyCtxt -> + (case (_lhsItvIsBound) of + { _tlOtvIsBound -> + (case (_lhsIrank) of + { _tlOrank -> + (case (_lhsIfxTvM) of + { _tlOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tlOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tlObaseQu -> + (case (_lhsItyCtxt) of + { _hdOtyCtxt -> + (case (_lhsItvIsBound) of + { _hdOtvIsBound -> + (case (_lhsIrank) of + { _hdOrank -> + (case (_lhsIfxTvM) of + { _hdOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _hdOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _hdObaseQu -> + (case (_lhsIqSurrTvS) of + { _tlOqSurrTvS -> + (case (_lhsIisRow) of + { _tlOisRow -> + (case (_lhsIappSpinePos + 1) of + { _tlOappSpinePos -> + (case (tl_1 _tlOappSpinePos _tlObaseQu _tlOdefaultedVarMp _tlOfxTvM _tlOisRow _tlOqSurrTvS _tlOrank _tlOtvIsBound _tlOtyCtxt) of + { ( _tlIquTy,_tlIself) -> + (case (_lhsIqSurrTvS) of + { _hdOqSurrTvS -> + (case (_lhsIisRow) of + { _hdOisRow -> + (case (hd_1 _hdObaseQu _hdOdefaultedVarMp _hdOfxTvM _hdOisRow _hdOqSurrTvS _hdOrank _hdOtvIsBound _hdOtyCtxt) of + { ( _hdIquTy,_hdIself) -> + (case (PredSeq_Cons _hdIquTy _tlIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (PredSeq_Cons _hdIself _tlIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_PredSeq_Cons_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,sem_PredSeq_1) }) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case ((let sem_PredSeq_Nil_1 :: T_PredSeq_1 + sem_PredSeq_Nil_1 = + (\ _lhsIappSpinePos + _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (PredSeq_Nil) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (PredSeq_Nil) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_PredSeq_Nil_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,sem_PredSeq_1) }) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case ((let sem_PredSeq_Var_1 :: T_PredSeq_1 + sem_PredSeq_Var_1 = + (\ _lhsIappSpinePos + _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (PredSeq_Var av_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (PredSeq_Var av_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_PredSeq_Var_1)) of + { ( sem_PredSeq_1) -> + ( _lhsOfrTvSL,_lhsOgathFxTvM,_lhsOqInsideTvS,sem_PredSeq_1) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attributes: + appSpinePos : Int + isAtTop : Bool + opts : TyQuOpts + pol : Polarity + synthesized attributes: + appFunNm : HsName + frTvSL : [TyVarIdS] + gathFxTvM : TvCatMp + isArrow : Bool + isPred : Bool + isQuLoc : Bool + qInsideTvS : TyVarIdS + qOrphanTvS : TyVarIdS + visit 1: + inherited attributes: + baseQu : TyQu + defaultedVarMp : VarMp + fxTvM : TvCatMp + isRow : Bool + qSurrTvS : TyVarIdS + rank : Int + tvIsBound : TvLevIsBound + tyCtxt : TyQuCtxt + synthesized attributes: + quTy : Ty + self : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 0: + local frTvS : _ + visit 1: + local quTy : _ + local self : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local isAtTop : _ + local appFunNm : {HsName} + local isSpineRoot : {Bool} + local appIsSum : _ + local appIsRec : {Bool} + local appIsRecOrSum : _ + local argIsRow : {Bool} + local appIsArrow : {Bool} + local isArrowArg : {Bool} + local isArrowRoot : {Bool} + local appIsLikeProd : {Bool} + local polArrowRes : _ + local _tup1 : _ + local frTvSL : {[TyVarIdS]} + local frRowTvS : {TyVarIdS} + local frTvS : {TyVarIdS} + local isQuLocExtraHook : _ + local isProdRoot : _ + local isQuLoc : {Bool} + local qOrphanTvS : {TyVarIdS} + local qHereTvS : {TyVarIdS} + visit 1: + local tyCtxt : _ + local qAsExist : _ + local hereQu : _ + local isQuFxLoc : _ + local _tup3 : _ + local tvIsBound : _ + local defaultedVarMpNew : _ + local defaultedVarMp : _ + local qSurrTvS : _ + local quTyBase : _ + local qBndL1Tvs : _ + local qBndExTvs : _ + local qBndTvs : _ + local isQuRank : _ + local self : _ + intra appIsLikeProd : {Bool} + intra appIsArrow : {Bool} + intra qHereTvS : {TyVarIdS} + intra isQuLoc : {Bool} + intra isArrowArg : {Bool} + intra argIsRow : {Bool} + intra frRowTvS : {TyVarIdS} + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 0: + local isAtTop : _ + visit 1: + local tyCtxt : _ + local isRow : _ + local quTy : _ + local self : _ + alternative Dbg: + child info : {String} + visit 1: + local quTy : _ + local self : _ + alternative Any: + visit 0: + local frTvS : _ + visit 1: + local quTy : _ + local self : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 0: + local frTvS : {TyVarIdS} + local isQuLocExtraHook : _ + local isQuLoc : {Bool} + visit 1: + local quTyBase : _ + local qAsExist : _ + local hereQu : _ + local isQuFxLoc : _ + local qHereTvS : _ + local _tup5 : _ + local qBndL1Tvs : _ + local qBndExTvs : _ + local qBndTvs : _ + local isQuRank : _ + local self : _ + intra frTvS : {TyVarIdS} + intra isQuLoc : {Bool} + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 0: + local introTVarS : {TyVarIdS} + local isAtTop : _ + local frTvS : {TyVarIdS} + local isQuLocExtraHook : _ + local isQuLoc : {Bool} + visit 1: + local tyCtxt : _ + local hereQu : _ + local _tup7 : _ + local tvIsBoundQu : _ + local isQuFxLoc : _ + local qHereTvS : _ + local _tup6 : _ + local tvIsBound : _ + local defaultedVarMpNew : _ + local defaultedVarMp : _ + local qSurrTvS : _ + local isRow : _ + local quTyBase : _ + local qBndL1TvsQu : _ + local qBndL1TvsOther : _ + local qBndL1Tvs : _ + local qBndExTvs : _ + local qBndTvs : _ + local isQuRank : _ + local self : _ + intra introTVarS : {TyVarIdS} + intra frTvS : {TyVarIdS} + intra isQuLoc : {Bool} + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local isAtTop : _ + local appFunNm : {HsName} + local frTvSL : _ + local qOrphanTvS : _ + visit 1: + local tyCtxt : _ + local isRow : _ + local quTy : _ + local self : _ + alternative Pred: + child pr : Pred + visit 0: + local isAtTop : _ + local frTvS : {TyVarIdS} + local isQuLocExtraHook : _ + local isQuLoc : {Bool} + visit 1: + local tyCtxt : _ + local qHereTvS : _ + local _tup8 : _ + local tvIsBound : _ + local defaultedVarMpNew : _ + local defaultedVarMp : _ + local qAsExist : _ + local hereQu : _ + local qBndL1Tvs : _ + local qBndExTvs : _ + local qBndTvs : _ + local isQuRank : _ + local isRow : _ + local self : _ + intra frTvS : {TyVarIdS} + intra isQuLoc : {Bool} + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 0: + local introTVarS : {TyVarIdS} + local isAtTop : _ + local frTvS : _ + visit 1: + local tyCtxt : _ + local tvIsBound : _ + local isRow : _ + local self : _ + intra introTVarS : {TyVarIdS} + alternative Impls: + child impls : Impls + visit 0: + local isAtTop : _ + local frTvS : _ + visit 1: + local tyCtxt : _ + local isRow : _ + local quTy : _ + local self : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = Int -> + Bool -> + TyQuOpts -> + Polarity -> + ( HsName,([TyVarIdS]),TvCatMp,Bool,Bool,Bool,TyVarIdS,TyVarIdS,T_Ty_1) +type T_Ty_1 = TyQu -> + VarMp -> + TvCatMp -> + Bool -> + TyVarIdS -> + Int -> + TvLevIsBound -> + TyQuCtxt -> + ( Ty,Ty) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (nm_) of + { _lhsOappFunNm -> + (case (Set.empty) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (False) of + { _lhsOisQuLoc -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Con_1 :: T_Ty_1 + sem_Ty_Con_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Ty_Con nm_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Con nm_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Ty_Con_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) })) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIopts) of + { _funcOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _funcOisAtTop -> + (case (_lhsIappSpinePos + 1) of + { _funcOappSpinePos -> + (case (_lhsIpol) of + { _funcOpol -> + (case (func_ _funcOappSpinePos _funcOisAtTop _funcOopts _funcOpol) of + { ( _funcIappFunNm,_funcIfrTvSL,_funcIgathFxTvM,_funcIisArrow,_funcIisPred,_funcIisQuLoc,_funcIqInsideTvS,_funcIqOrphanTvS,func_1) -> + (case (_funcIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case (_lhsIappSpinePos == 0) of + { _isSpineRoot -> + (case (0) of + { _argOappSpinePos -> + (case (hsnIsSum _funcIappFunNm) of + { _appIsSum -> + (case (hsnIsRec _funcIappFunNm) of + { _appIsRec -> + (case (_appIsRec || _appIsSum) of + { _appIsRecOrSum -> + (case (_isSpineRoot && _appIsRecOrSum) of + { _argIsRow -> + (case (_lhsIopts) of + { _argOopts -> + (case (_isAtTop) of + { _argOisAtTop -> + (case (hsnIsArrow _funcIappFunNm) of + { _appIsArrow -> + (case (_appIsArrow && _lhsIappSpinePos == 1) of + { _isArrowArg -> + (case (_appIsArrow && _isSpineRoot) of + { _isArrowRoot -> + (case (hsnIsProd _funcIappFunNm || _appIsRec) of + { _appIsLikeProd -> + (case (if _funcIisPred then _lhsIpol else polCovariant) of + { _polArrowRes -> + (case (if _appIsLikeProd then _lhsIpol + else if _isArrowRoot then _polArrowRes + else if _isArrowArg then polContravariant + else polInvariant) of + { _argOpol -> + (case (arg_ _argOappSpinePos _argOisAtTop _argOopts _argOpol) of + { ( _argIappFunNm,_argIfrTvSL,_argIgathFxTvM,_argIisArrow,_argIisPred,_argIisQuLoc,_argIqInsideTvS,_argIqOrphanTvS,arg_1) -> + (case (if _argIsRow + then hdAndTl (reverse _argIfrTvSL) + else (Set.empty,_argIfrTvSL ++ _funcIfrTvSL)) of + { __tup1 -> + (case (__tup1) of + { (_,_frTvSL) -> + (case (__tup1) of + { (_frRowTvS,_) -> + (case (Set.unions (_frRowTvS : _frTvSL)) of + { _frTvS -> + (case (if _isSpineRoot then [_frTvS] else _frTvSL) of + { _lhsOfrTvSL -> + (case (_funcIgathFxTvM `Map.union` _argIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (_isArrowRoot) of + { _lhsOisArrow -> + (case (if _isArrowArg then _argIisPred else False) of + { _lhsOisPred -> + (case (_lhsIisAtTop || tqoptAllowInnerQuant _lhsIopts) of + { _isQuLocExtraHook -> + (case (_appIsLikeProd && _isSpineRoot) of + { _isProdRoot -> + (case (( polIsCovariant _lhsIpol + || (polIsContravariant _lhsIpol + && (_isProdRoot + || _isArrowRoot + && (not _funcIisPred || _argIisQuLoc) + ) ) + ) && _isQuLocExtraHook) of + { _isQuLoc -> + (case (if _isArrowArg then _argIisQuLoc else _isQuLoc) of + { _lhsOisQuLoc -> + (case (_argIqOrphanTvS `Set.union` _funcIqOrphanTvS) of + { _qOrphanTvS -> + (case (if _isQuLoc + then if _appIsArrow || _appIsLikeProd + then Set.unions [tvarSOccurGE2 _frTvSL, _frRowTvS, _qOrphanTvS] + else _frTvS + else Set.empty) of + { _qHereTvS -> + (case (_qHereTvS) of + { _lhsOqInsideTvS -> + (case (if _isSpineRoot && _isQuLoc then Set.empty else _qOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_App_1 :: T_Ty_1 + sem_Ty_App_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (if _appIsArrow then TyQuCtxtArrow + else if _appIsLikeProd then TyQuCtxtProd + else TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _argOtyCtxt -> + (case ((_appIsLikeProd || polIsContravariant _lhsIpol && not _appIsArrow)) of + { _qAsExist -> + (case (if _qAsExist then tyquExists _lhsIbaseQu else _lhsIbaseQu) of + { _hereQu -> + (case (_lhsIrank > 1 + || _lhsIrank == 1 + && (_lhsItyCtxt == TyQuCtxtArrow && not _argIisArrow + || _lhsItyCtxt == TyQuCtxtOther + )) of + { _isQuFxLoc -> + (case (tvarsToQuant _lhsIopts _isQuLoc _lhsIfxTvM (tvMayQuFx _hereQu _lhsIfxTvM _isQuFxLoc) _lhsItvIsBound _qHereTvS) of + { __tup3 -> + (case (__tup3) of + { (_,_,_,_tvIsBound,_) -> + (case (_tvIsBound) of + { _argOtvIsBound -> + (case (_lhsIfxTvM) of + { _argOfxTvM -> + (case (__tup3) of + { (_,_,_,_,_defaultedVarMpNew) -> + (case (_defaultedVarMpNew `varUpd` _lhsIdefaultedVarMp) of + { _defaultedVarMp -> + (case (_defaultedVarMp) of + { _argOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _argObaseQu -> + (case (_tyCtxt) of + { _funcOtyCtxt -> + (case (_tvIsBound) of + { _funcOtvIsBound -> + (case (_lhsIrank) of + { _funcOrank -> + (case (_lhsIfxTvM) of + { _funcOfxTvM -> + (case (_defaultedVarMp) of + { _funcOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _funcObaseQu -> + (case (_lhsIrank + (if _isArrowArg then 1 else 0)) of + { _argOrank -> + (case (_qHereTvS `Set.union` _lhsIqSurrTvS) of + { _qSurrTvS -> + (case (_qSurrTvS) of + { _argOqSurrTvS -> + (case (_argIsRow) of + { _argOisRow -> + (case (arg_1 _argObaseQu _argOdefaultedVarMp _argOfxTvM _argOisRow _argOqSurrTvS _argOrank _argOtvIsBound _argOtyCtxt) of + { ( _argIquTy,_argIself) -> + (case (_qSurrTvS) of + { _funcOqSurrTvS -> + (case (_lhsIisRow) of + { _funcOisRow -> + (case (func_1 _funcObaseQu _funcOdefaultedVarMp _funcOfxTvM _funcOisRow _funcOqSurrTvS _funcOrank _funcOtvIsBound _funcOtyCtxt) of + { ( _funcIquTy,_funcIself) -> + (case (Ty_App _funcIquTy _argIquTy) of + { _quTyBase -> + (case (__tup3) of + { (_,_,_qBndL1Tvs,_,_) -> + (case (__tup3) of + { (_,_qBndExTvs,_,_,_) -> + (case (__tup3) of + { (_qBndTvs,_,_,_,_) -> + (case (_lhsIrank `elem` tqoptQuRanks _lhsIopts) of + { _isQuRank -> + (case (let (rwYTvS,rwNTvS) = partition (\(v,_) -> v `Set.member` _frRowTvS) _qBndTvs + in mkTyQuForRank _lhsIopts _isQuRank _hereQu _qBndL1Tvs rwNTvS _qBndExTvs + $ mkTyQuForRank _lhsIopts _isQuRank _lhsIbaseQu [] rwYTvS [] + $ _quTyBase) of + { _lhsOquTy -> + (case (Ty_App _funcIself _argIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_App_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (_lhsIpol) of + { _tyOpol -> + (case (_lhsIopts) of + { _tyOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIfrTvSL) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (_tyIisQuLoc) of + { _lhsOisQuLoc -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Ann_1 :: T_Ty_1 + sem_Ty_Ann_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (ann_) of + { ( _annIquTy,_annIself) -> + (case (Ty_Ann _annIquTy _tyIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Ann _annIself _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ann_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case ([]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (False) of + { _lhsOisQuLoc -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Dbg_1 :: T_Ty_1 + sem_Ty_Dbg_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Ty_Dbg info_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Dbg info_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Ty_Dbg_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) })) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (Set.empty) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (Map.empty) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (False) of + { _lhsOisQuLoc -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Any_1 :: T_Ty_1 + sem_Ty_Any_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (Ty_Any) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Any) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) })) + in sem_Ty_Any_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (categ_) of + { ( _categIquTy,_categIself) -> + (case (if tvCatIsPlain _categIself then Set.singleton tv_ else Set.empty) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (tv_ `Map.singleton` mkTvInfoTy _categIself) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIisAtTop || tqoptAllowInnerQuant _lhsIopts) of + { _isQuLocExtraHook -> + (case (polIsCovariant _lhsIpol && _isQuLocExtraHook) of + { _isQuLoc -> + (case (_isQuLoc) of + { _lhsOisQuLoc -> + (case (Set.empty) of + { _lhsOqInsideTvS -> + (case (if _isQuLoc then Set.empty else _frTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Var_1 :: T_Ty_1 + sem_Ty_Var_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (maybe (Ty_Var tv_ _categIquTy) id $ varmpTyLookup tv_ _lhsIdefaultedVarMp) of + { _quTyBase -> + (case (polIsContravariant _lhsIpol) of + { _qAsExist -> + (case (if _qAsExist then tyquExists _lhsIbaseQu else _lhsIbaseQu) of + { _hereQu -> + (case (False) of + { _isQuFxLoc -> + (case (if _isQuLoc then _frTvS else Set.empty) of + { _qHereTvS -> + (case (tvarsToQuant _lhsIopts _isQuLoc _lhsIfxTvM (tvMayQuFx _hereQu _lhsIfxTvM _isQuFxLoc) _lhsItvIsBound _qHereTvS) of + { __tup5 -> + (case (__tup5) of + { (_,_,_qBndL1Tvs,_,_) -> + (case (__tup5) of + { (_,_qBndExTvs,_,_,_) -> + (case (__tup5) of + { (_qBndTvs,_,_,_,_) -> + (case (_lhsIrank `elem` tqoptQuRanks _lhsIopts) of + { _isQuRank -> + (case (mkTyQuForRank _lhsIopts _isQuRank _hereQu _qBndL1Tvs _qBndTvs _qBndExTvs _quTyBase) of + { _lhsOquTy -> + (case (Ty_Var tv_ _categIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Var_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (Set.singleton tv_) of + { _introTVarS -> + (case (0) of + { _tyOappSpinePos -> + (case (_lhsIpol) of + { _tyOpol -> + (case (_lhsIopts) of + { _tyOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (head _tyIfrTvSL `Set.difference` _introTVarS) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (_lhsIisAtTop || tqoptAllowInnerQuant _lhsIopts) of + { _isQuLocExtraHook -> + (case (not (polIsInvariant _lhsIpol) && _isQuLocExtraHook) of + { _isQuLoc -> + (case (_isQuLoc) of + { _lhsOisQuLoc -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_TBind_1 :: T_Ty_1 + sem_Ty_TBind_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (tyQu_Forall) of + { _hereQu -> + (case (let (qBndL1Tvs,_,isB) = tvarsToQuantL1 [(tv_,l1_)] _lhsItvIsBound + in (qBndL1Tvs, tvBoundAddS 0 _introTVarS isB)) of + { __tup7 -> + (case (__tup7) of + { (_,_tvIsBoundQu) -> + (case (False) of + { _isQuFxLoc -> + (case (if _isQuLoc then _frTvS else Set.empty) of + { _qHereTvS -> + (case (tvarsToQuant _lhsIopts _isQuLoc _lhsIfxTvM + (tvMayQuFx _hereQu _lhsIfxTvM _isQuFxLoc) + _tvIsBoundQu _qHereTvS) of + { __tup6 -> + (case (__tup6) of + { (_,_,_,_tvIsBound,_) -> + (case (_tvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (__tup6) of + { (_,_,_,_,_defaultedVarMpNew) -> + (case (_defaultedVarMpNew `varUpd` _lhsIdefaultedVarMp) of + { _defaultedVarMp -> + (case (_defaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_qHereTvS `Set.union` _lhsIqSurrTvS) of + { _qSurrTvS -> + (case (_qSurrTvS) of + { _tyOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (qu_) of + { ( _quIquTy,_quIself) -> + (case (Ty_TBind _quIself tv_ l1_ _tyIquTy) of + { _quTyBase -> + (case (__tup7) of + { (_qBndL1TvsQu,_) -> + (case (__tup6) of + { (_,_,_qBndL1TvsOther,_,_) -> + (case (_qBndL1TvsOther ++ _qBndL1TvsQu) of + { _qBndL1Tvs -> + (case (__tup6) of + { (_,_qBndExTvs,_,_,_) -> + (case (__tup6) of + { (_qBndTvs,_,_,_,_) -> + (case (_lhsIrank `elem` tqoptQuRanks _lhsIopts) of + { _isQuRank -> + (case (mkTyQuForRank _lhsIopts _isQuRank _hereQu _qBndL1Tvs _qBndTvs _qBndExTvs _quTyBase) of + { _lhsOquTy -> + (case (Ty_TBind _quIself tv_ l1_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_TBind_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (_lhsIpol) of + { _tyOpol -> + (case (_lhsIopts) of + { _tyOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (_lhsIappSpinePos + 1) of + { _tyOappSpinePos -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIappFunNm) of + { _appFunNm -> + (case (_appFunNm) of + { _lhsOappFunNm -> + (case (0) of + { _extTyOappSpinePos -> + (case (_lhsIpol) of + { _extTyOpol -> + (case (_lhsIopts) of + { _extTyOopts -> + (case (_isAtTop) of + { _extTyOisAtTop -> + (case (extTy_ _extTyOappSpinePos _extTyOisAtTop _extTyOopts _extTyOpol) of + { ( _extTyIappFunNm,_extTyIfrTvSL,_extTyIgathFxTvM,_extTyIisArrow,_extTyIisPred,_extTyIisQuLoc,_extTyIqInsideTvS,_extTyIqOrphanTvS,extTy_1) -> + (case (_extTyIfrTvSL ++ _tyIfrTvSL) of + { _frTvSL -> + (case (_frTvSL) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM `Map.union` _extTyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (_tyIisQuLoc && _extTyIisQuLoc) of + { _lhsOisQuLoc -> + (case (_tyIqInsideTvS `Set.union` _extTyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_extTyIqOrphanTvS `Set.union` _tyIqOrphanTvS) of + { _qOrphanTvS -> + (case (_qOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Ext_1 :: T_Ty_1 + sem_Ty_Ext_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _extTyOtyCtxt -> + (case (_lhsItvIsBound) of + { _extTyOtvIsBound -> + (case (_lhsIrank) of + { _extTyOrank -> + (case (_lhsIfxTvM) of + { _extTyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _extTyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _extTyObaseQu -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (_lhsItvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_lhsIqSurrTvS) of + { _extTyOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _extTyOisRow -> + (case (extTy_1 _extTyObaseQu _extTyOdefaultedVarMp _extTyOfxTvM _extTyOisRow _extTyOqSurrTvS _extTyOrank _extTyOtvIsBound _extTyOtyCtxt) of + { ( _extTyIquTy,_extTyIself) -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (_isRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (Ty_Ext _tyIquTy nm_ _extTyIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Ext _tyIself nm_ _extTyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Ext_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (_lhsIopts) of + { _prOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _prOisAtTop -> + (case (polInvariant) of + { _prOpol -> + (case (pr_ _prOisAtTop _prOopts _prOpol) of + { ( _prIfrTvSL,_prIgathFxTvM,_prIqInsideTvS,_prIqOrphanTvS,pr_1) -> + (case (Set.unions _prIfrTvSL) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (_prIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisPred -> + (case (_lhsIisAtTop || tqoptAllowInnerQuant _lhsIopts) of + { _isQuLocExtraHook -> + (case (polIsCovariant _lhsIpol && _isQuLocExtraHook) of + { _isQuLoc -> + (case (_isQuLoc) of + { _lhsOisQuLoc -> + (case (_prIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_prIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Pred_1 :: T_Ty_1 + sem_Ty_Pred_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _prOtyCtxt -> + (case (_frTvS `Set.difference` _prIqInsideTvS) of + { _qHereTvS -> + (case (tvarsToQuant _lhsIopts _isQuLoc _lhsIfxTvM (const False) _lhsItvIsBound _qHereTvS) of + { __tup8 -> + (case (__tup8) of + { (_,_,_,_tvIsBound,_) -> + (case (_tvIsBound) of + { _prOtvIsBound -> + (case (_lhsIrank) of + { _prOrank -> + (case (_lhsIfxTvM) of + { _prOfxTvM -> + (case (__tup8) of + { (_,_,_,_,_defaultedVarMpNew) -> + (case (_defaultedVarMpNew `varUpd` _lhsIdefaultedVarMp) of + { _defaultedVarMp -> + (case (_defaultedVarMp) of + { _prOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _prObaseQu -> + (case (polIsContravariant _lhsIpol) of + { _qAsExist -> + (case (if _qAsExist then tyquExists _lhsIbaseQu else _lhsIbaseQu) of + { _hereQu -> + (case (__tup8) of + { (_,_,_qBndL1Tvs,_,_) -> + (case (__tup8) of + { (_,_qBndExTvs,_,_,_) -> + (case (__tup8) of + { (_qBndTvs,_,_,_,_) -> + (case (_lhsIrank `elem` tqoptQuRanks _lhsIopts) of + { _isQuRank -> + (case (_lhsIqSurrTvS) of + { _prOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _prOisRow -> + (case (pr_1 _prObaseQu _prOdefaultedVarMp _prOfxTvM _prOisRow _prOqSurrTvS _prOrank _prOtvIsBound _prOtyCtxt) of + { ( _prIquTy,_prIself) -> + (case (mkTyQuForRank _lhsIopts _isQuRank _hereQu _qBndL1Tvs _qBndTvs _qBndExTvs (mkTyPr _prIquTy)) of + { _lhsOquTy -> + (case (Ty_Pred _prIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Pred_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (_lhsIappSpinePos) of + { _tyOappSpinePos -> + (case (Set.singleton tv_) of + { _introTVarS -> + (case (_lhsIpol) of + { _tyOpol -> + (case (_lhsIopts) of + { _tyOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _tyOisAtTop -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (head _tyIfrTvSL `Set.difference` _introTVarS) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (_tyIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (False) of + { _lhsOisPred -> + (case (_tyIisQuLoc) of + { _lhsOisQuLoc -> + (case (_tyIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (Set.empty) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Lam_1 :: T_Ty_1 + sem_Ty_Lam_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _tyOtyCtxt -> + (case (tvBoundAddS 0 _introTVarS _lhsItvIsBound) of + { _tvIsBound -> + (case (_tvIsBound) of + { _tyOtvIsBound -> + (case (_lhsIrank) of + { _tyOrank -> + (case (_lhsIfxTvM) of + { _tyOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (_lhsIqSurrTvS) of + { _tyOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (Ty_Lam tv_ _tyIquTy) of + { _lhsOquTy -> + (case (Ty_Lam tv_ _tyIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Lam_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsIappSpinePos + _lhsIisAtTop + _lhsIopts + _lhsIpol -> + (case (hsnUnknown) of + { _lhsOappFunNm -> + (case (_lhsIpol) of + { _implsOpol -> + (case (_lhsIopts) of + { _implsOopts -> + (case (False) of + { _isAtTop -> + (case (_isAtTop) of + { _implsOisAtTop -> + (case (impls_ _implsOisAtTop _implsOopts _implsOpol) of + { ( _implsIfrTvSL,_implsIgathFxTvM,_implsIqInsideTvS,_implsIqOrphanTvS,impls_1) -> + (case (Set.unions _implsIfrTvSL) of + { _frTvS -> + (case ([_frTvS]) of + { _lhsOfrTvSL -> + (case (_implsIgathFxTvM) of + { _lhsOgathFxTvM -> + (case (False) of + { _lhsOisArrow -> + (case (True) of + { _lhsOisPred -> + (case (False) of + { _lhsOisQuLoc -> + (case (_implsIqInsideTvS) of + { _lhsOqInsideTvS -> + (case (_implsIqOrphanTvS) of + { _lhsOqOrphanTvS -> + (case ((let sem_Ty_Impls_1 :: T_Ty_1 + sem_Ty_Impls_1 = + (\ _lhsIbaseQu + _lhsIdefaultedVarMp + _lhsIfxTvM + _lhsIisRow + _lhsIqSurrTvS + _lhsIrank + _lhsItvIsBound + _lhsItyCtxt -> + (case (TyQuCtxtOther) of + { _tyCtxt -> + (case (_tyCtxt) of + { _implsOtyCtxt -> + (case (_lhsItvIsBound) of + { _implsOtvIsBound -> + (case (_lhsIrank) of + { _implsOrank -> + (case (_lhsIfxTvM) of + { _implsOfxTvM -> + (case (_lhsIdefaultedVarMp) of + { _implsOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _implsObaseQu -> + (case (_lhsIqSurrTvS) of + { _implsOqSurrTvS -> + (case (False) of + { _isRow -> + (case (_isRow) of + { _implsOisRow -> + (case (impls_1 _implsObaseQu _implsOdefaultedVarMp _implsOfxTvM _implsOisRow _implsOqSurrTvS _implsOrank _implsOtvIsBound _implsOtyCtxt) of + { ( _implsIquTy,_implsIself) -> + (case (Ty_Impls _implsIquTy) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (Ty_Impls _implsIself) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) + in sem_Ty_Impls_1)) of + { ( sem_Ty_1) -> + ( _lhsOappFunNm,_lhsOfrTvSL,_lhsOgathFxTvM,_lhsOisArrow,_lhsOisPred,_lhsOisQuLoc,_lhsOqInsideTvS,_lhsOqOrphanTvS,sem_Ty_1) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attributes: + baseQu : TyQu + opts : TyQuOpts + synthesized attribute: + quTy : Ty + alternatives: + alternative AGItf: + child ty : Ty + visit 0: + local opts : _ + local fxTvM : _ + local qHereTvS : _ + local _tup9 : _ + local tvIsBound : _ + local rank : _ + local defaultedVarMpNew : _ + local defaultedVarMp : _ + local qSurrTvS : _ + local quTyBase : _ + local hereQu : _ + local qBndL1Tvs : _ + local qBndExTvs : _ + local qBndTvs : _ + local isQuRank : _ +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = TyQu -> + TyQuOpts -> + ( Ty) +data Inh_TyAGItf = Inh_TyAGItf {baseQu_Inh_TyAGItf :: !(TyQu),opts_Inh_TyAGItf :: !(TyQuOpts)} +data Syn_TyAGItf = Syn_TyAGItf {quTy_Syn_TyAGItf :: !(Ty)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIbaseQu _lhsIopts) = + (let ( _lhsOquTy) = sem _lhsIbaseQu _lhsIopts + in (Syn_TyAGItf _lhsOquTy)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIbaseQu + _lhsIopts -> + (case (_lhsIopts + { tqoptQuRanks = take 5 (tqoptQuRanks _lhsIopts) + }) of + { _opts -> + (case (_opts) of + { _tyOopts -> + (case (polCovariant) of + { _tyOpol -> + (case (0) of + { _tyOappSpinePos -> + (case (True) of + { _tyOisAtTop -> + (case (ty_ _tyOappSpinePos _tyOisAtTop _tyOopts _tyOpol) of + { ( _tyIappFunNm,_tyIfrTvSL,_tyIgathFxTvM,_tyIisArrow,_tyIisPred,_tyIisQuLoc,_tyIqInsideTvS,_tyIqOrphanTvS,ty_1) -> + (case (_tyIgathFxTvM) of + { _fxTvM -> + (case (Set.empty) of + { _qHereTvS -> + (case (tvarsToQuant _lhsIopts True _fxTvM + (const False) + (tvIsBound2L0 $ tqoptTvIsBound _lhsIopts) _qHereTvS) of + { __tup9 -> + (case (__tup9) of + { (_,_,_,_tvIsBound,_) -> + (case (_tvIsBound) of + { _tyOtvIsBound -> + (case (1) of + { _rank -> + (case (_rank) of + { _tyOrank -> + (case (_fxTvM) of + { _tyOfxTvM -> + (case (__tup9) of + { (_,_,_,_,_defaultedVarMpNew) -> + (case (_defaultedVarMpNew) of + { _defaultedVarMp -> + (case (_defaultedVarMp) of + { _tyOdefaultedVarMp -> + (case (_lhsIbaseQu) of + { _tyObaseQu -> + (case (TyQuCtxtOnTop) of + { _tyOtyCtxt -> + (case (_qHereTvS) of + { _qSurrTvS -> + (case (_qSurrTvS) of + { _tyOqSurrTvS -> + (case (False) of + { _tyOisRow -> + (case (ty_1 _tyObaseQu _tyOdefaultedVarMp _tyOfxTvM _tyOisRow _tyOqSurrTvS _tyOrank _tyOtvIsBound _tyOtyCtxt) of + { ( _tyIquTy,_tyIself) -> + (case (_tyIquTy) of + { _quTyBase -> + (case (_lhsIbaseQu) of + { _hereQu -> + (case (__tup9) of + { (_,_,_qBndL1Tvs,_,_) -> + (case (__tup9) of + { (_,_qBndExTvs,_,_,_) -> + (case (__tup9) of + { (_qBndTvs,_,_,_,_) -> + (case (_rank `elem` tqoptQuRanks _opts) of + { _isQuRank -> + (case (mkTyQuForRank _lhsIopts _isQuRank _hereQu _qBndL1Tvs _qBndTvs _qBndExTvs _quTyBase) of + { _lhsOquTy -> + ( _lhsOquTy) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + synthesized attributes: + quTy : TyAnn + self : TyAnn + alternatives: + alternative Empty: + visit 0: + local quTy : _ + local self : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local quTy : _ + local self : _ + alternative Mono: + visit 0: + local quTy : _ + local self : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( TyAnn,TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (case (TyAnn_Empty) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyAnn_Empty) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (case (TyAnn_Strictness s_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyAnn_Strictness s_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (case (TyAnn_Mono) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyAnn_Mono) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +-- TyQu -------------------------------------------------------- +{- + visit 0: + synthesized attributes: + quTy : TyQu + self : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local quTy : _ + local self : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local quTy : _ + local self : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local quTy : _ + local self : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( TyQu,TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (case (TyQu_Forall mlev_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyQu_Forall mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (case (TyQu_Exists mlev_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyQu_Exists mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (case (TyQu_Plain mlev_) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyQu_Plain mlev_) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + synthesized attributes: + quTy : TyVarCateg + self : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local quTy : _ + local self : _ + alternative Fixed: + visit 0: + local quTy : _ + local self : _ + alternative Meta: + visit 0: + local quTy : _ + local self : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( TyVarCateg,TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (case (TyVarCateg_Plain) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyVarCateg_Plain) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (case (TyVarCateg_Fixed) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyVarCateg_Fixed) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (case (TyVarCateg_Meta) of + { _quTy -> + (case (_quTy) of + { _lhsOquTy -> + (case (TyVarCateg_Meta) of + { _self -> + (case (_self) of + { _lhsOself -> + ( _lhsOquTy,_lhsOself) }) }) }) }) diff --git a/src/UHC/Light/Compiler/Ty/Trf/Subst.hs b/src/UHC/Light/Compiler/Ty/Trf/Subst.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Trf/Subst.hs @@ -0,0 +1,1390 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/Trf/Subst.a) +module UHC.Light.Compiler.Ty.Trf.Subst(tyAppVarLookup, tyAppVarLookup2) where + +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Util.Utils +import qualified Data.Map as Map +import UHC.Light.Compiler.VarLookup +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Pretty +import UHC.Light.Compiler.Ty.Pretty + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + + + +tyAppVarLookup' :: VarLookup m TyVarId VarMpInfo => SubstOpts -> m -> TVUseMp -> Ty -> (Ty,VarMp) +tyAppVarLookup' opts m usemp ty + = (repl_Syn_TyAGItf t,cycVarMp_Syn_TyAGItf t) + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf + { substOpts_Inh_TyAGItf = opts + , tvUseMp_Inh_TyAGItf = usemp + , lkup_Inh_TyAGItf = mkLkup m + }) + +tyAppVarLookup :: VarLookup m TyVarId VarMpInfo => m -> Ty -> Ty +tyAppVarLookup m ty + = ty' + where (ty',_) = tyAppVarLookup' defaultOpts m Map.empty ty + +tyAppVarLookup2 :: VarLookup m TyVarId VarMpInfo => m -> Ty -> (Ty,VarMp) +tyAppVarLookup2 m ty + = tyAppVarLookup' defaultOpts m Map.empty ty + + + +data SubstOpts + = SubstOpts + +defaultOpts :: SubstOpts +defaultOpts = SubstOpts + + + +type Lkup = MetaLev -> TyVarId -> Maybe VarMpInfo + +mkLkup :: VarLookup m TyVarId VarMpInfo => m -> Lkup +mkLkup m = \mlev v -> {- trm "Subst.lkup" (\r -> mlev >#< v >#< r) $ -} varlookupWithMetaLev mlev v m + + + +data TVUse + = TVFree -- is still free + | TVBound -- is already bound + | TVSubst -- is being substituted (for occur check implementation) + +type TVUseMp = Map.Map TyVarId TVUse + +tvUse :: TyVarId -> TVUseMp -> TVUse +tvUse tv = maybe TVFree id . Map.lookup tv + + + +type IsBound = TyVarId -> Bool + + + +tvRepl3 :: TyVarId -> TVUse -> (TyVarId -> x -> VarMp) -> x -> x -> x -> VarMp -> (x,VarMp) +tvRepl3 tv tvuse mk repl replv replho cycmpho + = case tvuse of + TVFree -> (replho,cycmpho) + TVBound -> (repl,emptyVarMp) + TVSubst -> (repl,mk tv replv) + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + substOpts : SubstOpts + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : Impls + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + visit 0: + local repl : _ + local tvUse : _ + local _tup1 : _ + local isRepl : _ + local needRepl : _ + local replv : _ + inst repl' : Impls + local _tup2 : _ + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = Lkup -> + SubstOpts -> + TVUseMp -> + ( VarMp,Impls) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (Impls_Tail iv_ proveOccs_) of + { _repl -> + (case (tvUse iv_ _lhsItvUseMp) of + { _tvUse -> + (case (maybe (_repl,False) (\t -> (t,True)) $ vmiMbImpls $? _lhsIlkup 0 iv_) of + { __tup1 -> + (case (__tup1) of + { (_,_isRepl) -> + (case (case _tvUse of + TVFree -> _isRepl + _ -> False) of + { _needRepl -> + (case (__tup1) of + { (_replv,_) -> + (case (if _needRepl then _replv else Impls_Nil) of + { repl'_val_ -> + (case ((sem_Impls repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIlkup) of + { _repl'Olkup -> + (case (Map.insert iv_ TVSubst _lhsItvUseMp) of + { _repl'OtvUseMp -> + (case (_lhsIsubstOpts) of + { _repl'OsubstOpts -> + (case (repl'_inst_ _repl'Olkup _repl'OsubstOpts _repl'OtvUseMp) of + { ( _repl'IcycVarMp,_repl'Irepl) -> + (case (if _isRepl + then let replrepl = case _repl'Irepl of + Impls_Tail i occs -> Impls_Tail i (occs ++ proveOccs_) + r -> r + in tvRepl3 iv_ _tvUse varmpImplsUnit _repl _replv replrepl _repl'IcycVarMp + else (_repl,emptyVarMp)) of + { __tup2 -> + (case (__tup2) of + { (_,_lhsOcycVarMp) -> + (case (__tup2) of + { (_lhsOrepl,_) -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tlOtvUseMp -> + (case (_lhsIlkup) of + { _tlOlkup -> + (case (_lhsItvUseMp) of + { _prOtvUseMp -> + (case (_lhsIlkup) of + { _prOlkup -> + (case (_lhsIsubstOpts) of + { _tlOsubstOpts -> + (case (tl_ _tlOlkup _tlOsubstOpts _tlOtvUseMp) of + { ( _tlIcycVarMp,_tlIrepl) -> + (case (_lhsIsubstOpts) of + { _prOsubstOpts -> + (case (pr_ _prOlkup _prOsubstOpts _prOtvUseMp) of + { ( _prIcycVarMp,_prIrepl) -> + (case (_prIcycVarMp `varmpPlus` _tlIcycVarMp) of + { _lhsOcycVarMp -> + (case (Impls_Cons iv_ _prIrepl pv_ prange_ proveOccs_ _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (Impls_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +-- Label ------------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : Label + alternatives: + alternative Lab: + child nm : {HsName} + visit 0: + local repl : _ + alternative Var: + child lv : {LabelVarId} + visit 0: + local repl : _ + local tvUse : _ + local _tup3 : _ + local isRepl : _ + local needRepl : _ + local replv : _ + inst repl' : Label + local _tup4 : _ +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = Lkup -> + TVUseMp -> + ( VarMp,Label) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + (\ _lhsIlkup + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (Label_Lab nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + (\ _lhsIlkup + _lhsItvUseMp -> + (case (Label_Var lv_) of + { _repl -> + (case (tvUse lv_ _lhsItvUseMp) of + { _tvUse -> + (case (maybe (_repl,False) (\t -> (t,True)) $ vmiMbLabel $? _lhsIlkup 0 lv_) of + { __tup3 -> + (case (__tup3) of + { (_,_isRepl) -> + (case (case _tvUse of + TVFree -> _isRepl + _ -> False) of + { _needRepl -> + (case (__tup3) of + { (_replv,_) -> + (case (if _needRepl then _replv else Label_Lab (mkHNmBase "")) of + { repl'_val_ -> + (case ((sem_Label repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIlkup) of + { _repl'Olkup -> + (case (Map.insert lv_ TVSubst _lhsItvUseMp) of + { _repl'OtvUseMp -> + (case (repl'_inst_ _repl'Olkup _repl'OtvUseMp) of + { ( _repl'IcycVarMp,_repl'Irepl) -> + (case (if _isRepl + then tvRepl3 lv_ _tvUse varmpLabelUnit _repl _replv _repl'Irepl _repl'IcycVarMp + else (_repl,emptyVarMp)) of + { __tup4 -> + (case (__tup4) of + { (_,_lhsOcycVarMp) -> + (case (__tup4) of + { (_lhsOrepl,_) -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- LabelAGItf -------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + tvUseMp : TVUseMp + synthesized attribute: + repl : Label + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = Lkup -> + TVUseMp -> + ( Label) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + (\ _lhsIlkup + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _labOtvUseMp -> + (case (_lhsIlkup) of + { _labOlkup -> + (case (lab_ _labOlkup _labOtvUseMp) of + { ( _labIcycVarMp,_labIrepl) -> + (case (_labIrepl) of + { _lhsOrepl -> + ( _lhsOrepl) }) }) }) })) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + substOpts : SubstOpts + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : Pred + alternatives: + alternative Class: + child ty : Ty + visit 0: + local repl : _ + alternative Pred: + child ty : Ty + visit 0: + local repl : _ + alternative Lacks: + child ty : Ty + child lab : Label + visit 0: + local repl : _ + alternative Arrow: + child args : PredSeq + child res : Pred + visit 0: + local repl : _ + alternative Eq: + child tyL : Ty + child tyR : Ty + visit 0: + local repl : _ + alternative Var: + child pv : {TyVarId} + visit 0: + local repl : _ + local tvUse : _ + local _tup5 : _ + local isRepl : _ + local needRepl : _ + local replv : _ + inst repl' : Pred + local _tup6 : _ + alternative Preds: + child seq : PredSeq + visit 0: + local repl : _ +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = Lkup -> + SubstOpts -> + TVUseMp -> + ( VarMp,Pred) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Class _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Pred _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _labOtvUseMp -> + (case (_lhsIlkup) of + { _labOlkup -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (lab_ _labOlkup _labOtvUseMp) of + { ( _labIcycVarMp,_labIrepl) -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp `varmpPlus` _labIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Lacks _tyIrepl _labIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _resOtvUseMp -> + (case (_lhsIlkup) of + { _resOlkup -> + (case (_lhsItvUseMp) of + { _argsOtvUseMp -> + (case (_lhsIlkup) of + { _argsOlkup -> + (case (_lhsIsubstOpts) of + { _resOsubstOpts -> + (case (res_ _resOlkup _resOsubstOpts _resOtvUseMp) of + { ( _resIcycVarMp,_resIrepl) -> + (case (_lhsIsubstOpts) of + { _argsOsubstOpts -> + (case (args_ _argsOlkup _argsOsubstOpts _argsOtvUseMp) of + { ( _argsIcycVarMp,_argsIrepl) -> + (case (_argsIcycVarMp `varmpPlus` _resIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Arrow _argsIrepl _resIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tyROtvUseMp -> + (case (_lhsIlkup) of + { _tyROlkup -> + (case (_lhsItvUseMp) of + { _tyLOtvUseMp -> + (case (_lhsIlkup) of + { _tyLOlkup -> + (case (_lhsIsubstOpts) of + { _tyROsubstOpts -> + (case (tyR_ _tyROlkup _tyROsubstOpts _tyROtvUseMp) of + { ( _tyRIcycVarMp,_tyRIrepl) -> + (case (_lhsIsubstOpts) of + { _tyLOsubstOpts -> + (case (tyL_ _tyLOlkup _tyLOsubstOpts _tyLOtvUseMp) of + { ( _tyLIcycVarMp,_tyLIrepl) -> + (case (_tyLIcycVarMp `varmpPlus` _tyRIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Eq _tyLIrepl _tyRIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (Pred_Var pv_) of + { _repl -> + (case (tvUse pv_ _lhsItvUseMp) of + { _tvUse -> + (case (maybe (_repl,False) (\t -> (t,True)) $ vmiMbPred $? _lhsIlkup 0 pv_) of + { __tup5 -> + (case (__tup5) of + { (_,_isRepl) -> + (case (case _tvUse of + TVFree -> _isRepl + _ -> False) of + { _needRepl -> + (case (__tup5) of + { (_replv,_) -> + (case (if _needRepl then _replv else Pred_Pred Ty_Any) of + { repl'_val_ -> + (case ((sem_Pred repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIlkup) of + { _repl'Olkup -> + (case (Map.insert pv_ TVSubst _lhsItvUseMp) of + { _repl'OtvUseMp -> + (case (_lhsIsubstOpts) of + { _repl'OsubstOpts -> + (case (repl'_inst_ _repl'Olkup _repl'OsubstOpts _repl'OtvUseMp) of + { ( _repl'IcycVarMp,_repl'Irepl) -> + (case (if _isRepl + then tvRepl3 pv_ _tvUse varmpPredUnit _repl _replv _repl'Irepl _repl'IcycVarMp + else (_repl,emptyVarMp)) of + { __tup6 -> + (case (__tup6) of + { (_,_lhsOcycVarMp) -> + (case (__tup6) of + { (_lhsOrepl,_) -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _seqOtvUseMp -> + (case (_lhsIlkup) of + { _seqOlkup -> + (case (_lhsIsubstOpts) of + { _seqOsubstOpts -> + (case (seq_ _seqOlkup _seqOsubstOpts _seqOtvUseMp) of + { ( _seqIcycVarMp,_seqIrepl) -> + (case (_seqIcycVarMp) of + { _lhsOcycVarMp -> + (case (Pred_Preds _seqIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + substOpts : SubstOpts + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : PredSeq + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + visit 0: + local repl : _ + alternative Nil: + visit 0: + local repl : _ + alternative Var: + child av : {TyVarId} + visit 0: + local repl : _ + local tvUse : _ + local _tup7 : _ + local isRepl : _ + local needRepl : _ + local replv : _ + inst repl' : PredSeq + local _tup8 : _ +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = Lkup -> + SubstOpts -> + TVUseMp -> + ( VarMp,PredSeq) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tlOtvUseMp -> + (case (_lhsIlkup) of + { _tlOlkup -> + (case (_lhsItvUseMp) of + { _hdOtvUseMp -> + (case (_lhsIlkup) of + { _hdOlkup -> + (case (_lhsIsubstOpts) of + { _tlOsubstOpts -> + (case (tl_ _tlOlkup _tlOsubstOpts _tlOtvUseMp) of + { ( _tlIcycVarMp,_tlIrepl) -> + (case (_lhsIsubstOpts) of + { _hdOsubstOpts -> + (case (hd_ _hdOlkup _hdOsubstOpts _hdOtvUseMp) of + { ( _hdIcycVarMp,_hdIrepl) -> + (case (_hdIcycVarMp `varmpPlus` _tlIcycVarMp) of + { _lhsOcycVarMp -> + (case (PredSeq_Cons _hdIrepl _tlIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (PredSeq_Nil) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (PredSeq_Var av_) of + { _repl -> + (case (tvUse av_ _lhsItvUseMp) of + { _tvUse -> + (case (maybe (_repl,False) (\t -> (t,True)) $ vmiMbPredSeq $? _lhsIlkup 0 av_) of + { __tup7 -> + (case (__tup7) of + { (_,_isRepl) -> + (case (case _tvUse of + TVFree -> _isRepl + _ -> False) of + { _needRepl -> + (case (__tup7) of + { (_replv,_) -> + (case (if _needRepl then _replv else PredSeq_Nil) of + { repl'_val_ -> + (case ((sem_PredSeq repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIlkup) of + { _repl'Olkup -> + (case (Map.insert av_ TVSubst _lhsItvUseMp) of + { _repl'OtvUseMp -> + (case (_lhsIsubstOpts) of + { _repl'OsubstOpts -> + (case (repl'_inst_ _repl'Olkup _repl'OsubstOpts _repl'OtvUseMp) of + { ( _repl'IcycVarMp,_repl'Irepl) -> + (case (if _isRepl + then tvRepl3 av_ _tvUse varmpPredSeqUnit _repl _replv _repl'Irepl _repl'IcycVarMp + else (_repl,emptyVarMp)) of + { __tup8 -> + (case (__tup8) of + { (_,_lhsOcycVarMp) -> + (case (__tup8) of + { (_lhsOrepl,_) -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + substOpts : SubstOpts + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : Ty + alternatives: + alternative Con: + child nm : {HsName} + visit 0: + local repl : _ + alternative App: + child func : Ty + child arg : Ty + visit 0: + local repl : _ + alternative Ann: + child ann : TyAnn + child ty : Ty + visit 0: + local repl : _ + alternative Dbg: + child info : {String} + visit 0: + local repl : _ + alternative Any: + visit 0: + local repl : _ + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + visit 0: + local repl : _ + local tvUse : _ + local _tup9 : _ + local isRepl : _ + local needRepl : _ + local replv : _ + inst repl' : Ty + local _tup10 : _ + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + visit 0: + inst l1' : Ty + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + visit 0: + local repl : _ + alternative Pred: + child pr : Pred + visit 0: + local repl : _ + alternative Lam: + child tv : {TyVarId} + child ty : Ty + visit 0: + local repl : _ + alternative Impls: + child impls : Impls + visit 0: + local repl : _ +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = Lkup -> + SubstOpts -> + TVUseMp -> + ( VarMp,Ty) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Con nm_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _argOtvUseMp -> + (case (_lhsIlkup) of + { _argOlkup -> + (case (_lhsItvUseMp) of + { _funcOtvUseMp -> + (case (_lhsIlkup) of + { _funcOlkup -> + (case (_lhsIsubstOpts) of + { _argOsubstOpts -> + (case (arg_ _argOlkup _argOsubstOpts _argOtvUseMp) of + { ( _argIcycVarMp,_argIrepl) -> + (case (_lhsIsubstOpts) of + { _funcOsubstOpts -> + (case (func_ _funcOlkup _funcOsubstOpts _funcOtvUseMp) of + { ( _funcIcycVarMp,_funcIrepl) -> + (case (_funcIcycVarMp `varmpPlus` _argIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_App _funcIrepl _argIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_lhsItvUseMp) of + { _annOtvUseMp -> + (case (ann_ _annOtvUseMp) of + { ( _annIcycVarMp,_annIrepl) -> + (case (_annIcycVarMp `varmpPlus` _tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Ann _annIrepl _tyIrepl) of + { _repl -> + (case (tyCanonAnn _repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) })) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Dbg info_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Any) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _categOtvUseMp -> + (case (categ_ _categOtvUseMp) of + { ( _categIcycVarMp,_categIrepl) -> + (case (Ty_Var tv_ _categIrepl) of + { _repl -> + (case (tvUse tv_ _lhsItvUseMp) of + { _tvUse -> + (case (maybe (_repl,False) (\t -> (t,True)) $ vmiMbTy $? _lhsIlkup 0 tv_) of + { __tup9 -> + (case (__tup9) of + { (_,_isRepl) -> + (case (case _tvUse of + TVFree -> _isRepl + _ -> False) of + { _needRepl -> + (case (__tup9) of + { (_replv,_) -> + (case (if _needRepl then _replv else Ty_Any) of + { repl'_val_ -> + (case ((sem_Ty repl'_val_)) of + { repl'_inst_ -> + (case (_lhsIlkup) of + { _repl'Olkup -> + (case (Map.insert tv_ TVSubst _lhsItvUseMp) of + { _repl'OtvUseMp -> + (case (_lhsIsubstOpts) of + { _repl'OsubstOpts -> + (case (repl'_inst_ _repl'Olkup _repl'OsubstOpts _repl'OtvUseMp) of + { ( _repl'IcycVarMp,_repl'Irepl) -> + (case (if _isRepl + then tvRepl3 tv_ _tvUse varmpTyUnit _repl _replv _repl'Irepl _repl'IcycVarMp + else (_repl,emptyVarMp)) of + { __tup10 -> + (case (__tup10) of + { (_,_lhsOcycVarMp) -> + (case (__tup10) of + { (_lhsOrepl,_) -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (l1_) of + { l1'_val_ -> + (case ((sem_Ty l1'_val_)) of + { l1'_inst_ -> + (case (Map.empty) of + { _l1'OtvUseMp -> + (case (Map.insert tv_ TVBound _lhsItvUseMp) of + { _tyOtvUseMp -> + (case (\mlev v -> _lhsIlkup (mlev+1) v) of + { _l1'Olkup -> + (case (\mlev v -> if v == tv_ then Nothing else _lhsIlkup mlev v) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _l1'OsubstOpts -> + (case (l1'_inst_ _l1'Olkup _l1'OsubstOpts _l1'OtvUseMp) of + { ( _l1'IcycVarMp,_l1'Irepl) -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (varmpIncMetaLev _l1'IcycVarMp `varmpPlus` _tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (_lhsItvUseMp) of + { _quOtvUseMp -> + (case (qu_ _quOtvUseMp) of + { ( _quIcycVarMp,_quIrepl) -> + (case (Ty_TBind _quIrepl tv_ _l1'Irepl _tyIrepl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _extTyOtvUseMp -> + (case (_lhsIlkup) of + { _extTyOlkup -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _extTyOsubstOpts -> + (case (extTy_ _extTyOlkup _extTyOsubstOpts _extTyOtvUseMp) of + { ( _extTyIcycVarMp,_extTyIrepl) -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp `varmpPlus` _extTyIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Ext _tyIrepl nm_ _extTyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) }) }) }) }) })) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _prOtvUseMp -> + (case (_lhsIlkup) of + { _prOlkup -> + (case (_lhsIsubstOpts) of + { _prOsubstOpts -> + (case (pr_ _prOlkup _prOsubstOpts _prOtvUseMp) of + { ( _prIcycVarMp,_prIrepl) -> + (case (_prIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Pred _prIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (Map.insert tv_ TVBound _lhsItvUseMp) of + { _tyOtvUseMp -> + (case (\mlev v -> if v == tv_ then Nothing else _lhsIlkup mlev v) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Lam tv_ _tyIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _implsOtvUseMp -> + (case (_lhsIlkup) of + { _implsOlkup -> + (case (_lhsIsubstOpts) of + { _implsOsubstOpts -> + (case (impls_ _implsOlkup _implsOsubstOpts _implsOtvUseMp) of + { ( _implsIcycVarMp,_implsIrepl) -> + (case (_implsIcycVarMp) of + { _lhsOcycVarMp -> + (case (Ty_Impls _implsIrepl) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attributes: + lkup : Lkup + substOpts : SubstOpts + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : Ty + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = Lkup -> + SubstOpts -> + TVUseMp -> + ( VarMp,Ty) +data Inh_TyAGItf = Inh_TyAGItf {lkup_Inh_TyAGItf :: !(Lkup),substOpts_Inh_TyAGItf :: !(SubstOpts),tvUseMp_Inh_TyAGItf :: !(TVUseMp)} +data Syn_TyAGItf = Syn_TyAGItf {cycVarMp_Syn_TyAGItf :: !(VarMp),repl_Syn_TyAGItf :: !(Ty)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsIlkup _lhsIsubstOpts _lhsItvUseMp) = + (let ( _lhsOcycVarMp,_lhsOrepl) = sem _lhsIlkup _lhsIsubstOpts _lhsItvUseMp + in (Syn_TyAGItf _lhsOcycVarMp _lhsOrepl)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsIlkup + _lhsIsubstOpts + _lhsItvUseMp -> + (case (_lhsItvUseMp) of + { _tyOtvUseMp -> + (case (_lhsIlkup) of + { _tyOlkup -> + (case (_lhsIsubstOpts) of + { _tyOsubstOpts -> + (case (ty_ _tyOlkup _tyOsubstOpts _tyOtvUseMp) of + { ( _tyIcycVarMp,_tyIrepl) -> + (case (_tyIcycVarMp) of + { _lhsOcycVarMp -> + (case (_tyIrepl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) }) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + visit 0: + inherited attribute: + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : TyAnn + alternatives: + alternative Empty: + visit 0: + local repl : _ + alternative Strictness: + child s : {Strictness} + visit 0: + local repl : _ + alternative Mono: + visit 0: + local repl : _ +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = TVUseMp -> + ( VarMp,TyAnn) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyAnn_Empty) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyAnn_Strictness s_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyAnn_Mono) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +-- TyQu -------------------------------------------------------- +{- + visit 0: + inherited attribute: + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : TyQu + alternatives: + alternative Forall: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Exists: + child mlev : {MetaLev} + visit 0: + local repl : _ + alternative Plain: + child mlev : {MetaLev} + visit 0: + local repl : _ +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = TVUseMp -> + ( VarMp,TyQu) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyQu_Forall mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyQu_Exists mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyQu_Plain mlev_) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +-- TyVarCateg -------------------------------------------------- +{- + visit 0: + inherited attribute: + tvUseMp : TVUseMp + synthesized attributes: + cycVarMp : VarMp + repl : TyVarCateg + alternatives: + alternative Plain: + visit 0: + local repl : _ + alternative Fixed: + visit 0: + local repl : _ + alternative Meta: + visit 0: + local repl : _ +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = TVUseMp -> + ( VarMp,TyVarCateg) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyVarCateg_Plain) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyVarCateg_Fixed) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + (\ _lhsItvUseMp -> + (case (emptyVarMp) of + { _lhsOcycVarMp -> + (case (TyVarCateg_Meta) of + { _repl -> + (case (_repl) of + { _lhsOrepl -> + ( _lhsOcycVarMp,_lhsOrepl) }) }) })) diff --git a/src/UHC/Light/Compiler/Ty/UsedNames.hs b/src/UHC/Light/Compiler/Ty/UsedNames.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/UsedNames.hs @@ -0,0 +1,672 @@ + + +-- UUAGC 0.9.50.2 (build/103/lib-ehc/UHC/Light/Compiler/Ty/UsedNames.a) +module UHC.Light.Compiler.Ty.UsedNames(tyUsedNames) where + +import Data.List +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import qualified Data.Set as Set +import qualified Data.Map as Map +import UHC.Light.Compiler.Module.ImportExport + + + +{-| +There are some conventions/restrictions on the structure of types that are not enforced +by the abstract syntax: + +Encoding of prove-constraints: + concrete syntax: + {! impls !} -> ty + abstract syntax: + Ty_App (Ty_App (Ty_Con "->") (Ty_Impls impls)) ty + +Encoding of assume-constraints: + concrete syntax: + (ty, {! pred1 !}, ..., {! predn !}) + abstract syntax: + Ty_Ext (... (Ty_Ext ty (prod m+1) (Ty_Pred pred_1) ) ...) (prod m+n) (Ty_Pred pred_n) + + In other words: the predicates are at the outset of a product, pred_n "more outermost" + than pred_{n-1}. + +-} + + +{-| +The basic alternatives encode the following: +- Con: data type constructors, including tuple constructors +- App: application to 1 argument, for example 'a -> b' is encoded as (App (App -> a) b) +- Any: representing Bot/Top depending on context: (1) unknown expected type, (2) error type +- Var: type variables, including a category: plain tyvars, fixed tyvars (aka skolems) + +-} + + + + + + + + + + +tyUsedNames :: HsName -> Ty -> ModEntRelFilterMp +tyUsedNames moduleNm ty + = mentrelFilterMp_Syn_TyAGItf t + where t = wrap_TyAGItf + (sem_TyAGItf (TyAGItf_AGItf ty)) + (Inh_TyAGItf + { moduleNm_Inh_TyAGItf = moduleNm + }) + +-- Impls ------------------------------------------------------- +{- + visit 0: + inherited attribute: + moduleNm : HsName + synthesized attribute: + mentrelFilterMp : ModEntRelFilterMp + alternatives: + alternative Tail: + child iv : {ImplsVarId} + child proveOccs : {[ImplsProveOcc]} + alternative Cons: + child iv : {ImplsVarId} + child pr : Pred + child pv : {PredOccId} + child prange : {Range} + child proveOccs : {[ImplsProveOcc]} + child tl : Impls + alternative Nil: +-} +-- cata +sem_Impls :: Impls -> + T_Impls +sem_Impls (Impls_Tail _iv _proveOccs) = + (sem_Impls_Tail _iv _proveOccs) +sem_Impls (Impls_Cons _iv _pr _pv _prange _proveOccs _tl) = + (sem_Impls_Cons _iv (sem_Pred _pr) _pv _prange _proveOccs (sem_Impls _tl)) +sem_Impls (Impls_Nil) = + (sem_Impls_Nil) +-- semantic domain +type T_Impls = HsName -> + ( ModEntRelFilterMp) +sem_Impls_Tail :: ImplsVarId -> + ([ImplsProveOcc]) -> + T_Impls +sem_Impls_Tail iv_ proveOccs_ = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Impls_Cons :: ImplsVarId -> + T_Pred -> + PredOccId -> + Range -> + ([ImplsProveOcc]) -> + T_Impls -> + T_Impls +sem_Impls_Cons iv_ pr_ pv_ prange_ proveOccs_ tl_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm -> + (case (_lhsImoduleNm) of + { _prOmoduleNm -> + (case (tl_ _tlOmoduleNm) of + { ( _tlImentrelFilterMp) -> + (case (pr_ _prOmoduleNm) of + { ( _prImentrelFilterMp) -> + (case (_prImentrelFilterMp `mentrelFilterMpUnion` _tlImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_Impls_Nil :: T_Impls +sem_Impls_Nil = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +-- Label ------------------------------------------------------- +{- + alternatives: + alternative Lab: + child nm : {HsName} + alternative Var: + child lv : {LabelVarId} +-} +-- cata +sem_Label :: Label -> + T_Label +sem_Label (Label_Lab _nm) = + (sem_Label_Lab _nm) +sem_Label (Label_Var _lv) = + (sem_Label_Var _lv) +-- semantic domain +type T_Label = ( ) +sem_Label_Lab :: HsName -> + T_Label +sem_Label_Lab nm_ = + ( ) +sem_Label_Var :: LabelVarId -> + T_Label +sem_Label_Var lv_ = + ( ) +-- LabelAGItf -------------------------------------------------- +{- + alternatives: + alternative AGItf: + child lab : Label +-} +-- cata +sem_LabelAGItf :: LabelAGItf -> + T_LabelAGItf +sem_LabelAGItf (LabelAGItf_AGItf _lab) = + (sem_LabelAGItf_AGItf (sem_Label _lab)) +-- semantic domain +type T_LabelAGItf = ( ) +sem_LabelAGItf_AGItf :: T_Label -> + T_LabelAGItf +sem_LabelAGItf_AGItf lab_ = + ( ) +-- Pred -------------------------------------------------------- +{- + visit 0: + inherited attribute: + moduleNm : HsName + synthesized attribute: + mentrelFilterMp : ModEntRelFilterMp + alternatives: + alternative Class: + child ty : Ty + alternative Pred: + child ty : Ty + alternative Lacks: + child ty : Ty + child lab : Label + alternative Arrow: + child args : PredSeq + child res : Pred + alternative Eq: + child tyL : Ty + child tyR : Ty + alternative Var: + child pv : {TyVarId} + alternative Preds: + child seq : PredSeq +-} +-- cata +sem_Pred :: Pred -> + T_Pred +sem_Pred (Pred_Class _ty) = + (sem_Pred_Class (sem_Ty _ty)) +sem_Pred (Pred_Pred _ty) = + (sem_Pred_Pred (sem_Ty _ty)) +sem_Pred (Pred_Lacks _ty _lab) = + (sem_Pred_Lacks (sem_Ty _ty) (sem_Label _lab)) +sem_Pred (Pred_Arrow _args _res) = + (sem_Pred_Arrow (sem_PredSeq _args) (sem_Pred _res)) +sem_Pred (Pred_Eq _tyL _tyR) = + (sem_Pred_Eq (sem_Ty _tyL) (sem_Ty _tyR)) +sem_Pred (Pred_Var _pv) = + (sem_Pred_Var _pv) +sem_Pred (Pred_Preds _seq) = + (sem_Pred_Preds (sem_PredSeq _seq)) +-- semantic domain +type T_Pred = HsName -> + ( ModEntRelFilterMp) +sem_Pred_Class :: T_Ty -> + T_Pred +sem_Pred_Class ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Pred_Pred :: T_Ty -> + T_Pred +sem_Pred_Pred ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Pred_Lacks :: T_Ty -> + T_Label -> + T_Pred +sem_Pred_Lacks ty_ lab_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Pred_Arrow :: T_PredSeq -> + T_Pred -> + T_Pred +sem_Pred_Arrow args_ res_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _resOmoduleNm -> + (case (_lhsImoduleNm) of + { _argsOmoduleNm -> + (case (res_ _resOmoduleNm) of + { ( _resImentrelFilterMp) -> + (case (args_ _argsOmoduleNm) of + { ( _argsImentrelFilterMp) -> + (case (_argsImentrelFilterMp `mentrelFilterMpUnion` _resImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_Pred_Eq :: T_Ty -> + T_Ty -> + T_Pred +sem_Pred_Eq tyL_ tyR_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyROmoduleNm -> + (case (_lhsImoduleNm) of + { _tyLOmoduleNm -> + (case (tyR_ _tyROmoduleNm) of + { ( _tyRImentrelFilterMp) -> + (case (tyL_ _tyLOmoduleNm) of + { ( _tyLImentrelFilterMp) -> + (case (_tyLImentrelFilterMp `mentrelFilterMpUnion` _tyRImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_Pred_Var :: TyVarId -> + T_Pred +sem_Pred_Var pv_ = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Pred_Preds :: T_PredSeq -> + T_Pred +sem_Pred_Preds seq_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _seqOmoduleNm -> + (case (seq_ _seqOmoduleNm) of + { ( _seqImentrelFilterMp) -> + (case (_seqImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +-- PredSeq ----------------------------------------------------- +{- + visit 0: + inherited attribute: + moduleNm : HsName + synthesized attribute: + mentrelFilterMp : ModEntRelFilterMp + alternatives: + alternative Cons: + child hd : Pred + child tl : PredSeq + alternative Nil: + alternative Var: + child av : {TyVarId} +-} +-- cata +sem_PredSeq :: PredSeq -> + T_PredSeq +sem_PredSeq (PredSeq_Cons _hd _tl) = + (sem_PredSeq_Cons (sem_Pred _hd) (sem_PredSeq _tl)) +sem_PredSeq (PredSeq_Nil) = + (sem_PredSeq_Nil) +sem_PredSeq (PredSeq_Var _av) = + (sem_PredSeq_Var _av) +-- semantic domain +type T_PredSeq = HsName -> + ( ModEntRelFilterMp) +sem_PredSeq_Cons :: T_Pred -> + T_PredSeq -> + T_PredSeq +sem_PredSeq_Cons hd_ tl_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tlOmoduleNm -> + (case (_lhsImoduleNm) of + { _hdOmoduleNm -> + (case (tl_ _tlOmoduleNm) of + { ( _tlImentrelFilterMp) -> + (case (hd_ _hdOmoduleNm) of + { ( _hdImentrelFilterMp) -> + (case (_hdImentrelFilterMp `mentrelFilterMpUnion` _tlImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_PredSeq_Nil :: T_PredSeq +sem_PredSeq_Nil = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_PredSeq_Var :: TyVarId -> + T_PredSeq +sem_PredSeq_Var av_ = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +-- Ty ---------------------------------------------------------- +{- + visit 0: + inherited attribute: + moduleNm : HsName + synthesized attribute: + mentrelFilterMp : ModEntRelFilterMp + alternatives: + alternative Con: + child nm : {HsName} + alternative App: + child func : Ty + child arg : Ty + alternative Ann: + child ann : TyAnn + child ty : Ty + alternative Dbg: + child info : {String} + alternative Any: + alternative Var: + child tv : {TyVarId} + child categ : TyVarCateg + alternative TBind: + child qu : TyQu + child tv : {TyVarId} + child l1 : {Ty} + child ty : Ty + alternative Ext: + child ty : Ty + child nm : {HsName} + child extTy : Ty + alternative Pred: + child pr : Pred + alternative Lam: + child tv : {TyVarId} + child ty : Ty + alternative Impls: + child impls : Impls +-} +-- cata +sem_Ty :: Ty -> + T_Ty +sem_Ty (Ty_Con _nm) = + (sem_Ty_Con _nm) +sem_Ty (Ty_App _func _arg) = + (sem_Ty_App (sem_Ty _func) (sem_Ty _arg)) +sem_Ty (Ty_Ann _ann _ty) = + (sem_Ty_Ann (sem_TyAnn _ann) (sem_Ty _ty)) +sem_Ty (Ty_Dbg _info) = + (sem_Ty_Dbg _info) +sem_Ty (Ty_Any) = + (sem_Ty_Any) +sem_Ty (Ty_Var _tv _categ) = + (sem_Ty_Var _tv (sem_TyVarCateg _categ)) +sem_Ty (Ty_TBind _qu _tv _l1 _ty) = + (sem_Ty_TBind (sem_TyQu _qu) _tv _l1 (sem_Ty _ty)) +sem_Ty (Ty_Ext _ty _nm _extTy) = + (sem_Ty_Ext (sem_Ty _ty) _nm (sem_Ty _extTy)) +sem_Ty (Ty_Pred _pr) = + (sem_Ty_Pred (sem_Pred _pr)) +sem_Ty (Ty_Lam _tv _ty) = + (sem_Ty_Lam _tv (sem_Ty _ty)) +sem_Ty (Ty_Impls _impls) = + (sem_Ty_Impls (sem_Impls _impls)) +-- semantic domain +type T_Ty = HsName -> + ( ModEntRelFilterMp) +sem_Ty_Con :: HsName -> + T_Ty +sem_Ty_Con nm_ = + (\ _lhsImoduleNm -> + (case (mentrelFilterMpSingleton [_lhsImoduleNm] IdOcc_Type nm_) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Ty_App :: T_Ty -> + T_Ty -> + T_Ty +sem_Ty_App func_ arg_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _argOmoduleNm -> + (case (_lhsImoduleNm) of + { _funcOmoduleNm -> + (case (arg_ _argOmoduleNm) of + { ( _argImentrelFilterMp) -> + (case (func_ _funcOmoduleNm) of + { ( _funcImentrelFilterMp) -> + (case (_funcImentrelFilterMp `mentrelFilterMpUnion` _argImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_Ty_Ann :: T_TyAnn -> + T_Ty -> + T_Ty +sem_Ty_Ann ann_ ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Ty_Dbg :: String -> + T_Ty +sem_Ty_Dbg info_ = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Ty_Any :: T_Ty +sem_Ty_Any = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Ty_Var :: TyVarId -> + T_TyVarCateg -> + T_Ty +sem_Ty_Var tv_ categ_ = + (\ _lhsImoduleNm -> + (case (Map.empty) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) })) +sem_Ty_TBind :: T_TyQu -> + TyVarId -> + Ty -> + T_Ty -> + T_Ty +sem_Ty_TBind qu_ tv_ l1_ ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Ty_Ext :: T_Ty -> + HsName -> + T_Ty -> + T_Ty +sem_Ty_Ext ty_ nm_ extTy_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _extTyOmoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (extTy_ _extTyOmoduleNm) of + { ( _extTyImentrelFilterMp) -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp `mentrelFilterMpUnion` _extTyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) }) }) })) +sem_Ty_Pred :: T_Pred -> + T_Ty +sem_Ty_Pred pr_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _prOmoduleNm -> + (case (pr_ _prOmoduleNm) of + { ( _prImentrelFilterMp) -> + (case (_prImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Ty_Lam :: TyVarId -> + T_Ty -> + T_Ty +sem_Ty_Lam tv_ ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +sem_Ty_Impls :: T_Impls -> + T_Ty +sem_Ty_Impls impls_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _implsOmoduleNm -> + (case (impls_ _implsOmoduleNm) of + { ( _implsImentrelFilterMp) -> + (case (_implsImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +-- TyAGItf ----------------------------------------------------- +{- + visit 0: + inherited attribute: + moduleNm : HsName + synthesized attribute: + mentrelFilterMp : ModEntRelFilterMp + alternatives: + alternative AGItf: + child ty : Ty +-} +-- cata +sem_TyAGItf :: TyAGItf -> + T_TyAGItf +sem_TyAGItf (TyAGItf_AGItf _ty) = + (sem_TyAGItf_AGItf (sem_Ty _ty)) +-- semantic domain +type T_TyAGItf = HsName -> + ( ModEntRelFilterMp) +data Inh_TyAGItf = Inh_TyAGItf {moduleNm_Inh_TyAGItf :: !(HsName)} +data Syn_TyAGItf = Syn_TyAGItf {mentrelFilterMp_Syn_TyAGItf :: !(ModEntRelFilterMp)} +wrap_TyAGItf :: T_TyAGItf -> + Inh_TyAGItf -> + Syn_TyAGItf +wrap_TyAGItf sem (Inh_TyAGItf _lhsImoduleNm) = + (let ( _lhsOmentrelFilterMp) = sem _lhsImoduleNm + in (Syn_TyAGItf _lhsOmentrelFilterMp)) +sem_TyAGItf_AGItf :: T_Ty -> + T_TyAGItf +sem_TyAGItf_AGItf ty_ = + (\ _lhsImoduleNm -> + (case (_lhsImoduleNm) of + { _tyOmoduleNm -> + (case (ty_ _tyOmoduleNm) of + { ( _tyImentrelFilterMp) -> + (case (_tyImentrelFilterMp) of + { _lhsOmentrelFilterMp -> + ( _lhsOmentrelFilterMp) }) }) })) +-- TyAnn ------------------------------------------------------- +{- + alternatives: + alternative Empty: + alternative Strictness: + child s : {Strictness} + alternative Mono: +-} +-- cata +sem_TyAnn :: TyAnn -> + T_TyAnn +sem_TyAnn (TyAnn_Empty) = + (sem_TyAnn_Empty) +sem_TyAnn (TyAnn_Strictness _s) = + (sem_TyAnn_Strictness _s) +sem_TyAnn (TyAnn_Mono) = + (sem_TyAnn_Mono) +-- semantic domain +type T_TyAnn = ( ) +sem_TyAnn_Empty :: T_TyAnn +sem_TyAnn_Empty = + ( ) +sem_TyAnn_Strictness :: Strictness -> + T_TyAnn +sem_TyAnn_Strictness s_ = + ( ) +sem_TyAnn_Mono :: T_TyAnn +sem_TyAnn_Mono = + ( ) +-- TyQu -------------------------------------------------------- +{- + alternatives: + alternative Forall: + child mlev : {MetaLev} + alternative Exists: + child mlev : {MetaLev} + alternative Plain: + child mlev : {MetaLev} +-} +-- cata +sem_TyQu :: TyQu -> + T_TyQu +sem_TyQu (TyQu_Forall _mlev) = + (sem_TyQu_Forall _mlev) +sem_TyQu (TyQu_Exists _mlev) = + (sem_TyQu_Exists _mlev) +sem_TyQu (TyQu_Plain _mlev) = + (sem_TyQu_Plain _mlev) +-- semantic domain +type T_TyQu = ( ) +sem_TyQu_Forall :: MetaLev -> + T_TyQu +sem_TyQu_Forall mlev_ = + ( ) +sem_TyQu_Exists :: MetaLev -> + T_TyQu +sem_TyQu_Exists mlev_ = + ( ) +sem_TyQu_Plain :: MetaLev -> + T_TyQu +sem_TyQu_Plain mlev_ = + ( ) +-- TyVarCateg -------------------------------------------------- +{- + alternatives: + alternative Plain: + alternative Fixed: + alternative Meta: +-} +-- cata +sem_TyVarCateg :: TyVarCateg -> + T_TyVarCateg +sem_TyVarCateg (TyVarCateg_Plain) = + (sem_TyVarCateg_Plain) +sem_TyVarCateg (TyVarCateg_Fixed) = + (sem_TyVarCateg_Fixed) +sem_TyVarCateg (TyVarCateg_Meta) = + (sem_TyVarCateg_Meta) +-- semantic domain +type T_TyVarCateg = ( ) +sem_TyVarCateg_Plain :: T_TyVarCateg +sem_TyVarCateg_Plain = + ( ) +sem_TyVarCateg_Fixed :: T_TyVarCateg +sem_TyVarCateg_Fixed = + ( ) +sem_TyVarCateg_Meta :: T_TyVarCateg +sem_TyVarCateg_Meta = + ( ) diff --git a/src/UHC/Light/Compiler/Ty/Utils1.hs b/src/UHC/Light/Compiler/Ty/Utils1.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Utils1.hs @@ -0,0 +1,24 @@ +module UHC.Light.Compiler.Ty.Utils1 +( ppTyS +, tyTopLevelMain ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Base.TermLike +import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts + + + +{-# LINE 19 "src/ehc/Ty/Utils1.chs" #-} +ppTyS :: VarUpdatable Ty m => m -> Ty -> PP_Doc +ppTyS = ppS ppTy + +{-# LINE 24 "src/ehc/Ty/Utils1.chs" #-} +tyTopLevelMain :: EHCOpts -> TyVarId -> Ty +tyTopLevelMain opts uniq = appCon1App (ehcOptBuiltin opts ehbnIO) (mkTyVar uniq) + diff --git a/src/UHC/Light/Compiler/Ty/Utils2.hs b/src/UHC/Light/Compiler/Ty/Utils2.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/Ty/Utils2.hs @@ -0,0 +1,24 @@ +module UHC.Light.Compiler.Ty.Utils2 +( foAppLRCoeAsSubst ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Base.HsName.Builtin +import UHC.Light.Compiler.Opts +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty.FitsInCommon +import UHC.Light.Compiler.AbstractCore +import UHC.Light.Compiler.Core +import UHC.Light.Compiler.Core.Subst + + + +{-# LINE 26 "src/ehc/Ty/Utils2.chs" #-} +foAppLRCoeAsSubst :: EHCOpts -> UID -> FIOut -> VarMp -> CSubst -> CExpr -> (CExpr,CSubst) +foAppLRCoeAsSubst opts uniq fo c cs ce + = (ce', foCSubst fo `cSubstApp` s1 `cSubstApp` s2) + where (u',u1,u2) = mkNewLevUID2 uniq + -- s0 = cs `cSubstApp` foCSubst fo + (ww ,s1) = lrcoeWipeWeaveAsSubst opts u1 c (foLRCoe fo) + (ce',s2) = coeEvalOnAsSubst u2 ww ce + diff --git a/src/UHC/Light/Compiler/VarLookup.hs b/src/UHC/Light/Compiler/VarLookup.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/VarLookup.hs @@ -0,0 +1,8 @@ +module UHC.Light.Compiler.VarLookup +( module UHC.Util.VarLookup ) +where +import UHC.Util.VarLookup + +{-# LINE 16 "src/ehc/VarLookup.chs" #-} +-- moved to uhc-util package + diff --git a/src/UHC/Light/Compiler/VarMp.hs b/src/UHC/Light/Compiler/VarMp.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/VarMp.hs @@ -0,0 +1,335 @@ +module UHC.Light.Compiler.VarMp +( vmiMbTy +, tyAsVarMp', tyAsVarMp +, varmpTyLookupCyc +, varmpTyLookupCyc2 +, module UHC.Util.VarMp +, module UHC.Light.Compiler.VarLookup +, assocMetaLevTyLToVarMp, assocTyLToVarMp, varmpToAssocTyL +, instToL1VarMp +, VarMpInfo (..) +, VarMp +, varmpFilterTy +, varmpMetaLevTyUnit, varmpTyUnit +, tyRestrictKiVarMp +, varmpTyLookup +, vmiMbImpls, vmiMbScope, vmiMbPred, vmiMbAssNm +, varmpTailAddOcc +, varmpMapThr, varmpMapThrTy +, varmpImplsUnit, assocImplsLToVarMp, varmpScopeUnit, varmpPredUnit, varmpAssNmUnit +, varmpImplsLookup, varmpScopeLookup, varmpPredLookup +, varmpImplsLookupImplsCyc, varmpImplsLookupCyc, varmpScopeLookupScopeCyc, varmpAssNmLookupAssNmCyc +, varmpPredLookup2, varmpScopeLookup2, varmpAssNmLookup2, varmpImplsLookupCyc2 +, vmiMbLabel, vmiMbOffset +, varmpLabelUnit, varmpOffsetUnit +, varmpLabelLookup, varmpOffsetLookup +, varmpLabelLookupCyc, varmpLabelLookupLabelCyc +, vmiMbPredSeq +, varmpPredSeqUnit +, varmpPredSeqLookup +, varmpinfoMkVar +, ppVarMpInfoCfgTy, ppVarMpInfoDt ) +where +import Data.List +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import qualified Data.Map as Map +import qualified Data.Set as Set +import Data.Maybe +import UHC.Util.Pretty +import UHC.Light.Compiler.Ty.Pretty +import UHC.Light.Compiler.Error +import UHC.Util.VarMp +import UHC.Light.Compiler.VarLookup +import UHC.Light.Compiler.Base.Debug +import UHC.Util.Utils +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + + + + + +{-# LINE 84 "src/ehc/VarMp.chs" #-} +-- moved to package uhc-util + + +{-# LINE 163 "src/ehc/VarMp.chs" #-} +assocMetaLevTyLToVarMp :: Ord k => AssocL k (MetaLev,Ty) -> VarMp' k VarMpInfo +assocMetaLevTyLToVarMp = assocMetaLevLToVarMp . assocLMapElt (\(ml,t) -> (ml, VMITy t)) -- varmpUnions [ varmpMetaLevTyUnit lev v t | (v,(lev,t)) <- l ] + +assocTyLToVarMp :: Ord k => AssocL k Ty -> VarMp' k VarMpInfo +assocTyLToVarMp = assocLToVarMp . assocLMapElt VMITy + +varmpToAssocTyL :: VarMp' k VarMpInfo -> AssocL k Ty +varmpToAssocTyL c = [ (v,t) | (v,VMITy t) <- varmpToAssocL c ] + + +{-# LINE 206 "src/ehc/VarMp.chs" #-} +instToL1VarMp :: [InstTo] -> VarMp +instToL1VarMp = varmpIncMetaLev . assocMetaLevTyLToVarMp . instToL1AssocL + +{-# LINE 215 "src/ehc/VarMp.chs" #-} +data VarMpInfo + = VMITy !Ty + | VMIImpls !Impls + | VMIScope !PredScope + | VMIPred !Pred + | VMIAssNm !VarUIDHsName + | VMILabel !Label + | VMIOffset !LabelOffset +-- | VMIExts !RowExts + | VMIPredSeq !PredSeq + deriving + ( Eq, Ord, Show + , Typeable, Data + ) + +{-# LINE 244 "src/ehc/VarMp.chs" #-} +vmiMbTy i = case i of {VMITy x -> Just x; _ -> Nothing} + +{-# LINE 254 "src/ehc/VarMp.chs" #-} +vmiMbImpls i = case i of {VMIImpls x -> Just x; _ -> Nothing} +vmiMbScope i = case i of {VMIScope x -> Just x; _ -> Nothing} +vmiMbPred i = case i of {VMIPred x -> Just x; _ -> Nothing} +vmiMbAssNm i = case i of {VMIAssNm x -> Just x; _ -> Nothing} +{-# LINE 260 "src/ehc/VarMp.chs" #-} +vmiMbLabel i = case i of {VMILabel x -> Just x; _ -> Nothing} +vmiMbOffset i = case i of {VMIOffset x -> Just x; _ -> Nothing} +{-# LINE 264 "src/ehc/VarMp.chs" #-} +vmiMbPredSeq i = case i of {VMIPredSeq x -> Just x; _ -> Nothing} + +{-# LINE 278 "src/ehc/VarMp.chs" #-} +type VarMp = VarMp' VarId VarMpInfo + +{-# LINE 287 "src/ehc/VarMp.chs" #-} +varmpFilterTy :: Ord k => (k -> Ty -> Bool) -> VarMp' k VarMpInfo -> VarMp' k VarMpInfo +varmpFilterTy f + = varmpFilter + (\v i -> case i of {VMITy t -> f v t ; _ -> True}) + +{-# LINE 298 "src/ehc/VarMp.chs" #-} +varmpTailAddOcc :: ImplsProveOcc -> Impls -> (Impls,VarMp) +varmpTailAddOcc o (Impls_Tail i os) = (t, varmpImplsUnit i t) + where t = Impls_Tail i (o:os) +varmpTailAddOcc _ x = (x,emptyVarMp) + +{-# LINE 309 "src/ehc/VarMp.chs" #-} +varmpMapThr :: (MetaLev -> TyVarId -> VarMpInfo -> thr -> (VarMpInfo,thr)) -> thr -> VarMp -> (VarMp,thr) +varmpMapThr f thr (VarMp l ms) + = (VarMp l ms',thr') + where (ms',thr') = foldMlev thr ms + foldMp mlev thr fm + = Map.foldrWithKey + (\v i (fm,thr) + -> let (i',thr') = f mlev v i thr + in (Map.insert v i' fm,thr') + ) + (Map.empty,thr) fm + foldMlev thr ms + = foldr + (\(mlev,m) (ms,thr) + -> let (m',thr') = foldMp mlev thr m + in (m':ms,thr') + ) + ([],thr) (zip [0..] ms) + +varmpMapThrTy :: (MetaLev -> TyVarId -> Ty -> thr -> (Ty,thr)) -> thr -> VarMp -> (VarMp,thr) +varmpMapThrTy f + = varmpMapThr + (\mlev v i thr + -> case i of + VMITy t -> (VMITy t,thr') + where (t',thr') = f mlev v t thr + _ -> (i,thr) + ) + +{-# LINE 351 "src/ehc/VarMp.chs" #-} +varmpinfoMkVar :: TyVarId -> VarMpInfo -> Ty +varmpinfoMkVar v i + = case i of + VMITy t -> mkTyVar v + VMIImpls i -> mkImplsVar v + _ -> mkTyVar v -- rest incomplete + +{-# LINE 369 "src/ehc/VarMp.chs" #-} +varmpMetaLevTyUnit :: Ord k => MetaLev -> k -> Ty -> VarMp' k VarMpInfo +varmpMetaLevTyUnit mlev v t = varmpMetaLevSingleton mlev v (VMITy t) + +varmpTyUnit :: Ord k => k -> Ty -> VarMp' k VarMpInfo +varmpTyUnit = varmpMetaLevTyUnit metaLevVal + +{-# LINE 382 "src/ehc/VarMp.chs" #-} +varmpImplsUnit :: ImplsVarId -> Impls -> VarMp +varmpImplsUnit v i = mkVarMp (Map.fromList [(v,VMIImpls i)]) + +varmpScopeUnit :: TyVarId -> PredScope -> VarMp +varmpScopeUnit v sc = mkVarMp (Map.fromList [(v,VMIScope sc)]) + +varmpPredUnit :: TyVarId -> Pred -> VarMp +varmpPredUnit v p = mkVarMp (Map.fromList [(v,VMIPred p)]) + +varmpAssNmUnit :: TyVarId -> VarUIDHsName -> VarMp +varmpAssNmUnit v p = mkVarMp (Map.fromList [(v,VMIAssNm p)]) + +assocImplsLToVarMp :: AssocL ImplsVarId Impls -> VarMp +assocImplsLToVarMp = mkVarMp . Map.fromList . assocLMapElt VMIImpls + +{-# LINE 400 "src/ehc/VarMp.chs" #-} +varmpLabelUnit :: LabelVarId -> Label -> VarMp +varmpLabelUnit v l = mkVarMp (Map.fromList [(v,VMILabel l)]) + +varmpOffsetUnit :: UID -> LabelOffset -> VarMp +varmpOffsetUnit v l = mkVarMp (Map.fromList [(v,VMIOffset l)]) + + +{-# LINE 411 "src/ehc/VarMp.chs" #-} +varmpPredSeqUnit :: TyVarId -> PredSeq -> VarMp +varmpPredSeqUnit v l = mkVarMp (Map.fromList [(v,VMIPredSeq l)]) + +{-# LINE 416 "src/ehc/VarMp.chs" #-} +-- restrict the kinds of tvars bound to value identifiers to kind * +tyRestrictKiVarMp :: [Ty] -> VarMp +tyRestrictKiVarMp ts = varmpIncMetaLev $ assocTyLToVarMp [ (v,kiStar) | t <- ts, v <- maybeToList $ tyMbVar t ] + +{-# LINE 426 "src/ehc/VarMp.chs" #-} +-- | Encode 'ty' as a tvar + VarMp, with additional initial construction +tyAsVarMp' :: (UID -> Ty -> Ty) -> UID -> Ty -> (Ty,VarMp) +tyAsVarMp' f u t + = case f v1 t of + t | tyIsVar t -> (t, emptyVarMp) + | otherwise -> (mkTyVar v2, varmpTyUnit v2 t) + where [v1,v2] = mkNewLevUIDL 2 u + +-- | Encode 'ty' as a tvar + VarMp +tyAsVarMp :: UID -> Ty -> (Ty,VarMp) +tyAsVarMp = tyAsVarMp' (flip const) + +{-# LINE 451 "src/ehc/VarMp.chs" #-} +varmpTyLookup :: (VarLookup m k VarMpInfo,Ord k) => k -> m -> Maybe Ty +varmpTyLookup = varlookupMap vmiMbTy + +{-# LINE 456 "src/ehc/VarMp.chs" #-} +varmpImplsLookup :: VarLookup m ImplsVarId VarMpInfo => ImplsVarId -> m -> Maybe Impls +varmpImplsLookup = varlookupMap vmiMbImpls + +varmpScopeLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe PredScope +varmpScopeLookup = varlookupMap vmiMbScope + +varmpPredLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe Pred +varmpPredLookup = varlookupMap vmiMbPred + +varmpAssNmLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe VarUIDHsName +varmpAssNmLookup = varlookupMap vmiMbAssNm + +{-# LINE 470 "src/ehc/VarMp.chs" #-} +varmpLabelLookup :: VarLookup m LabelVarId VarMpInfo => LabelVarId -> m -> Maybe Label +varmpLabelLookup = varlookupMap vmiMbLabel + +varmpOffsetLookup :: VarLookup m UID VarMpInfo => UID -> m -> Maybe LabelOffset +varmpOffsetLookup = varlookupMap vmiMbOffset + +{-# LINE 478 "src/ehc/VarMp.chs" #-} +varmpPredSeqLookup :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe PredSeq +varmpPredSeqLookup = varlookupMap vmiMbPredSeq + +{-# LINE 487 "src/ehc/VarMp.chs" #-} +varmpTyLookupCyc :: VarLookup m TyVarId VarMpInfo => TyVarId -> m -> Maybe Ty +varmpTyLookupCyc x m = lookupLiftCycMb2 tyMbVar (flip varmpTyLookup m) x + +{-# LINE 496 "src/ehc/VarMp.chs" #-} +varmpImplsLookupImplsCyc :: VarLookup m ImplsVarId VarMpInfo => Impls -> m -> Maybe Impls +varmpImplsLookupImplsCyc x m = lookupLiftCycMb1 implsMbVar (flip varmpImplsLookup m) x + +varmpImplsLookupCyc :: VarLookup m ImplsVarId VarMpInfo => TyVarId -> m -> Maybe Impls +varmpImplsLookupCyc x m = lookupLiftCycMb2 implsMbVar (flip varmpImplsLookup m) x + +varmpScopeLookupScopeCyc :: VarLookup m ImplsVarId VarMpInfo => PredScope -> m -> Maybe PredScope +varmpScopeLookupScopeCyc x m = lookupLiftCycMb1 pscpMbVar (flip varmpScopeLookup m) x + +varmpAssNmLookupAssNmCyc :: VarLookup m ImplsVarId VarMpInfo => VarUIDHsName -> m -> Maybe VarUIDHsName +varmpAssNmLookupAssNmCyc x m = lookupLiftCycMb1 vunmMbVar (flip varmpAssNmLookup m) x + +{-# LINE 510 "src/ehc/VarMp.chs" #-} +varmpLabelLookupLabelCyc :: VarLookup m ImplsVarId VarMpInfo => Label -> m -> Maybe Label +varmpLabelLookupLabelCyc x m = lookupLiftCycMb1 labelMbVar (flip varmpLabelLookup m) x + +varmpLabelLookupCyc :: VarLookup m ImplsVarId VarMpInfo => TyVarId -> m -> Maybe Label +varmpLabelLookupCyc x m = lookupLiftCycMb2 labelMbVar (flip varmpLabelLookup m) x + +{-# LINE 522 "src/ehc/VarMp.chs" #-} +varmpTyLookupCyc2 :: VarMp -> TyVarId -> Maybe Ty +varmpTyLookupCyc2 x m = varmpTyLookupCyc m x + +{-# LINE 527 "src/ehc/VarMp.chs" #-} +varmpScopeLookup2 :: VarMp -> TyVarId -> Maybe PredScope +varmpScopeLookup2 m v = varmpScopeLookup v m + +varmpImplsLookup2 :: VarMp -> ImplsVarId -> Maybe Impls +varmpImplsLookup2 m v = varmpImplsLookup v m + +varmpImplsLookupCyc2 :: VarMp -> ImplsVarId -> Maybe Impls +varmpImplsLookupCyc2 m v = varmpImplsLookupCyc v m + +varmpPredLookup2 :: VarMp -> TyVarId -> Maybe Pred +varmpPredLookup2 m v = varmpPredLookup v m + +varmpAssNmLookup2 :: VarMp -> TyVarId -> Maybe VarUIDHsName +varmpAssNmLookup2 m v = varmpAssNmLookup v m + +{-# LINE 544 "src/ehc/VarMp.chs" #-} +varmpLabelLookup2 :: VarMp -> LabelVarId -> Maybe Label +varmpLabelLookup2 m v = varmpLabelLookup v m + + +{-# LINE 572 "src/ehc/VarMp.chs" #-} +ppVarMpInfoCfgTy :: CfgPPTy -> VarMpInfo -> PP_Doc +ppVarMpInfoCfgTy c i + = case i of + VMITy t -> ppTyWithCfg c t + VMIImpls i -> ppImplsWithCfg c i + VMIScope s -> pp s -- rest incomplete + VMIPred p -> pp p + VMILabel x -> pp x + VMIOffset x -> pp x + VMIPredSeq x -> pp "predseq" -- pp x + +ppVarMpInfoDt :: VarMpInfo -> PP_Doc +ppVarMpInfoDt = ppVarMpInfoCfgTy cfgPPTyDT + +{-# LINE 588 "src/ehc/VarMp.chs" #-} +instance PP VarMpInfo where + pp (VMITy t) = pp t + pp (VMIImpls i) = pp i + pp (VMIScope s) = pp s + pp (VMIPred p) = pp p + pp (VMILabel x) = pp x + pp (VMIOffset x) = pp x + -- pp (VMIExts x) = pp "exts" -- pp x + pp (VMIPredSeq x) = pp "predseq" -- pp x + +{-# LINE 610 "src/ehc/VarMp.chs" #-} +instance Serialize VarMpInfo where + sput (VMITy a) = sputWord8 0 >> sput a + sput (VMIImpls a) = sputWord8 1 >> sput a + sput (VMIScope a) = sputWord8 2 >> sput a + sput (VMIPred a) = sputWord8 3 >> sput a + sput (VMIAssNm a) = sputWord8 4 >> sput a + sput (VMILabel a) = sputWord8 5 >> sput a + sput (VMIOffset a) = sputWord8 6 >> sput a + sput (VMIPredSeq a) = sputWord8 7 >> sput a + sget = do t <- sgetWord8 + case t of + 0 -> liftM VMITy sget + 1 -> liftM VMIImpls sget + 2 -> liftM VMIScope sget + 3 -> liftM VMIPred sget + 4 -> liftM VMIAssNm sget + 5 -> liftM VMILabel sget + 6 -> liftM VMIOffset sget + 7 -> liftM VMIPredSeq sget + + diff --git a/src/UHC/Light/Compiler/VarMp/Utils.hs b/src/UHC/Light/Compiler/VarMp/Utils.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/VarMp/Utils.hs @@ -0,0 +1,27 @@ +module UHC.Light.Compiler.VarMp.Utils +( varmpGraphVisit ) +where +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Substitutable +import qualified Data.Set as Set +import qualified Data.Map as Map + +{-# LINE 34 "src/ehc/VarMp/Utils.chs" #-} +-- | Filter the base level by traversing as a graph +varmpGraphVisit + :: VarIdS + -> VarMp + -> VarMp +varmpGraphVisit start (VarMp l (m:ms)) + = VarMp l (m':ms) + where m' + = graphVisit (\newm m tvar + -> case Map.lookup tvar m of + Just i -> (Map.insert tvar i newm, varFreeSet i) + _ -> (newm,Set.empty) + ) + Set.union + Map.empty + start m + diff --git a/uhc-light.cabal b/uhc-light.cabal new file mode 100644 --- /dev/null +++ b/uhc-light.cabal @@ -0,0 +1,28 @@ +Name: uhc-light +Version: 1.1.7.0 +License: BSD3 +Copyright: Utrecht University, Department of Information and Computing Sciences, Software Technology group +Build-Type: Simple +license-file: LICENSE +Author: UHC Team +Maintainer: uhc-developers@lists.science.uu.nl +Homepage: https://github.com/UU-ComputerScience/uhc +Bug-Reports: https://github.com/UU-ComputerScience/uhc/issues +Category: Development +Synopsis: Part of UHC packaged as cabal/hackage installable library +Description: A 'light' variant of UHC including only an API and an executable for compiling to Core representation. This version is just to test the infrastructure. Later versions will provide a fleshing out of the API etc.. +Cabal-Version: >= 1.8 +data-files: 103/lib/ag/AnaDomain/AbsSyn.ag,103/lib/ag/Cmm/AbsSyn.ag,103/lib/ag/Core/AbsSyn.ag,103/lib/ag/CoreRun/AbsSyn.ag,103/lib/ag/EH/AbsSyn.ag,103/lib/ag/Error/AbsSyn.ag,103/lib/ag/Foreign/AbsSyn.ag,103/lib/ag/GrinByteCode/AbsSyn.ag,103/lib/ag/GrinCode/AbsSyn.ag,103/lib/ag/HS/AbsSyn.ag,103/lib/ag/JavaScript/AbsSyn.ag,103/lib/ag/JVMClass/AbsSyn.ag,103/lib/ag/LLVM/AbsSyn.ag,103/lib/ag/Silly/AbsSyn.ag,103/lib/ag/Ty/AbsSyn.ag,103/lib/ag/TyCore/AbsSyn.ag,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.cr,103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi,103/lib/pkg/array-1.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/CompileAll,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/include/consUtils.h,103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.cr,103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Control/Monad.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Bits.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Char.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Either.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/IORef.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/List.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Maybe.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Data/Typeable.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Debug/Trace.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/Ptr.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Foreign/StablePtr.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/CTypes.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/dirUtils.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBase.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/HsBaseConfig.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/IntLikeInstance.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/MachDeps.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/TupleInstance.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/include/Typeable.h,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/installed-pkg-config,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Error.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Fix.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO/Unsafe.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/System/IO.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Array.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Base.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bits.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Bounded.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/BoxArray.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Char.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Enum.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Eq.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Float.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/GC.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics/Tuple.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Generics.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Handle.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IO.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/IOBase.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ix.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/LazyST.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MutVar.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/MVar.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/OldException.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ord.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Prims.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Ptr.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Read.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Real.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Run.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Show.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/ST.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StablePtr.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/StackTrace.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/STRef.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Types.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/Weak.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/UHC/WeakPtr.hi,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.cr,103/lib/pkg/uhcbase-1.1.7.0/103/cr/plain/Unsafe/Coerce.hi + +Library + Hs-Source-Dirs: src + Build-Depends: fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale + Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,OverlappingInstances,LiberalTypeSynonyms,StandaloneDeriving,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables + Exposed-Modules: UHC.Light.Compiler.API,UHC.Light.Compiler.Core.API + Other-Modules: Paths_uhc_light,UHC.Light.Compiler.AbstractCore,UHC.Light.Compiler.AbstractCore.Utils,UHC.Light.Compiler.AnaDomain,UHC.Light.Compiler.AnaDomain.Ftv,UHC.Light.Compiler.AnaDomain.Pretty,UHC.Light.Compiler.AnaDomain.Trf.Instantiate,UHC.Light.Compiler.AnaDomain.Trf.Subst,UHC.Light.Compiler.AnaDomain.Utils,UHC.Light.Compiler.Base.CfgPP,UHC.Light.Compiler.Base.Common,UHC.Light.Compiler.Base.Debug,UHC.Light.Compiler.Base.FileSearchLocation,UHC.Light.Compiler.Base.Fld,UHC.Light.Compiler.Base.HsName,UHC.Light.Compiler.Base.HsName.Builtin,UHC.Light.Compiler.Base.Optimize,UHC.Light.Compiler.Base.PackageDatabase,UHC.Light.Compiler.Base.ParseUtils,UHC.Light.Compiler.Base.Parser,UHC.Light.Compiler.Base.Parser2,UHC.Light.Compiler.Base.Pragma,UHC.Light.Compiler.Base.RLList,UHC.Light.Compiler.Base.Range,UHC.Light.Compiler.Base.Strictness,UHC.Light.Compiler.Base.Target,UHC.Light.Compiler.Base.TermLike,UHC.Light.Compiler.Base.TreeTrie,UHC.Light.Compiler.Base.UID,UHC.Light.Compiler.CHR,UHC.Light.Compiler.CHR.Constraint,UHC.Light.Compiler.CHR.Key,UHC.Light.Compiler.CHR.Solve,UHC.Light.Compiler.CodeGen.BasicAnnot,UHC.Light.Compiler.CodeGen.Bits,UHC.Light.Compiler.CodeGen.BuiltinPrims,UHC.Light.Compiler.CodeGen.BuiltinSizeInfo,UHC.Light.Compiler.CodeGen.CVar,UHC.Light.Compiler.CodeGen.Const,UHC.Light.Compiler.CodeGen.ImportUsedModules,UHC.Light.Compiler.CodeGen.RefGenerator,UHC.Light.Compiler.CodeGen.Tag,UHC.Light.Compiler.CodeGen.TrfUtils,UHC.Light.Compiler.CodeGen.ValAccess,UHC.Light.Compiler.Config,UHC.Light.Compiler.ConfigCabal,UHC.Light.Compiler.ConfigDefines,UHC.Light.Compiler.ConfigInstall,UHC.Light.Compiler.ConfigInternalVersions,UHC.Light.Compiler.Core,UHC.Light.Compiler.Core.BindExtract,UHC.Light.Compiler.Core.Check,UHC.Light.Compiler.Core.Coercion,UHC.Light.Compiler.Core.ExtractFFE,UHC.Light.Compiler.Core.FFI,UHC.Light.Compiler.Core.FvS,UHC.Light.Compiler.Core.Merge,UHC.Light.Compiler.Core.ModAsMap,UHC.Light.Compiler.Core.Parser,UHC.Light.Compiler.Core.Pretty,UHC.Light.Compiler.Core.Subst,UHC.Light.Compiler.Core.SysF.AsTy,UHC.Light.Compiler.Core.ToCoreRun,UHC.Light.Compiler.Core.ToGrin,UHC.Light.Compiler.Core.Trf,UHC.Light.Compiler.Core.Trf.ANormal,UHC.Light.Compiler.Core.Trf.AnaRelevance,UHC.Light.Compiler.Core.Trf.AnnBasedSimplify,UHC.Light.Compiler.Core.Trf.CAFGlobalAsArg,UHC.Light.Compiler.Core.Trf.ConstProp,UHC.Light.Compiler.Core.Trf.ElimNonCodegenConstructs,UHC.Light.Compiler.Core.Trf.ElimTrivApp,UHC.Light.Compiler.Core.Trf.EraseExtractTysigCore,UHC.Light.Compiler.Core.Trf.EtaRed,UHC.Light.Compiler.Core.Trf.ExplicitStackTrace,UHC.Light.Compiler.Core.Trf.FixAfterParse,UHC.Light.Compiler.Core.Trf.FloatToGlobal,UHC.Light.Compiler.Core.Trf.InlineLetAlias,UHC.Light.Compiler.Core.Trf.LamGlobalAsArg,UHC.Light.Compiler.Core.Trf.LetDefBeforeUse,UHC.Light.Compiler.Core.Trf.LetFlattenStrict,UHC.Light.Compiler.Core.Trf.LetUnrec,UHC.Light.Compiler.Core.Trf.OptimizeStrictness,UHC.Light.Compiler.Core.Trf.RenUniq,UHC.Light.Compiler.Core.UsedModNms,UHC.Light.Compiler.Core.Utils,UHC.Light.Compiler.CoreRun,UHC.Light.Compiler.CoreRun.Pretty,UHC.Light.Compiler.CoreRun.Prim,UHC.Light.Compiler.CoreRun.Run,UHC.Light.Compiler.CoreRun.Run.Val,UHC.Light.Compiler.CoreRun.Run.Val.Prim,UHC.Light.Compiler.CoreRun.Run.Val.RunExplStk,UHC.Light.Compiler.CoreRun.Run.Val.RunImplStk,UHC.Light.Compiler.Deriving,UHC.Light.Compiler.EH,UHC.Light.Compiler.EH.MainAG,UHC.Light.Compiler.EH.MainAG_AGItf,UHC.Light.Compiler.EH.MainAG_CaseAlt,UHC.Light.Compiler.EH.MainAG_CaseAlts,UHC.Light.Compiler.EH.MainAG_DataConstr,UHC.Light.Compiler.EH.MainAG_DataConstrs,UHC.Light.Compiler.EH.MainAG_DataField,UHC.Light.Compiler.EH.MainAG_DataFieldExpr,UHC.Light.Compiler.EH.MainAG_DataFieldPatExpr,UHC.Light.Compiler.EH.MainAG_DataFields,UHC.Light.Compiler.EH.MainAG_Decl,UHC.Light.Compiler.EH.MainAG_Decls,UHC.Light.Compiler.EH.MainAG_Expr,UHC.Light.Compiler.EH.MainAG_ExprAnn,UHC.Light.Compiler.EH.MainAG_FuncDep,UHC.Light.Compiler.EH.MainAG_FuncDeps,UHC.Light.Compiler.EH.MainAG_KiExpr,UHC.Light.Compiler.EH.MainAG_KiExprAnn,UHC.Light.Compiler.EH.MainAG_MbTyExpr,UHC.Light.Compiler.EH.MainAG_PatExpr,UHC.Light.Compiler.EH.MainAG_PatExprAnn,UHC.Light.Compiler.EH.MainAG_PrExpr,UHC.Light.Compiler.EH.MainAG_PrExprs,UHC.Light.Compiler.EH.MainAG_RecExpr,UHC.Light.Compiler.EH.MainAG_RecPatExpr,UHC.Light.Compiler.EH.MainAG_RowTyExpr,UHC.Light.Compiler.EH.MainAG_TyExpr,UHC.Light.Compiler.EH.MainAG_TyExprAnn,UHC.Light.Compiler.EH.MainAG_TyExprs,UHC.Light.Compiler.EH.MainAG_TyVar,UHC.Light.Compiler.EH.MainAG_TyVars,UHC.Light.Compiler.EH.MainAG_common,UHC.Light.Compiler.EH.Parser,UHC.Light.Compiler.EHC.Common,UHC.Light.Compiler.EHC.CompileGroup,UHC.Light.Compiler.EHC.CompilePhase.Cleanup,UHC.Light.Compiler.EHC.CompilePhase.CompileC,UHC.Light.Compiler.EHC.CompilePhase.FlowBetweenPhase,UHC.Light.Compiler.EHC.CompilePhase.Link,UHC.Light.Compiler.EHC.CompilePhase.Module,UHC.Light.Compiler.EHC.CompilePhase.Output,UHC.Light.Compiler.EHC.CompilePhase.Parsers,UHC.Light.Compiler.EHC.CompilePhase.Run,UHC.Light.Compiler.EHC.CompilePhase.Semantics,UHC.Light.Compiler.EHC.CompilePhase.TopLevelPhases,UHC.Light.Compiler.EHC.CompilePhase.Transformations,UHC.Light.Compiler.EHC.CompilePhase.Translations,UHC.Light.Compiler.EHC.CompileRun,UHC.Light.Compiler.EHC.CompileUnit,UHC.Light.Compiler.EHC.Environment,UHC.Light.Compiler.EHC.InitialSetup,UHC.Light.Compiler.Error,UHC.Light.Compiler.Error.Pretty,UHC.Light.Compiler.FinalEnv,UHC.Light.Compiler.Foreign,UHC.Light.Compiler.Foreign.Boxing,UHC.Light.Compiler.Foreign.Extract,UHC.Light.Compiler.Foreign.Parser,UHC.Light.Compiler.Foreign.Pretty,UHC.Light.Compiler.Gam,UHC.Light.Compiler.Gam.AppSpineGam,UHC.Light.Compiler.Gam.Base,UHC.Light.Compiler.Gam.ClGam,UHC.Light.Compiler.Gam.ClassDefaultGam,UHC.Light.Compiler.Gam.DataGam,UHC.Light.Compiler.Gam.FixityGam,UHC.Light.Compiler.Gam.Full,UHC.Light.Compiler.Gam.Instantiate,UHC.Light.Compiler.Gam.KiGam,UHC.Light.Compiler.Gam.PolGam,UHC.Light.Compiler.Gam.Quantify,UHC.Light.Compiler.Gam.TyGam,UHC.Light.Compiler.Gam.TyKiGam,UHC.Light.Compiler.Gam.Utils,UHC.Light.Compiler.Gam.ValGam,UHC.Light.Compiler.Generics,UHC.Light.Compiler.HI,UHC.Light.Compiler.HS,UHC.Light.Compiler.HS.MainAG,UHC.Light.Compiler.HS.ModImpExp,UHC.Light.Compiler.HS.Parser,UHC.Light.Compiler.LamInfo,UHC.Light.Compiler.Module.ImportExport,UHC.Light.Compiler.Module.Merge,UHC.Light.Compiler.NameAspect,UHC.Light.Compiler.Opts,UHC.Light.Compiler.Opts.Base,UHC.Light.Compiler.Opts.CommandLine,UHC.Light.Compiler.Pred,UHC.Light.Compiler.Pred.CHR,UHC.Light.Compiler.Pred.CommonCHR,UHC.Light.Compiler.Pred.Evidence,UHC.Light.Compiler.Pred.EvidenceToCore,UHC.Light.Compiler.Pred.Heuristics,UHC.Light.Compiler.Pred.RedGraph,UHC.Light.Compiler.Pred.ToCHR,UHC.Light.Compiler.Scanner.Common,UHC.Light.Compiler.Scanner.Machine,UHC.Light.Compiler.Scanner.Scanner,UHC.Light.Compiler.Scanner.Token,UHC.Light.Compiler.Scanner.TokenParser,UHC.Light.Compiler.SourceCodeSig,UHC.Light.Compiler.Substitutable,UHC.Light.Compiler.Ty,UHC.Light.Compiler.Ty.AppSpineGam,UHC.Light.Compiler.Ty.FIEnv,UHC.Light.Compiler.Ty.FIEnv2,UHC.Light.Compiler.Ty.FitsIn,UHC.Light.Compiler.Ty.FitsInCommon,UHC.Light.Compiler.Ty.FitsInCommon2,UHC.Light.Compiler.Ty.Ftv,UHC.Light.Compiler.Ty.Parser,UHC.Light.Compiler.Ty.Pretty,UHC.Light.Compiler.Ty.TreeTrieKey,UHC.Light.Compiler.Ty.Trf.BetaReduce,UHC.Light.Compiler.Ty.Trf.Canonic,UHC.Light.Compiler.Ty.Trf.FreshVar,UHC.Light.Compiler.Ty.Trf.Instantiate,UHC.Light.Compiler.Ty.Trf.MergePreds,UHC.Light.Compiler.Ty.Trf.Quantify,UHC.Light.Compiler.Ty.Trf.Subst,UHC.Light.Compiler.Ty.UsedNames,UHC.Light.Compiler.Ty.Utils1,UHC.Light.Compiler.Ty.Utils2,UHC.Light.Compiler.VarLookup,UHC.Light.Compiler.VarMp,UHC.Light.Compiler.VarMp.Utils + +Executable uhcl + Hs-Source-Dirs: src + Build-Depends: uhc-light==1.1.7.0, fgl,hashable>=1.1&&<1.3,uhc-util>=0.1.3.7,base>=4&&<5,vector,syb,uulib,network,binary,mtl,directory,containers,array,process,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale + Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,OverlappingInstances,LiberalTypeSynonyms,StandaloneDeriving,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables + Main-Is: EHC.hs