diff --git a/103/lib/ag/AnaDomain/AbsSyn.ag b/103/lib/ag/AnaDomain/AbsSyn.ag --- a/103/lib/ag/AnaDomain/AbsSyn.ag +++ b/103/lib/ag/AnaDomain/AbsSyn.ag @@ -1,88 +1,1 @@ -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/Core/AbsSyn.ag b/103/lib/ag/Core/AbsSyn.ag --- a/103/lib/ag/Core/AbsSyn.ag +++ b/103/lib/ag/Core/AbsSyn.ag @@ -143,12 +143,11 @@ -- | ann for CExpr DATA CExprAnn | Ty ty : {Ty} - | Coe coe : {RelevCoe} | Debug info : {String} -- | ann for name intro DATA CBindAnn - | Coe coe : {RelevCoe} + | Coe coe : {()} -- dummy TYPE CBindAnnL = [CBindAnn] @@ -170,9 +169,6 @@ | Meta aspectKeyS : {ACoreBindAspectKeyS} cmetas : CMetas - -- a (keyed) RelevTy - | RelevTy aspectKeyS : {ACoreBindAspectKeyS} - relevTy : {RelevTy} -- a (keyed) CExpr | Val aspectKeyS : {ACoreBindAspectKeyS} 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 Binary files a/103/lib/pkg/array-1.0.0.0/103/cr/plain/Data/Array.hi 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 --- 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 @@ -1,2 +1,2 @@ exposed-modules: Data.Array -build-depends: uhcbase-1.1.9.1 base-3.0.0.0 +build-depends: uhcbase-1.1.9.2 base-3.0.0.0 diff --git a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Applicative.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Arrow.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Category.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Fix.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/Instances.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Control/Monad/ST/Lazy.hi 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.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Bool.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.cr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Complex.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.cr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Dynamic.hi 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.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Eq.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Foldable.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Function.hi 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.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ix.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Monoid.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ord.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Ratio.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/String.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.cr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Data/Traversable.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Numeric.hi 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.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Prelude.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Console/GetOpt.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/System/Exit.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadP.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/ParserCombinators/ReadPrec.hi 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.hi b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Read/Lex.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show.hi 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.bcrr b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.bcrr Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.bcrr and b/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.bcrr 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 Binary files a/103/lib/pkg/base-3.0.0.0/103/cr/plain/Text/Show/Functions.hi 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/installed-pkg-config b/103/lib/pkg/base-3.0.0.0/103/cr/plain/installed-pkg-config --- 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 @@ -1,2 +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.9.1 +build-depends: uhcbase-1.1.9.2 diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.bcrr deleted file mode 100644 # file too large to diff: 103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.bcrr diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.bcrr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.bcrr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.bcrr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.cr b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.cr deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.cr and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.hi b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.hi deleted file mode 100644 Binary files a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.hi and /dev/null differ diff --git a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/CTypes.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/CTypes.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/CTypes.h +++ /dev/null @@ -1,231 +0,0 @@ -{- -------------------------------------------------------------------------- -// 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.9.1/103/cr/plain/include/HsBase.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBase.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBase.h +++ /dev/null @@ -1,757 +0,0 @@ -/* ----------------------------------------------------------------------------- - * - * (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.9.1/103/cr/plain/include/HsBaseConfig.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBaseConfig.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBaseConfig.h +++ /dev/null @@ -1,944 +0,0 @@ -/* 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.9.1/103/cr/plain/include/IntLikeInstance.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/IntLikeInstance.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/IntLikeInstance.h +++ /dev/null @@ -1,242 +0,0 @@ -{- -------------------------------------------------------------------------- -// 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.9.1/103/cr/plain/include/MachDeps.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/MachDeps.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/MachDeps.h +++ /dev/null @@ -1,125 +0,0 @@ -/* 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.9.1/103/cr/plain/include/TupleInstance.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/TupleInstance.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/TupleInstance.h +++ /dev/null @@ -1,147 +0,0 @@ -{- -------------------------------------------------------------------------- -// 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.9.1/103/cr/plain/include/Typeable.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/Typeable.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/Typeable.h +++ /dev/null @@ -1,149 +0,0 @@ -{- -------------------------------------------------------------------------- -// 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.9.1/103/cr/plain/include/dirUtils.h b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/dirUtils.h deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/dirUtils.h +++ /dev/null @@ -1,11 +0,0 @@ -/* - * (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.9.1/103/cr/plain/installed-pkg-config b/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/installed-pkg-config deleted file mode 100644 --- a/103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/installed-pkg-config +++ /dev/null @@ -1,2 +0,0 @@ -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/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.bcrr new file mode 100644 # file too large to diff: 103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.bcrr diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.bcrr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.bcrr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.bcrr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.cr b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.cr new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.cr differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.hi b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.hi new file mode 100644 Binary files /dev/null and b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.hi differ diff --git a/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/CTypes.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/CTypes.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/HsBase.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/HsBase.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/HsBaseConfig.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/HsBaseConfig.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/IntLikeInstance.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/IntLikeInstance.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/MachDeps.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/MachDeps.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/TupleInstance.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/TupleInstance.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/Typeable.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/Typeable.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/include/dirUtils.h b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/dirUtils.h new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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.9.2/103/cr/plain/installed-pkg-config b/103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/installed-pkg-config new file mode 100644 --- /dev/null +++ b/103/lib/pkg/uhcbase-1.1.9.2/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/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,13 @@ # Changelog +## 1.1.9.2 - 20151027 + +- [corerun] CoreRun specific options via --corerunopt=... +- [corerun] Some cleanup for use in course http://foswiki.cs.uu.nl/foswiki/Cco/WebHome +- [dependencies] Removal of dependency on Data.Data/syb +- [chr] CHR machinery moved to uhc-util +- [ast dump] Framework for debugging AST: --ehopt=dump-ast & --debug-traceon=... combi allow selectively looking into AST + info + ## 1.1.9.1 - 20151013 - [guarantees] This is a pre-release as far as below extensions is concerned. diff --git a/src/UHC/Light/Compiler/AbstractCore.hs b/src/UHC/Light/Compiler/AbstractCore.hs --- a/src/UHC/Light/Compiler/AbstractCore.hs +++ b/src/UHC/Light/Compiler/AbstractCore.hs @@ -4,7 +4,7 @@ , acoreMetaLift , ACoreBindAspectKey (..), ACoreBindAspectKeyS, ACoreBindAspMp , acbaspkeyMetaLev -, acbaspkeyDefaultTy, acbaspkeyTy, acbaspkeyDefaultCore, acbaspkeyNone, acbaspkeyDefault, acbaspkeyDefaultRelevTy, acbaspkeyStrict, acbaspkeyDebug +, acbaspkeyDefaultTy, acbaspkeyTy, acbaspkeyDefaultCore, acbaspkeyNone, acbaspkeyDefault, acbaspkeyStrict, acbaspkeyDebug , ppACBaspKeyS , hsnUniqifyACoreBindAspectKeyS , ACoreBindRef (..), acoreMkRef, acoreMkAspRef @@ -401,7 +401,6 @@ 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 @@ -412,7 +411,6 @@ 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" @@ -426,11 +424,11 @@ acbaspkeyMk :: [ACoreBindAspectKey] -> ACoreBindAspectKeyS acbaspkeyMk = Set.fromList -{-# LINE 422 "src/ehc/AbstractCore.chs" #-} +{-# LINE 426 "src/ehc/AbstractCore.chs" #-} acbaspkeyMetaLev :: MetaLev -> ACoreBindAspectKeyS -> MetaLev acbaspkeyMetaLev mlev _ = mlev -{-# LINE 433 "src/ehc/AbstractCore.chs" #-} +{-# LINE 444 "src/ehc/AbstractCore.chs" #-} -- | predefined: acbaspkeyNone :: ACoreBindAspectKeyS acbaspkeyNone = acbaspkeyMk @@ -457,11 +455,6 @@ [ ACoreBindAspectKey_Default, ACoreBindAspectKey_Core ] -- | predefined: -acbaspkeyDefaultRelevTy :: ACoreBindAspectKeyS -acbaspkeyDefaultRelevTy = acbaspkeyMk - [ ACoreBindAspectKey_Default, ACoreBindAspectKey_RelevTy ] - --- | predefined: acbaspkeyStrict :: ACoreBindAspectKeyS acbaspkeyStrict = acbaspkeyMk [ ACoreBindAspectKey_Strict ] @@ -471,17 +464,17 @@ acbaspkeyDebug = acbaspkeyMk [ ACoreBindAspectKey_Debug ] -{-# LINE 492 "src/ehc/AbstractCore.chs" #-} +{-# LINE 498 "src/ehc/AbstractCore.chs" #-} -- | predefined: acbaspkeyFusionRole :: ACoreBindAspectKeyS acbaspkeyFusionRole = acbaspkeyMk [ ACoreBindAspectKey_FusionRole ] -{-# LINE 499 "src/ehc/AbstractCore.chs" #-} +{-# LINE 505 "src/ehc/AbstractCore.chs" #-} ppACBaspKeyS :: ACoreBindAspectKeyS -> PP_Doc ppACBaspKeyS = ppCurlysCommas . Set.toList -{-# LINE 504 "src/ehc/AbstractCore.chs" #-} +{-# LINE 510 "src/ehc/AbstractCore.chs" #-} -- | uniqify with ACoreBindAspectKeyS, omitting the default hsnUniqifyACoreBindAspectKeyS :: ACoreBindAspectKeyS -> HsName -> HsName hsnUniqifyACoreBindAspectKeyS as n @@ -489,13 +482,10 @@ where mk ACoreBindAspectKey_Strict = hsnUniqify HsNameUniqifier_Strict mk a = hsnUniqifyStr HsNameUniqifier_BindAspect (show a) -{-# LINE 513 "src/ehc/AbstractCore.chs" #-} +{-# LINE 519 "src/ehc/AbstractCore.chs" #-} deriving instance Typeable ACoreBindAspectKey -{-# LINE 517 "src/ehc/AbstractCore.chs" #-} -deriving instance Data ACoreBindAspectKey - -{-# LINE 525 "src/ehc/AbstractCore.chs" #-} +{-# LINE 527 "src/ehc/AbstractCore.chs" #-} -- | reference to binding aspect: name + aspect keys data ACoreBindRef = ACoreBindRef @@ -516,28 +506,27 @@ instance Show ACoreBindRef where show = show . mkHNm -{-# LINE 547 "src/ehc/AbstractCore.chs" #-} +{-# LINE 549 "src/ehc/AbstractCore.chs" #-} acbrefAspKey :: ACoreBindRef -> ACoreBindAspectKeyS acbrefAspKey = maybe acbaspkeyNone id . acbrefMbAspKey {-# INLINE acbrefAspKey #-} -{-# LINE 553 "src/ehc/AbstractCore.chs" #-} +{-# LINE 555 "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 559 "src/ehc/AbstractCore.chs" #-} +{-# LINE 561 "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 567 "src/ehc/AbstractCore.chs" #-} +{-# LINE 569 "src/ehc/AbstractCore.chs" #-} deriving instance Typeable ACoreBindRef -deriving instance Data ACoreBindRef -{-# LINE 576 "src/ehc/AbstractCore.chs" #-} +{-# LINE 577 "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 #-} @@ -552,7 +541,7 @@ 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 596 "src/ehc/AbstractCore.chs" #-} +{-# LINE 597 "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 #-} @@ -573,7 +562,7 @@ 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 618 "src/ehc/AbstractCore.chs" #-} +{-# LINE 619 "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 @@ -594,7 +583,7 @@ acoreTag tg = acoreTagTup tg [] {-# INLINE acoreTag #-} -{-# LINE 651 "src/ehc/AbstractCore.chs" #-} +{-# LINE 652 "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 #-} @@ -631,7 +620,7 @@ acoreBind1 n e = acoreBind1Cat (acoreBindcategDflt e) n e {-# INLINE acoreBind1 #-} -{-# LINE 689 "src/ehc/AbstractCore.chs" #-} +{-# LINE 690 "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 #-} @@ -657,7 +646,7 @@ -} -{-# LINE 716 "src/ehc/AbstractCore.chs" #-} +{-# LINE 717 "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 #-} @@ -674,7 +663,7 @@ acoreBind1Nm1 n = acoreBind1Asp n [] {-# INLINE acoreBind1Nm1 #-} -{-# LINE 738 "src/ehc/AbstractCore.chs" #-} +{-# LINE 739 "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 #-} @@ -695,7 +684,7 @@ acoreBoundVal1Cat cat n e = acoreBoundVal1CatTy cat n (acoreTyErr "acoreBoundVal1Cat") e {-# INLINE acoreBoundVal1Cat #-} -{-# LINE 760 "src/ehc/AbstractCore.chs" #-} +{-# LINE 761 "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 #-} @@ -705,7 +694,7 @@ {-# INLINE acoreBoundVal1Meta #-} -{-# LINE 771 "src/ehc/AbstractCore.chs" #-} +{-# LINE 772 "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 #-} @@ -714,12 +703,12 @@ acoreBound1Val e = acoreBound1AspkeyVal acbaspkeyDefault e {-# INLINE acoreBound1Val #-} -{-# LINE 791 "src/ehc/AbstractCore.chs" #-} +{-# LINE 792 "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 801 "src/ehc/AbstractCore.chs" #-} +{-# LINE 802 "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 @@ -751,11 +740,11 @@ acoreLetRec bs e = acoreLet (acoreBindcategRec) bs e {-# INLINE acoreLetRec #-} -{-# LINE 834 "src/ehc/AbstractCore.chs" #-} +{-# LINE 835 "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 839 "src/ehc/AbstractCore.chs" #-} +{-# LINE 840 "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] @@ -770,7 +759,7 @@ acoreLet1Plain nm e = acoreLet1PlainTy nm (acoreTyErr "acoreLet1Plain") e {-# INLINE acoreLet1Plain #-} -{-# LINE 855 "src/ehc/AbstractCore.chs" #-} +{-# LINE 856 "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] @@ -785,7 +774,7 @@ acoreLet1Strict nm e = acoreLet1StrictTy nm (acoreTyErr "acoreLet1Strict") e {-# INLINE acoreLet1Strict #-} -{-# LINE 871 "src/ehc/AbstractCore.chs" #-} +{-# LINE 872 "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 @@ -812,20 +801,20 @@ acoreLet1StrictIn nm e mkC = acoreLet1StrictInMeta nm acoreMetavalDflt e mkC {-# INLINE acoreLet1StrictIn #-} -{-# LINE 903 "src/ehc/AbstractCore.chs" #-} +{-# LINE 904 "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 915 "src/ehc/AbstractCore.chs" #-} +{-# LINE 916 "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 926 "src/ehc/AbstractCore.chs" #-} +{-# LINE 927 "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 @@ -836,11 +825,11 @@ 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 942 "src/ehc/AbstractCore.chs" #-} +{-# LINE 943 "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 947 "src/ehc/AbstractCore.chs" #-} +{-# LINE 948 "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 @@ -849,15 +838,15 @@ Just (t,i') -> acoreIntTy2 t (toInteger i + i') _ -> acoreBuiltinApp opts ehbnPrimAddInt [e,acoreInt opts i] -{-# LINE 957 "src/ehc/AbstractCore.chs" #-} +{-# LINE 958 "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 962 "src/ehc/AbstractCore.chs" #-} +{-# LINE 963 "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 967 "src/ehc/AbstractCore.chs" #-} +{-# LINE 968 "src/ehc/AbstractCore.chs" #-} -- | Creates a string expression. -- The expression represents a packed String, which can be passed to Haskell generated Core functions. acoreBuiltinString :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) @@ -866,7 +855,7 @@ -> e acoreBuiltinString opts m = let x = acoreBuiltinApp opts ehbnPackedStringToString [acoreStringTy (acoreTyString opts) m] in x -{-# LINE 977 "src/ehc/AbstractCore.chs" #-} +{-# LINE 978 "src/ehc/AbstractCore.chs" #-} -- | Generates an error expression, failing with the given string when evaluated. ('error' in haskell) acoreBuiltinError :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts @@ -878,7 +867,7 @@ acoreBuiltinUndefined :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts -> e acoreBuiltinUndefined opts = acoreBuiltinApp opts ehbnUndefined [] -{-# LINE 990 "src/ehc/AbstractCore.chs" #-} +{-# LINE 991 "src/ehc/AbstractCore.chs" #-} -- | Creates a Core 'Integer' constant. acoreBuiltinInteger :: (AbstractCore e m b bound boundmeta bcat mbind t p pr pf a) => EHCOpts @@ -886,13 +875,13 @@ -> e acoreBuiltinInteger opts i = acoreBuiltinApp opts ehbnPackedStringToInteger [acoreStringTy (acoreTyString opts) (show i)] -{-# LINE 999 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1000 "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 1010 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1011 "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 @@ -904,25 +893,25 @@ -- <|> (const ctagChar) <$> acorePatMbChar p ) . fst . acoreUnAlt -{-# LINE 1027 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1028 "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 1038 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1039 "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 1049 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1050 "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 1060 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1061 "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 @@ -934,12 +923,12 @@ Nothing {-(tcUndefined opts)-} ) -{-# LINE 1073 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1074 "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 1103 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1104 "src/ehc/AbstractCore.chs" #-} data Coe' expr metaval bind bindasp ty = Coe_Map !(expr -> expr) -- normal, expression as function | Coe_C !expr -- constant @@ -958,7 +947,7 @@ instance Show (Coe' expr metaval bind bindasp ty) where show _ = "COE" -{-# LINE 1140 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1141 "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 @@ -969,9 +958,12 @@ data CoeCtx = CoeCtx_Allow | CoeCtx_DontAllow - deriving (Eq,Show) + deriving + ( Eq, Show + , Typeable + ) -{-# LINE 1158 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1164 "src/ehc/AbstractCore.chs" #-} -- | Non inspectable, most general, coercion acoreCoeMap :: (e -> e) -> Coe' e m b ba t acoreCoeMap = Coe_Map @@ -982,7 +974,7 @@ acoreCoeId = Coe_C acoreCoeArg {-# INLINE acoreCoeId #-} -{-# LINE 1170 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1176 "src/ehc/AbstractCore.chs" #-} acoreCoeLamLetTy :: HsName -> t -> UID -> Coe' e m b ba t acoreCoeLamLetTy = Coe_LamLet {-# INLINE acoreCoeLamLetTy #-} @@ -996,7 +988,7 @@ acoreCoeLetRec [] = acoreCoeId acoreCoeLetRec bs = Coe_LetRec bs -{-# LINE 1185 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1191 "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 @@ -1013,7 +1005,7 @@ acoreCoeAppN as = acoreCoeMap (\e -> acoreApp e as) {-# INLINE acoreCoeAppN #-} -{-# LINE 1203 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1209 "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 @@ -1023,7 +1015,7 @@ acoreCoeLam1 n = acoreCoeLam1Ty n (acoreTyErr "acoreCoeLam1") {-# INLINE acoreCoeLam1 #-} -{-# LINE 1214 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1220 "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 @@ -1031,14 +1023,14 @@ | otherwise = Coe_Compose c1 c2 -{-# LINE 1223 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1229 "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 1231 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1237 "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 @@ -1051,19 +1043,19 @@ 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 1249 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1255 "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 1259 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1265 "src/ehc/AbstractCore.chs" #-} data CSubstKey = CSKey_UID UID | CSKey_Nm HsName | CSKey_Ref ACoreBindRef deriving (Show,Eq,Ord) -{-# LINE 1267 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1273 "src/ehc/AbstractCore.chs" #-} data CSubstInfo' expr metaval bind bindasp ty = CSITy { csiTy :: !ty } @@ -1078,37 +1070,37 @@ instance Show (CSubstInfo' e m b ba t) where show _ = "CSubstInfo'" -{-# LINE 1285 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1291 "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 1296 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1302 "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 1301 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1307 "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 1306 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1312 "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 1311 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1317 "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 1323 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1329 "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 1333 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1339 "src/ehc/AbstractCore.chs" #-} infixr `cSubstApp` class CSubstitutable e m b ba t a @@ -1119,7 +1111,7 @@ instance CSubstitutable e m b ba t (CSubst' e m b ba t) where cSubstApp cs s = cs `cSubstAppSubst` s -{-# LINE 1349 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1355 "src/ehc/AbstractCore.chs" #-} data RAlt' e t b pr = RAlt_Alt { rcaPats :: ![RPat' e t b pr], raaExpr :: !e, raaFailS :: UIDS } @@ -1140,14 +1132,14 @@ type RCEAltL' e t b pr = [RAlt' e t b pr] -{-# LINE 1373 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1379 "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 1381 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1387 "src/ehc/AbstractCore.chs" #-} rpatConTag :: RPat' e t b pr -> CTag rpatConTag (RPat_Int _ _ _ ) = ctagInt rpatConTag (RPat_Char _ _ _ ) = ctagChar @@ -1156,7 +1148,7 @@ rcaTag :: RAlt' e t b pr -> CTag rcaTag = rpatConTag . head . rcaPats -{-# LINE 1391 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1397 "src/ehc/AbstractCore.chs" #-} raltIsVar :: RAlt' e t b pr -> Bool raltIsVar (RAlt_Alt (RPat_Var _ _ _ : _) _ _) = True raltIsVar _ = False @@ -1169,17 +1161,17 @@ c _ = False raltIsConst _ = False -{-# LINE 1405 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1411 "src/ehc/AbstractCore.chs" #-} raltIsConMany :: RAlt' e t b pr -> Bool raltIsConMany (RAlt_Alt (RPat_Con _ _ _ (RPatConBind_Many _) : _) _ _) = True raltIsConMany _ = False -{-# LINE 1411 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1417 "src/ehc/AbstractCore.chs" #-} raltIsIrrefutable :: RAlt' e t b pr -> Bool raltIsIrrefutable (RAlt_Alt (RPat_Irrefutable _ _ _ : _) _ _) = True raltIsIrrefutable _ = False -{-# LINE 1417 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1423 "src/ehc/AbstractCore.chs" #-} raltMbBoolExpr :: RAlt' e t b pr -> Maybe (Maybe SrcConst) raltMbBoolExpr (RAlt_Alt (RPat_BoolExpr _ _ _ e : _) _ _) = Just e raltMbBoolExpr _ = Nothing @@ -1187,13 +1179,13 @@ raltIsBoolExpr :: RAlt' e t b pr -> Bool raltIsBoolExpr = isJust . raltMbBoolExpr -{-# LINE 1428 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1434 "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 1439 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1445 "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 @@ -1204,7 +1196,7 @@ RPat_Char n ty v -> acorePatCharTy ty v RPat_BoolExpr n _ v _ -> acorePatBoolExpr v -{-# LINE 1453 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1459 "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 @@ -1214,17 +1206,17 @@ 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 1470 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1476 "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 1482 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1488 "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 1492 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1498 "src/ehc/AbstractCore.chs" #-} -- | Reason to fail a case alternative data CaseAltFailReason = CaseAltFailReason_Absence -- failed because of absence @@ -1237,23 +1229,22 @@ pp (CaseAltFailReason_Continue i) = pp i pp (CaseAltFailReason_Absence ) = pp "absent" -{-# LINE 1506 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1512 "src/ehc/AbstractCore.chs" #-} cafailHasId :: CaseAltFailReason -> (Bool,UID) cafailHasId (CaseAltFailReason_Absence ) = (False,uidUnused) cafailHasId (CaseAltFailReason_Continue i) = (True ,i) -{-# LINE 1512 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1518 "src/ehc/AbstractCore.chs" #-} deriving instance Typeable CaseAltFailReason -deriving instance Data CaseAltFailReason -{-# LINE 1521 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1526 "src/ehc/AbstractCore.chs" #-} data AppFunKind = AppFunKind_NoApp -- inlined Nothing | AppFunKind_Fun ACoreBindRef | AppFunKind_Tag CTag | AppFunKind_FFI -{-# LINE 1533 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1538 "src/ehc/AbstractCore.chs" #-} -- | What kind of Expr? data WhatExpr @@ -1270,7 +1261,7 @@ | ExprIsBind HsName deriving Eq -{-# LINE 1551 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1556 "src/ehc/AbstractCore.chs" #-} -- | is an var? whatExprMbVar :: WhatExpr -> Maybe HsName whatExprMbVar (ExprIsVar a) = Just a @@ -1301,7 +1292,7 @@ whatExprAppArity (ExprIsApp a _) = a whatExprAppArity _ = 0 -{-# LINE 1583 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1588 "src/ehc/AbstractCore.chs" #-} whatExprIsWHNF :: WhatExpr -> Bool whatExprIsWHNF (ExprIsLam _ _) = True whatExprIsWHNF (ExprIsVar _) = True @@ -1310,7 +1301,7 @@ whatExprIsWHNF ExprIsOtherWHNF = True whatExprIsWHNF _ = False -{-# LINE 1593 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1598 "src/ehc/AbstractCore.chs" #-} whatExprIsBind :: WhatExpr -> Bool whatExprIsBind = isJust . whatExprMbBind {-# INLINE whatExprIsBind #-} @@ -1325,19 +1316,18 @@ whatExprIsTup _ = False -{-# LINE 1609 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1614 "src/ehc/AbstractCore.chs" #-} -- | Is Expr a FFI? whatExprIsFFI :: WhatExpr -> Bool whatExprIsFFI (ExprIsFFI ) = True whatExprIsFFI _ = False -{-# LINE 1627 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1632 "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 @@ -1347,17 +1337,16 @@ 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 1658 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1667 "src/ehc/AbstractCore.chs" #-} instance Serialize ACoreBindRef where sput (ACoreBindRef a b) = sput a >> sput b sget = liftM2 ACoreBindRef sget sget -{-# LINE 1664 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1673 "src/ehc/AbstractCore.chs" #-} instance Serialize CaseAltFailReason where sput (CaseAltFailReason_Continue a) = sputWord8 0 >> sput a sput (CaseAltFailReason_Absence ) = sputWord8 1 @@ -1367,13 +1356,13 @@ 0 -> liftM CaseAltFailReason_Continue sget 1 -> return CaseAltFailReason_Absence -{-# LINE 1679 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1688 "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 1686 "src/ehc/AbstractCore.chs" #-} +{-# LINE 1695 "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 diff --git a/src/UHC/Light/Compiler/AnaDomain.hs b/src/UHC/Light/Compiler/AnaDomain.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain.hs +++ /dev/null @@ -1,561 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 Control.Monad hiding (join) -import UHC.Util.Serialize -import UHC.Util.Control.Monad (liftM6) - - - - - - - - - - - - - - - - - --- | 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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain/Ftv.hs +++ /dev/null @@ -1,568 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain/Pretty.hs +++ /dev/null @@ -1,782 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain/Trf/Instantiate.hs +++ /dev/null @@ -1,989 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain/Trf/Subst.hs +++ /dev/null @@ -1,824 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/AnaDomain/Utils.hs +++ /dev/null @@ -1,364 +0,0 @@ -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 - - - -{-# 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 --- a/src/UHC/Light/Compiler/Base/CfgPP.hs +++ b/src/UHC/Light/Compiler/Base/CfgPP.hs @@ -117,5 +117,6 @@ 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)) + where mkl :: (x -> PP_Doc) -> AssocL HsName x -> PP_Doc + 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 --- a/src/UHC/Light/Compiler/Base/Common.hs +++ b/src/UHC/Light/Compiler/Base/Common.hs @@ -40,9 +40,9 @@ , module UHC.Light.Compiler.CodeGen.Tag , module UHC.Light.Compiler.Base.Strictness , ppHsnNonAlpha, ppHsnEscaped, hsnEscapeeChars, ppHsnEscapeWith, hsnOkChars, hsnNotOkStrs +, VarPPMp , ppSemi , ppPair -, showPP , ppFM , putCompileMsg , writePP, writeToFile @@ -61,7 +61,6 @@ , MaybeOk (..), isJustOk, isNotOk, maybeOk, fromJustOk, fromNotOk , KnownPrim (..) , allKnownPrimMp -, module UHC.Light.Compiler.Base.RLList , PredOccId (..) , mkPrId, poiHNm , mkPrIdCHR @@ -71,7 +70,6 @@ , InstVariant (..) , VarUIDHsName (..), vunmNm , vunmMbVar -, combineToDistinguishedElts , fixityAppPrio , InstDerivingFrom (..) , SrcConst (..) @@ -110,7 +108,6 @@ 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 import Data.Version @@ -124,7 +121,6 @@ - {-# LINE 104 "src/ehc/Base/Common.chs" #-} deriving instance Generic Version @@ -199,6 +195,9 @@ emptyPredOccId = mkPrId uidStart {-# LINE 195 "src/ehc/Base/Common.chs" #-} +type VarPPMp = Map.Map UID PP_Doc + +{-# LINE 203 "src/ehc/Base/Common.chs" #-} ppAppTop :: PP arg => (HsName,arg) -> [arg] -> PP_Doc -> PP_Doc ppAppTop (conNm,con) argL dflt = if ( hsnIsArrow conNm @@ -212,12 +211,12 @@ else if hsnIsRow conNm then ppListSep (hsnORow >|< con) hsnCRow "," argL else dflt -{-# LINE 216 "src/ehc/Base/Common.chs" #-} +{-# LINE 224 "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 222 "src/ehc/Base/Common.chs" #-} +{-# LINE 230 "src/ehc/Base/Common.chs" #-} ppCon :: HsName -> PP_Doc ppCon nm = if hsnIsProd nm then ppParens (text (replicate (hsnProdArity nm - 1) ',')) @@ -226,17 +225,17 @@ ppCmt :: PP_Doc -> PP_Doc ppCmt p = "{-" >#< p >#< "-}" -{-# LINE 232 "src/ehc/Base/Common.chs" #-} +{-# LINE 240 "src/ehc/Base/Common.chs" #-} ppSemi :: PP x => x -> PP_Doc ppSemi = (>|< ";") -{-# LINE 237 "src/ehc/Base/Common.chs" #-} +{-# LINE 245 "src/ehc/Base/Common.chs" #-} ppSpaced :: PP a => [a] -> PP_Doc ppSpaced = ppListSep "" "" " " -{-# LINE 244 "src/ehc/Base/Common.chs" #-} +{-# LINE 252 "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 @@ -249,7 +248,7 @@ mkPPAppFun :: HsName -> PP_Doc -> PP_Doc mkPPAppFun = mkPPAppFun' "|" -{-# LINE 258 "src/ehc/Base/Common.chs" #-} +{-# LINE 266 "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 @@ -259,23 +258,19 @@ mkExtAppPP :: (HsName,PP_Doc,[PP_Doc]) -> (HsName,PP_Doc,[PP_Doc],PP_Doc) -> (PP_Doc,[PP_Doc]) mkExtAppPP = mkExtAppPP' "|" -{-# LINE 274 "src/ehc/Base/Common.chs" #-} +{-# LINE 282 "src/ehc/Base/Common.chs" #-} ppPair :: (PP a, PP b) => (a,b) -> PP_Doc ppPair (x,y) = ppParens (pp x >|< "," >|< pp y) -{-# LINE 279 "src/ehc/Base/Common.chs" #-} -showPP :: PP a => a -> String -showPP x = disp (pp x) 100 "" - -{-# LINE 284 "src/ehc/Base/Common.chs" #-} +{-# LINE 292 "src/ehc/Base/Common.chs" #-} ppFM :: (PP k,PP v) => Map.Map k v -> PP_Doc ppFM = ppAssocL . Map.toList -{-# LINE 289 "src/ehc/Base/Common.chs" #-} +{-# LINE 297 "src/ehc/Base/Common.chs" #-} ppListV :: PP a => [a] -> PP_Doc ppListV = vlist . map pp -{-# LINE 298 "src/ehc/Base/Common.chs" #-} +{-# LINE 306 "src/ehc/Base/Common.chs" #-} putCompileMsg :: Verbosity -> Verbosity -> String -> Maybe String -> HsName -> FPath -> IO () putCompileMsg v optsVerbosity msg mbMsg2 modNm fNm = if optsVerbosity >= v @@ -284,7 +279,7 @@ } else return () -{-# LINE 308 "src/ehc/Base/Common.chs" #-} +{-# LINE 316 "src/ehc/Base/Common.chs" #-} writePP :: (a -> PP_Doc) -> a -> FPath -> IO () writePP f text fp = writeToFile (show.f $ text) fp @@ -299,7 +294,7 @@ writeToFile = writeToFile' False -{-# LINE 333 "src/ehc/Base/Common.chs" #-} +{-# LINE 341 "src/ehc/Base/Common.chs" #-} data ParNeed = ParNotNeeded | ParNeededLow | ParNeeded | ParNeededHigh | ParOverrideNeeded deriving (Eq,Ord) @@ -316,13 +311,13 @@ | otherwise = (ParNeeded,repeat ParNeededHigh) in pr -{-# LINE 355 "src/ehc/Base/Common.chs" #-} +{-# LINE 363 "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 381 "src/ehc/Base/Common.chs" #-} +{-# LINE 389 "src/ehc/Base/Common.chs" #-} -- | Expressions in a CBound position optionally may be labelled data CLbl = CLbl_None @@ -339,36 +334,36 @@ clbl _ f _ (CLbl_Nm n) = f n clbl _ _ f (CLbl_Tag t) = f t -{-# LINE 399 "src/ehc/Base/Common.chs" #-} +{-# LINE 407 "src/ehc/Base/Common.chs" #-} instance PP CLbl where pp = clbl empty pp pp -{-# LINE 408 "src/ehc/Base/Common.chs" #-} +{-# LINE 416 "src/ehc/Base/Common.chs" #-} data Unbox = Unbox_FirstField | Unbox_Tag !Int | Unbox_None -{-# LINE 419 "src/ehc/Base/Common.chs" #-} +{-# LINE 427 "src/ehc/Base/Common.chs" #-} unions :: Eq a => [[a]] -> [a] unions = foldr union [] -{-# LINE 424 "src/ehc/Base/Common.chs" #-} +{-# LINE 432 "src/ehc/Base/Common.chs" #-} listCombineUniq :: Eq a => [[a]] -> [a] listCombineUniq = nub . concat -{-# LINE 444 "src/ehc/Base/Common.chs" #-} +{-# LINE 452 "src/ehc/Base/Common.chs" #-} replicateBy :: [a] -> b -> [b] replicateBy l e = replicate (length l) e -{-# LINE 453 "src/ehc/Base/Common.chs" #-} +{-# LINE 461 "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 473 "src/ehc/Base/Common.chs" #-} +{-# LINE 481 "src/ehc/Base/Common.chs" #-} data Verbosity = VerboseQuiet -- nothing at all | VerboseMinimal @@ -377,12 +372,12 @@ | VerboseDebug deriving (Eq,Ord,Enum) -{-# LINE 487 "src/ehc/Base/Common.chs" #-} +{-# LINE 495 "src/ehc/Base/Common.chs" #-} data CHRScoped = CHRScopedInstOnly | CHRScopedMutualSuper | CHRScopedAll deriving (Eq,Ord) -{-# LINE 497 "src/ehc/Base/Common.chs" #-} +{-# LINE 505 "src/ehc/Base/Common.chs" #-} data CompilePoint = CompilePoint_Imports | CompilePoint_Parse @@ -392,7 +387,7 @@ | CompilePoint_All deriving (Eq,Ord,Show) -{-# LINE 514 "src/ehc/Base/Common.chs" #-} +{-# LINE 522 "src/ehc/Base/Common.chs" #-} data Fixity = Fixity_Infix | Fixity_Infixr | Fixity_Infixl deriving (Eq,Ord,Show,Enum) @@ -402,15 +397,15 @@ pp Fixity_Infixl = pp "infixl" pp Fixity_Infixr = pp "infixr" -{-# LINE 525 "src/ehc/Base/Common.chs" #-} +{-# LINE 533 "src/ehc/Base/Common.chs" #-} fixityMaxPrio :: Int fixityMaxPrio = 9 -{-# LINE 530 "src/ehc/Base/Common.chs" #-} +{-# LINE 538 "src/ehc/Base/Common.chs" #-} fixityAppPrio :: Int fixityAppPrio = fixityMaxPrio + 1 -{-# LINE 539 "src/ehc/Base/Common.chs" #-} +{-# LINE 547 "src/ehc/Base/Common.chs" #-} data InstVariant = InstNormal | InstDefault | InstDeriving InstDerivingFrom @@ -419,7 +414,7 @@ instance PP InstVariant where pp = pp . show -{-# LINE 551 "src/ehc/Base/Common.chs" #-} +{-# LINE 559 "src/ehc/Base/Common.chs" #-} -- | Either a deriving combined from a datatype directly or a standalone data InstDerivingFrom = InstDerivingFrom_Datatype @@ -429,7 +424,7 @@ instance PP InstDerivingFrom where pp = pp . show -{-# LINE 566 "src/ehc/Base/Common.chs" #-} +{-# LINE 574 "src/ehc/Base/Common.chs" #-} type NmLev = Int nmLevAbsent, nmLevBuiltin, nmLevOutside, nmLevModule :: NmLev @@ -439,7 +434,7 @@ nmLevModule = 0 -{-# LINE 587 "src/ehc/Base/Common.chs" #-} +{-# LINE 595 "src/ehc/Base/Common.chs" #-} -- Assumption: tokTpIsInt (genTokTp t) == True tokMkInt :: Token -> Int tokMkInt t @@ -451,28 +446,28 @@ tokMkStr :: Token -> String tokMkStr = tokenVal -{-# LINE 605 "src/ehc/Base/Common.chs" #-} +{-# LINE 613 "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 615 "src/ehc/Base/Common.chs" #-} +{-# LINE 623 "src/ehc/Base/Common.chs" #-} tokMkQNames :: [Token] -> [HsName] tokMkQNames = map tokMkQName instance HSNM Token where mkHNm = tokMkQName -{-# LINE 627 "src/ehc/Base/Common.chs" #-} +{-# LINE 635 "src/ehc/Base/Common.chs" #-} hsnLclSupplyWith :: HsName -> [HsName] hsnLclSupplyWith n = map (\i -> hsnSuffix n $ "_" ++ show i) [1..] hsnLclSupply :: [HsName] hsnLclSupply = hsnLclSupplyWith (hsnFromString "") -{-# LINE 639 "src/ehc/Base/Common.chs" #-} +{-# LINE 647 "src/ehc/Base/Common.chs" #-} splitByRadix :: (Integral b) => Int -> Int -> b -> (Int,[Int]) splitByRadix len radix num = ( fromIntegral $ signum num @@ -488,19 +483,19 @@ (abs num) difflen = len - length repr -{-# LINE 656 "src/ehc/Base/Common.chs" #-} +{-# LINE 664 "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 667 "src/ehc/Base/Common.chs" #-} +{-# LINE 675 "src/ehc/Base/Common.chs" #-} data Backend = BackendGrinByteCode | BackendSilly deriving (Eq, Ord) -{-# LINE 678 "src/ehc/Base/Common.chs" #-} +{-# LINE 686 "src/ehc/Base/Common.chs" #-} data VarUIDHsName = VarUIDHs_Name { vunmId :: !UID, vunmNm' :: !HsName } | VarUIDHs_UID { vunmId :: !UID } @@ -512,12 +507,12 @@ vunmNm (VarUIDHs_UID i ) = mkHNm i vunmNm _ = panic "Common.assnmNm" -{-# LINE 691 "src/ehc/Base/Common.chs" #-} +{-# LINE 699 "src/ehc/Base/Common.chs" #-} vunmMbVar :: VarUIDHsName -> Maybe UID vunmMbVar (VarUIDHs_Var v) = Just v vunmMbVar _ = Nothing -{-# LINE 697 "src/ehc/Base/Common.chs" #-} +{-# LINE 705 "src/ehc/Base/Common.chs" #-} instance Show VarUIDHsName where show (VarUIDHs_Name _ n) = show n show (VarUIDHs_UID i ) = show i @@ -526,7 +521,7 @@ instance PP VarUIDHsName where pp a = pp $ show a -{-# LINE 711 "src/ehc/Base/Common.chs" #-} +{-# LINE 719 "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 @@ -534,7 +529,7 @@ -> yes (Set.insert v $ Set.union (noVisit t) vsVisited) t _ -> dflt -{-# LINE 720 "src/ehc/Base/Common.chs" #-} +{-# LINE 728 "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 @@ -548,7 +543,7 @@ withLkupLift get = withLkupChkVisitLift get (const Set.empty) -{-# LINE 735 "src/ehc/Base/Common.chs" #-} +{-# LINE 743 "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 @@ -558,32 +553,17 @@ lookupLiftCyc2 get lookup dflt found x = maybe dflt (\x -> lookupLiftCyc1 get lookup (found x) found x) $ lookup x -{-# LINE 746 "src/ehc/Base/Common.chs" #-} +{-# LINE 754 "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 758 "src/ehc/Base/Common.chs" #-} -data Presence = Present | Absent deriving (Eq,Ord,Show) - {-# LINE 766 "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 +data Presence = Present | Absent deriving (Eq,Ord,Show) -{-# LINE 789 "src/ehc/Base/Common.chs" #-} +{-# LINE 798 "src/ehc/Base/Common.chs" #-} data AlwaysEq a = AlwaysEq { unAlwaysEq :: a } instance Eq (AlwaysEq a) where @@ -602,12 +582,12 @@ hashWithSalt salt _ = hashWithSalt salt (12345 :: Int) -- arbitarry, but constant -{-# LINE 813 "src/ehc/Base/Common.chs" #-} +{-# LINE 822 "src/ehc/Base/Common.chs" #-} type PkgName = String emptyPkgName = "" -{-# LINE 823 "src/ehc/Base/Common.chs" #-} +{-# LINE 832 "src/ehc/Base/Common.chs" #-} -- | How to do linking/packaging data LinkingStyle = LinkingStyle_None -- ^ no linking (e.g. indicated by --compile-only flag) @@ -616,46 +596,46 @@ deriving (Eq,Ord,Enum,Bounded) -{-# LINE 863 "src/ehc/Base/Common.chs" #-} +{-# LINE 872 "src/ehc/Base/Common.chs" #-} metaLevTy, metaLevKi, metaLevSo :: MetaLev metaLevTy = metaLevVal + 1 metaLevKi = metaLevTy + 1 metaLevSo = metaLevKi + 1 -{-# LINE 874 "src/ehc/Base/Common.chs" #-} +{-# LINE 883 "src/ehc/Base/Common.chs" #-} -- | Use as variable id type VarId = UID type VarIdS = Set.Set UID -{-# LINE 884 "src/ehc/Base/Common.chs" #-} +{-# LINE 893 "src/ehc/Base/Common.chs" #-} uidHNm :: UID -> HsName uidHNm = mkHNm -- hsnFromString . show -{-# LINE 889 "src/ehc/Base/Common.chs" #-} +{-# LINE 898 "src/ehc/Base/Common.chs" #-} uidQualHNm :: HsName -> UID -> HsName uidQualHNm modnm uid = hsnPrefixQual modnm $ uidHNm uid -{-# LINE 907 "src/ehc/Base/Common.chs" #-} +{-# LINE 916 "src/ehc/Base/Common.chs" #-} data SrcConst = SrcConst_Int Integer | SrcConst_Char Char | SrcConst_Ratio Integer Integer deriving (Eq,Show,Ord) -{-# LINE 919 "src/ehc/Base/Common.chs" #-} +{-# LINE 928 "src/ehc/Base/Common.chs" #-} fmap2Tuple :: Functor f => snd -> f x -> f (x,snd) fmap2Tuple snd = fmap (\x -> (x,snd)) -{-# LINE 928 "src/ehc/Base/Common.chs" #-} +{-# LINE 937 "src/ehc/Base/Common.chs" #-} -- | Shorthand for if if' :: Bool -> a -> a -> a if' c t e = if c then t else e {-# INLINE if' #-} -{-# LINE 939 "src/ehc/Base/Common.chs" #-} +{-# LINE 948 "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 @@ -683,7 +663,7 @@ {-# INLINE ifM' #-} -{-# LINE 968 "src/ehc/Base/Common.chs" #-} +{-# LINE 977 "src/ehc/Base/Common.chs" #-} -- | Variation of `maybe` where the maybe is computed in a monad. See also `maybeM'` maybeM :: Monad m => m (Maybe a) -> m b -> (a -> m b) -> m b maybeM mmaybe mnothing mjust = mmaybe >>= maybe mnothing mjust @@ -724,7 +704,7 @@ unlessJustM :: Monad m => m (Maybe a) -> m () -> m () unlessJustM mmaybe = maybeM' mmaybe (\_ -> return ()) -{-# LINE 1014 "src/ehc/Base/Common.chs" #-} +{-# LINE 1023 "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) @@ -739,7 +719,7 @@ ch x | x < 26 = [chr $ ord 'a' + x] | otherwise = let (q,r) = x `quotRem` 26 in ch q ++ ch r -{-# LINE 1034 "src/ehc/Base/Common.chs" #-} +{-# LINE 1043 "src/ehc/Base/Common.chs" #-} data MaybeOk a = JustOk a | NotOk String @@ -761,7 +741,7 @@ maybeOk _ j (JustOk x) = j x maybeOk n _ (NotOk x) = n x -{-# LINE 1061 "src/ehc/Base/Common.chs" #-} +{-# LINE 1070 "src/ehc/Base/Common.chs" #-} -- | Abstract graph visit, over arbitrary structures graphVisit :: (Ord node) @@ -781,7 +761,7 @@ unvisited3 = unionUnvisited (newUnvisited `Set.difference` visited') unvisited2 in v ((visited',unvisited3),thr') -{-# LINE 1086 "src/ehc/Base/Common.chs" #-} +{-# LINE 1095 "src/ehc/Base/Common.chs" #-} data KnownPrim = -- platform Int @@ -820,17 +800,17 @@ | KnownPrim_Mul64 deriving (Show,Eq,Enum,Bounded) -{-# LINE 1132 "src/ehc/Base/Common.chs" #-} +{-# LINE 1141 "src/ehc/Base/Common.chs" #-} instance PP KnownPrim where pp = pp . show -{-# LINE 1137 "src/ehc/Base/Common.chs" #-} +{-# LINE 1146 "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 1152 "src/ehc/Base/Common.chs" #-} +{-# LINE 1161 "src/ehc/Base/Common.chs" #-} str2stMpWithOmitShow :: (Enum opt, Bounded opt, Eq opt) => (opt -> String) -> [opt] -> Map.Map String opt str2stMpWithOmitShow shw omits = Map.fromList [ (shw o, o) | o <- [minBound .. maxBound] \\ omits ] @@ -846,35 +826,28 @@ showStr2stMp :: Map.Map String opt -> String showStr2stMp = concat . intersperse " " . Map.keys -{-# LINE 1173 "src/ehc/Base/Common.chs" #-} -deriving instance Data KnownPrim +{-# LINE 1182 "src/ehc/Base/Common.chs" #-} deriving instance Typeable KnownPrim -{-# LINE 1178 "src/ehc/Base/Common.chs" #-} +{-# LINE 1186 "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 #if __GLASGOW_HASKELL__ >= 708 deriving instance Typeable AlwaysEq #else deriving instance Typeable1 AlwaysEq #endif -deriving instance Data x => Data (AlwaysEq x) deriving instance Typeable PredOccId -deriving instance Data PredOccId deriving instance Typeable CLbl -deriving instance Data CLbl -{-# LINE 1207 "src/ehc/Base/Common.chs" #-} +{-# LINE 1209 "src/ehc/Base/Common.chs" #-} instance Binary KnownPrim where put = putEnum8 get = getEnum8 diff --git a/src/UHC/Light/Compiler/Base/Debug.hs b/src/UHC/Light/Compiler/Base/Debug.hs --- a/src/UHC/Light/Compiler/Base/Debug.hs +++ b/src/UHC/Light/Compiler/Base/Debug.hs @@ -5,8 +5,10 @@ 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) diff --git a/src/UHC/Light/Compiler/Base/Fld.hs b/src/UHC/Light/Compiler/Base/Fld.hs --- a/src/UHC/Light/Compiler/Base/Fld.hs +++ b/src/UHC/Light/Compiler/Base/Fld.hs @@ -108,9 +108,8 @@ #else deriving instance Typeable1 Fld' #endif -deriving instance Data x => Data (Fld' x) -{-# LINE 143 "src/ehc/Base/Fld.chs" #-} +{-# LINE 142 "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 --- a/src/UHC/Light/Compiler/Base/HsName.hs +++ b/src/UHC/Light/Compiler/Base/HsName.hs @@ -631,26 +631,20 @@ {-# LINE 857 "src/ehc/Base/HsName.chs" #-} deriving instance Typeable HsName -deriving instance Data HsName deriving instance Typeable IdOccKind -deriving instance Data IdOccKind deriving instance Typeable IdOcc -deriving instance Data IdOcc -{-# LINE 868 "src/ehc/Base/HsName.chs" #-} +{-# LINE 865 "src/ehc/Base/HsName.chs" #-} deriving instance Typeable HsNameUniqifier -deriving instance Data HsNameUniqifier deriving instance Typeable HsNameUnique -deriving instance Data HsNameUnique -{-# LINE 876 "src/ehc/Base/HsName.chs" #-} +{-# LINE 871 "src/ehc/Base/HsName.chs" #-} deriving instance Typeable OrigName -deriving instance Data OrigName -{-# LINE 885 "src/ehc/Base/HsName.chs" #-} +{-# LINE 879 "src/ehc/Base/HsName.chs" #-} instance Binary HsNameUniqifier where put = putEnum8 get = getEnum8 @@ -717,7 +711,7 @@ sputNested = sputPlain sgetNested = sgetPlain -{-# LINE 957 "src/ehc/Base/HsName.chs" #-} +{-# LINE 951 "src/ehc/Base/HsName.chs" #-} data IdOccKind = IdOcc_Val | IdOcc_Pat @@ -732,7 +726,7 @@ | IdOcc_Fusion deriving (Eq,Ord,Enum) -{-# LINE 983 "src/ehc/Base/HsName.chs" #-} +{-# LINE 977 "src/ehc/Base/HsName.chs" #-} -- intended for parsing instance Show IdOccKind where show IdOcc_Val = "Value" @@ -747,21 +741,21 @@ show IdOcc_Data = "Data" show IdOcc_Fusion = "Fusion" -{-# LINE 1009 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1003 "src/ehc/Base/HsName.chs" #-} -- intended for parsing instance PP IdOccKind where pp = text . show -{-# LINE 1015 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1009 "src/ehc/Base/HsName.chs" #-} data IdOcc = IdOcc { ioccNm :: !HsName, ioccKind :: !IdOccKind } deriving (Show,Eq,Ord) -{-# LINE 1026 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1020 "src/ehc/Base/HsName.chs" #-} type HsNameS = Set.Set HsName -{-# LINE 1034 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1028 "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 @@ -772,17 +766,17 @@ first s@(c:_) | isDigit c = '_' : s first s = s -{-# LINE 1061 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1055 "src/ehc/Base/HsName.chs" #-} type FvS = HsNameS type FvSMp = Map.Map HsName FvS -{-# LINE 1070 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1064 "src/ehc/Base/HsName.chs" #-} type HsNameMp = Map.Map HsName HsName hsnRepl :: HsNameMp -> HsName -> HsName hsnRepl m n = Map.findWithDefault n n m -{-# LINE 1081 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1075 "src/ehc/Base/HsName.chs" #-} data RPatNm = RPatNmOrig {rpatNmNm :: !HsName} | RPatNmUniq {rpatNmNm :: !HsName} @@ -798,16 +792,16 @@ pp (RPatNmOrig n) = n >|< "(O)" pp (RPatNmUniq n) = n >|< "(U)" -{-# LINE 1098 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1092 "src/ehc/Base/HsName.chs" #-} rpatNmIsOrig :: RPatNm -> Bool rpatNmIsOrig (RPatNmOrig _) = True rpatNmIsOrig _ = False -{-# LINE 1108 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1102 "src/ehc/Base/HsName.chs" #-} hsnUnknown :: HsName hsnUnknown = hsnFromString "??" -{-# LINE 1117 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1111 "src/ehc/Base/HsName.chs" #-} data Track = TrackNone @@ -818,7 +812,7 @@ deriving (Eq, Ord, Show) -{-# LINE 1129 "src/ehc/Base/HsName.chs" #-} +{-# LINE 1123 "src/ehc/Base/HsName.chs" #-} instance Serialize Track where sput (TrackNone ) = sputWord8 0 @@ -836,7 +830,6 @@ 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/Pragma.hs b/src/UHC/Light/Compiler/Base/Pragma.hs --- a/src/UHC/Light/Compiler/Base/Pragma.hs +++ b/src/UHC/Light/Compiler/Base/Pragma.hs @@ -42,7 +42,7 @@ | Pragma_ExcludeIfTarget { pragmaExcludeTargets :: [Target] } - deriving (Eq,Ord,Show,Typeable,Data) + deriving (Eq,Ord,Show,Typeable) {-# LINE 63 "src/ehc/Base/Pragma.chs" #-} diff --git a/src/UHC/Light/Compiler/Base/RLList.hs b/src/UHC/Light/Compiler/Base/RLList.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/Base/RLList.hs +++ /dev/null @@ -1,113 +0,0 @@ -{-# LANGUAGE CPP #-} - -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 34 "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 50 "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 72 "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 81 "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 94 "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 109 "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 116 "src/ehc/Base/RLList.chs" #-} -instance Show a => Show (RLList a) where - show = show . rllToList - -{-# LINE 125 "src/ehc/Base/RLList.chs" #-} -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable RLList -#else -deriving instance Typeable1 RLList -#endif -deriving instance Data x => Data (RLList x) - - -{-# LINE 139 "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 --- a/src/UHC/Light/Compiler/Base/Range.hs +++ b/src/UHC/Light/Compiler/Base/Range.hs @@ -118,13 +118,11 @@ {-# 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" #-} +{-# LINE 182 "src/ehc/Base/Range.chs" #-} instance Binary Range where put (Range_Unknown ) = putWord8 0 put (Range_Builtin ) = putWord8 1 diff --git a/src/UHC/Light/Compiler/Base/Strictness.hs b/src/UHC/Light/Compiler/Base/Strictness.hs --- a/src/UHC/Light/Compiler/Base/Strictness.hs +++ b/src/UHC/Light/Compiler/Base/Strictness.hs @@ -22,9 +22,8 @@ {-# LINE 38 "src/ehc/Base/Strictness.chs" #-} deriving instance Typeable Strictness -deriving instance Data Strictness -{-# LINE 47 "src/ehc/Base/Strictness.chs" #-} +{-# LINE 46 "src/ehc/Base/Strictness.chs" #-} instance Binary Strictness where put (Strictness_Strict ) = putWord8 0 put (Strictness_NonStrict ) = putWord8 1 diff --git a/src/UHC/Light/Compiler/Base/Target.hs b/src/UHC/Light/Compiler/Base/Target.hs --- a/src/UHC/Light/Compiler/Base/Target.hs +++ b/src/UHC/Light/Compiler/Base/Target.hs @@ -289,15 +289,12 @@ {-# LINE 549 "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 564 "src/ehc/Base/Target.chs" #-} +{-# LINE 561 "src/ehc/Base/Target.chs" #-} instance Binary Target where put = putEnum8 get = getEnum8 diff --git a/src/UHC/Light/Compiler/Base/Trace.hs b/src/UHC/Light/Compiler/Base/Trace.hs --- a/src/UHC/Light/Compiler/Base/Trace.hs +++ b/src/UHC/Light/Compiler/Base/Trace.hs @@ -62,7 +62,10 @@ trppEmpty :: TrPP trppEmpty = Sq.empty -{-# LINE 85 "src/ehc/Base/Trace.chs" #-} +instance PP TrPP where + pp = vlist . Fld.toList + +{-# LINE 88 "src/ehc/Base/Trace.chs" #-} -- | Tracing PPs trPP :: (TraceOn -> Bool) -> TraceOn -> [PP_Doc] -> TrPP trPP onTr ton ms = if onTr ton then pr ms else trppEmpty @@ -77,12 +80,6 @@ -- | Tracing PPs, producing output on IO trOnPP :: (Monad m, MonadIO m) => (TraceOn -> Bool) -> TraceOn -> [PP_Doc] -> m () trOnPP onTr ton ms = when (onTr ton) $ trPPOnIO $ trPP onTr ton ms -{- - where pr [] = return () - pr [m] = putPPLn $ show ton >|< ":" >#< m - pr (m:ms) = do pr [m] - forM_ ms $ \m -> putPPLn $ indent 2 m --} {-# INLINE trOnPP #-} -- | Tracing Strings, producing output on IO diff --git a/src/UHC/Light/Compiler/Base/TreeTrie.hs b/src/UHC/Light/Compiler/Base/TreeTrie.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/Base/TreeTrie.hs +++ /dev/null @@ -1,406 +0,0 @@ -{-# LANGUAGE CPP #-} - -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 Data.Typeable (Typeable) -import Data.Generics (Data) -import Control.Monad -import UHC.Util.Serialize - - - - - -{-# LINE 64 "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 92 "src/ehc/Base/TreeTrie.chs" #-} -#if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable TreeTrie1Key -deriving instance Typeable TreeTrieMp1Key -#else -deriving instance Typeable1 TreeTrie1Key -deriving instance Typeable1 TreeTrieMp1Key -#endif -deriving instance Data x => Data (TreeTrie1Key x) -deriving instance Data x => Data (TreeTrieMp1Key x) - -{-# LINE 104 "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 121 "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 137 "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 177 "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 189 "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 211 "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 221 "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 233 "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 265 "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 279 "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 301 "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 321 "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 396 "src/ehc/Base/TreeTrie.chs" #-} -lookupResultToList :: ([v],Maybe v) -> [v] -lookupResultToList (vs,mv) = maybeToList mv ++ vs - -{-# LINE 405 "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 415 "src/ehc/Base/TreeTrie.chs" #-} -elems :: TreeTrie k v -> [v] -elems = map snd . toListByKey - -{-# LINE 424 "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 439 "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 461 "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 479 "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 494 "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 503 "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 --- a/src/UHC/Light/Compiler/Base/UID.hs +++ b/src/UHC/Light/Compiler/Base/UID.hs @@ -172,9 +172,8 @@ {-# LINE 236 "src/ehc/Base/UID.chs" #-} deriving instance Typeable UID -deriving instance Data UID -{-# LINE 254 "src/ehc/Base/UID.chs" #-} +{-# LINE 253 "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 diff --git a/src/UHC/Light/Compiler/CHR.hs b/src/UHC/Light/Compiler/CHR.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/CHR.hs +++ /dev/null @@ -1,96 +0,0 @@ -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 --- a/src/UHC/Light/Compiler/CHR/Constraint.hs +++ b/src/UHC/Light/Compiler/CHR/Constraint.hs @@ -1,23 +1,29 @@ {-# LANGUAGE CPP #-} module UHC.Light.Compiler.CHR.Constraint -( Constraint (..) -, mkReduction +( Constraint, Constraint' (..) , cnstrReducablePart -, UnresolvedTrace (..) -, cnstrMpSingletonL, cnstrMpFromList +, CHRIntermediateUntilAssume +, mkProve, mkAssume, mkReduction +, gathPredLToProveCnstrMp, gathPredLToAssumeCnstrMp +, predOccCnstrMpLiftScope +, RedHowAnnotation (..) +, ByScopeRedHow (..) +, UnresolvedTrace' (..), UnresolvedTrace +, cnstrMpFromList , ConstraintToInfoTraceMp -, cnstrTraceMpSingleton, cnstrTraceMpLiftTrace, cnstrTraceMpElimTrace, cnstrTraceMpFromList +, cnstrTraceMpSingleton, cnstrTraceMpElimTrace, cnstrTraceMpFromList , ConstraintToInfoMap , emptyCnstrMp , cnstrMpUnion, cnstrMpUnions -, cnstrRequiresSolve ) +, mkProveConstraint, mkAssumeConstraint, mkAssumeConstraint' +, rhaMbId ) where import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.Ty -import UHC.Light.Compiler.CHR +import UHC.Util.CHR import UHC.Light.Compiler.CHR.Key -import UHC.Light.Compiler.Base.TreeTrie +import UHC.Util.TreeTrie import UHC.Light.Compiler.Substitutable import UHC.Util.Pretty as PP import UHC.Util.Utils @@ -32,9 +38,12 @@ -{-# LINE 35 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 38 "src/ehc/CHR/Constraint.chs" #-} +type instance CHRMatchableKey VarMp = Key + +{-# LINE 46 "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 +data Constraint' p info = Prove { cnstrPred :: !p } -- proof obligation | Assume { cnstrPred :: !p } -- assumed constraint | Reduction -- 'side effect', residual info used by (e.g.) codegeneration @@ -45,29 +54,26 @@ } deriving (Eq, Ord, Show) -{-# LINE 51 "src/ehc/CHR/Constraint.chs" #-} -mkReduction :: p -> info -> [p] -> Constraint p info -mkReduction p i ps - = Reduction p i ps - varlookupEmpty +type Constraint = Constraint' CHRPredOcc RedHowAnnotation -{-# LINE 60 "src/ehc/CHR/Constraint.chs" #-} +type instance TTKey (Constraint' p info) = TTKey p + +{-# LINE 66 "src/ehc/CHR/Constraint.chs" #-} #if __GLASGOW_HASKELL__ >= 708 -deriving instance Typeable Constraint +deriving instance Typeable Constraint' #else -deriving instance Typeable2 Constraint +deriving instance Typeable2 Constraint' #endif -deriving instance (Data x, Data y) => Data (Constraint x y) -{-# LINE 69 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 74 "src/ehc/CHR/Constraint.chs" #-} -- | Dissection of Constraint, including reconstruction function -cnstrReducablePart :: Constraint p info -> Maybe (String,p,p->Constraint p info) +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 82 "src/ehc/CHR/Constraint.chs" #-} -instance (CHRMatchable env p s) => CHRMatchable env (Constraint p info) s where +instance (CHRMatchable env p s, TTKey p ~ Key) => CHRMatchable env (Constraint' p info) s where chrMatchTo env s c1 c2 = do { (_,p1,_) <- cnstrReducablePart c1 ; (_,p2,_) <- cnstrReducablePart c2 @@ -75,120 +81,237 @@ } {-# LINE 91 "src/ehc/CHR/Constraint.chs" #-} -instance TTKeyable p => TTKeyable (Constraint p info) where +instance (TTKeyable p, TTKey p ~ Key) => TTKeyable (Constraint' p info) where + -- type TTKey (Constraint' p info) = Key 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 + _ -> panic "TTKeyable (Constraint' p info).toTTKey'" -- ttkEmpty -{-# LINE 100 "src/ehc/CHR/Constraint.chs" #-} -instance (VarExtractable p v,VarExtractable info v) => VarExtractable (Constraint p info) v where +{-# LINE 101 "src/ehc/CHR/Constraint.chs" #-} +type instance ExtrValVarKey (Constraint' p info) = ExtrValVarKey p + +instance (VarExtractable p) => VarExtractable (Constraint' p info) 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 +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 118 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 121 "src/ehc/CHR/Constraint.chs" #-} +-- | intermediate structure for holding constraint and related info until it can safely be assumed +type CHRIntermediateUntilAssume = (CHRPredOcc,(PredScope,ConstraintToInfoTraceMp)) + +{-# LINE 126 "src/ehc/CHR/Constraint.chs" #-} +mkProve :: CHRPredOcc -> Constraint +mkProve = Prove + +mkAssume :: CHRPredOcc -> Constraint +mkAssume = Assume + +mkReduction :: CHRPredOcc -> RedHowAnnotation -> [CHRPredOcc] -> Constraint +mkReduction p i ps + = Reduction p i ps + varlookupEmpty + +{-# LINE 159 "src/ehc/CHR/Constraint.chs" #-} +mkProveConstraint :: Range -> Pred -> UID -> PredScope -> (Constraint,RedHowAnnotation) +mkProveConstraint r pr i sc = (mkProve (mkCHRPredOccRng r pr sc),RedHow_ProveObl i sc) + +mkAssumeConstraint'' :: Range -> Pred -> VarUIDHsName -> PredScope -> (Constraint,RedHowAnnotation) +mkAssumeConstraint'' r pr vun sc = (mkAssume (mkCHRPredOccRng r pr sc),RedHow_Assumption vun sc) + +mkAssumeConstraint' :: Range -> Pred -> UID -> HsName -> PredScope -> (Constraint,RedHowAnnotation) +mkAssumeConstraint' r pr i n sc = mkAssumeConstraint'' r pr (VarUIDHs_Name i n) sc + +mkAssumeConstraint :: Range -> Pred -> UID -> PredScope -> (Constraint,RedHowAnnotation) +mkAssumeConstraint r pr i sc = mkAssumeConstraint'' r pr (VarUIDHs_UID i) sc + +{-# LINE 177 "src/ehc/CHR/Constraint.chs" #-} +gathPredLToProveCnstrMp :: [PredOcc] -> ConstraintToInfoMap +gathPredLToProveCnstrMp l = cnstrMpFromList [ rngLift (poRange po) mkProveConstraint (poPr po) (poId po) (poScope po) | po <- l ] + +gathPredLToAssumeCnstrMp :: [PredOcc] -> ConstraintToInfoMap +gathPredLToAssumeCnstrMp l = cnstrMpFromList [ rngLift (poRange po) mkAssumeConstraint (poPr po) (poId po) (poScope po) | po <- l ] + +{-# LINE 185 "src/ehc/CHR/Constraint.chs" #-} +-- | Lift predicate occurrences to new scope, used to lift unproven predicates to an outer scope. +predOccCnstrMpLiftScope :: PredScope -> ConstraintToInfoMap -> ConstraintToInfoMap +predOccCnstrMpLiftScope sc + = Map.mapKeysWith (++) c . Map.map (map i) + where c (Prove o@(CHRPredOcc {cpoCxt=cx})) + = mkProve (o {cpoCxt = cx {cpocxScope = sc}}) + c x = x + i (RedHow_ProveObl id _) + = RedHow_ProveObl id sc + i x = x + +{-# LINE 202 "src/ehc/CHR/Constraint.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 + ) + +{-# LINE 232 "src/ehc/CHR/Constraint.chs" #-} +rhaMbId :: RedHowAnnotation -> Maybe UID +rhaMbId (RedHow_ProveObl i _) = Just i +rhaMbId _ = Nothing + +{-# LINE 238 "src/ehc/CHR/Constraint.chs" #-} +instance Show RedHowAnnotation where + show = showPP . pp + +{-# LINE 243 "src/ehc/CHR/Constraint.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 271 "src/ehc/CHR/Constraint.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 + ) + +-- 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 305 "src/ehc/CHR/Constraint.chs" #-} -- | The trace of an unresolved predicate -data UnresolvedTrace p info +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] + , utraceRedTo :: [UnresolvedTrace' p info] } | UnresolvedTrace_Fail -- failed reduction { utraceRedFrom :: p -- , utraceInfoTo2From :: info - , utraceRedTo :: [UnresolvedTrace p info] + , utraceRedTo :: [UnresolvedTrace' p info] } | UnresolvedTrace_Overlap -- choice could not be made { utraceRedFrom :: p - , utraceRedChoices :: [(info,[UnresolvedTrace p info])] + , utraceRedChoices :: [(info,[UnresolvedTrace' p info])] } deriving Show -instance Eq p => Eq (UnresolvedTrace p info) where +type UnresolvedTrace = UnresolvedTrace' CHRPredOcc RedHowAnnotation + +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 +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 153 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 342 "src/ehc/CHR/Constraint.chs" #-} -- | Map from constraint to something -type ConstraintMp' p info x = Map.Map (Constraint p info) [x] +type ConstraintMp'' p info x = Map.Map (Constraint' p info) [x] +type ConstraintMp' x = ConstraintMp'' CHRPredOcc RedHowAnnotation x -{-# LINE 158 "src/ehc/CHR/Constraint.chs" #-} -cnstrMpSingletonL :: Constraint p i -> [x] -> ConstraintMp' p i x +{-# LINE 348 "src/ehc/CHR/Constraint.chs" #-} +cnstrMpSingletonL :: Constraint -> [x] -> ConstraintMp' x cnstrMpSingletonL c xs = Map.singleton c xs -cnstrMpSingleton :: Constraint p i -> x -> ConstraintMp' p i x +cnstrMpSingleton :: Constraint -> x -> ConstraintMp' x cnstrMpSingleton c x = cnstrMpSingletonL c [x] -cnstrMpFromList :: (Ord p, Ord i) => [(Constraint p i,x)] -> ConstraintMp' p i x +cnstrMpFromList :: [(Constraint,x)] -> ConstraintMp' 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 :: (x -> y) -> ConstraintMp' x -> ConstraintMp' y cnstrMpMap f = Map.map (map f) -{-# LINE 172 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 362 "src/ehc/CHR/Constraint.chs" #-} +-- type ConstraintToInfoTraceMp' p info = ConstraintMp'' p info (info,[UnresolvedTrace' p info]) + -- | Map from constraint to info + trace -type ConstraintToInfoTraceMp p info = ConstraintMp' p info (info,[UnresolvedTrace p info]) +type ConstraintToInfoTraceMp = ConstraintMp' (RedHowAnnotation,[UnresolvedTrace]) -{-# LINE 177 "src/ehc/CHR/Constraint.chs" #-} -cnstrTraceMpFromList :: (Ord p, Ord i) => [(Constraint p i,(i,[UnresolvedTrace p i]))] -> ConstraintToInfoTraceMp p i +{-# LINE 369 "src/ehc/CHR/Constraint.chs" #-} +cnstrTraceMpFromList :: [(Constraint,(RedHowAnnotation,[UnresolvedTrace]))] -> ConstraintToInfoTraceMp cnstrTraceMpFromList = cnstrMpFromList -cnstrTraceMpSingleton :: Constraint p i -> i -> [UnresolvedTrace p i] -> ConstraintToInfoTraceMp p i +cnstrTraceMpSingleton :: Constraint -> RedHowAnnotation -> [UnresolvedTrace] -> ConstraintToInfoTraceMp cnstrTraceMpSingleton c i ts = cnstrMpSingleton c (i,ts) -cnstrTraceMpElimTrace :: (Ord p, Ord i) => ConstraintToInfoTraceMp p i -> ConstraintToInfoMap p i +cnstrTraceMpElimTrace :: ConstraintToInfoTraceMp -> ConstraintToInfoMap cnstrTraceMpElimTrace = cnstrMpMap fst -cnstrTraceMpLiftTrace :: (Ord p, Ord i) => ConstraintToInfoMap p i -> ConstraintToInfoTraceMp p i +cnstrTraceMpLiftTrace :: ConstraintToInfoMap -> ConstraintToInfoTraceMp cnstrTraceMpLiftTrace = cnstrMpMap (\x -> (x,[])) -{-# LINE 191 "src/ehc/CHR/Constraint.chs" #-} +{-# LINE 383 "src/ehc/CHR/Constraint.chs" #-} +-- type ConstraintToInfoMap' p info = ConstraintMp'' p info info + -- | Map from constraint to info -type ConstraintToInfoMap p info = ConstraintMp' p info info +type ConstraintToInfoMap = ConstraintMp' RedHowAnnotation -{-# LINE 196 "src/ehc/CHR/Constraint.chs" #-} -emptyCnstrMp :: ConstraintMp' p info x +{-# LINE 390 "src/ehc/CHR/Constraint.chs" #-} +emptyCnstrMp :: ConstraintMp' x emptyCnstrMp = Map.empty -{-# LINE 206 "src/ehc/CHR/Constraint.chs" #-} -cnstrMpUnion :: (Ord p, Ord i) => ConstraintMp' p i x -> ConstraintMp' p i x -> ConstraintMp' p i x +{-# LINE 395 "src/ehc/CHR/Constraint.chs" #-} +cnstrMpUnion :: ConstraintMp' x -> ConstraintMp' x -> ConstraintMp' x cnstrMpUnion = Map.unionWith (++) -cnstrMpUnions :: (Ord p, Ord i) => [ConstraintMp' p i x] -> ConstraintMp' p i x +cnstrMpUnions :: [ConstraintMp' x] -> ConstraintMp' x cnstrMpUnions = Map.unionsWith (++) -{-# LINE 218 "src/ehc/CHR/Constraint.chs" #-} --- | Predicate for whether solving is required -cnstrRequiresSolve :: Constraint p info -> Bool -cnstrRequiresSolve (Reduction {}) = False -cnstrRequiresSolve _ = True +{-# LINE 407 "src/ehc/CHR/Constraint.chs" #-} +instance IsConstraint (Constraint' p info) where + cnstrRequiresSolve (Reduction {}) = False + cnstrRequiresSolve _ = True -{-# LINE 229 "src/ehc/CHR/Constraint.chs" #-} -instance (PP p, PP info) => PP (Constraint p info) where +{-# LINE 417 "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 241 "src/ehc/CHR/Constraint.chs" #-} -instance (Serialize p, Serialize i) => Serialize (Constraint p i) where +{-# LINE 429 "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 @@ -197,4 +320,34 @@ 0 -> liftM Prove sget 1 -> liftM Assume sget 2 -> liftM4 Reduction sget sget sget sget + +{-# LINE 441 "src/ehc/CHR/Constraint.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/CHR/Guard.hs b/src/UHC/Light/Compiler/CHR/Guard.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR/Guard.hs @@ -0,0 +1,57 @@ +module UHC.Light.Compiler.CHR.Guard +( Guard (..) ) +where +import UHC.Util.CHR +import UHC.Light.Compiler.CHR.Key +import UHC.Util.Pretty +import UHC.Light.Compiler.Base.Common +import UHC.Light.Compiler.Ty +import Control.Monad +import UHC.Util.Binary +import UHC.Util.Serialize + + + +{-# LINE 39 "src/ehc/CHR/Guard.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) + +{-# LINE 60 "src/ehc/CHR/Guard.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 79 "src/ehc/CHR/Guard.chs" #-} +instance Show Guard where + show _ = "CHR Guard" + +instance PP Guard where + pp = ppGuard + +{-# LINE 91 "src/ehc/CHR/Guard.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/CHR/Instances.hs b/src/UHC/Light/Compiler/CHR/Instances.hs new file mode 100644 --- /dev/null +++ b/src/UHC/Light/Compiler/CHR/Instances.hs @@ -0,0 +1,187 @@ +module UHC.Light.Compiler.CHR.Instances +( module UHC.Light.Compiler.CHR.Constraint, module UHC.Light.Compiler.CHR.Guard ) +where +import UHC.Util.CHR +import UHC.Light.Compiler.CHR.Key +import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Guard +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/CHR/Instances.chs" #-} +type instance ExtrValVarKey ConstraintToInfoMap = TyVarId + +instance VarExtractable ConstraintToInfoMap where + varFreeSet x = Set.unions [ varFreeSet k | k <- Map.keys x ] + +instance VarUpdatable ConstraintToInfoMap VarMp where + varUpd s x = Map.mapKeysWith (++) (varUpd s) x + +type instance ExtrValVarKey Guard = TyVarId + +instance VarExtractable Guard 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 85 "src/ehc/CHR/Instances.chs" #-} +type instance ExtrValVarKey VarUIDHsName = TyVarId + +instance VarExtractable VarUIDHsName where + varFreeSet (VarUIDHs_Var i) = Set.singleton i + varFreeSet _ = Set.empty + +-- instance VarUpdatable VarUIDHsName VarMp where +instance (VarLookup m (SubstVarKey m) (SubstVarVal m), SubstVarKey m ~ ImplsVarId, SubstVarVal m ~ VarMpInfo) => VarUpdatable VarUIDHsName m where + varUpd s a = maybe a id $ varmpAssNmLookupAssNmCyc a s + +{-# LINE 97 "src/ehc/CHR/Instances.chs" #-} +type instance ExtrValVarKey RedHowAnnotation = TyVarId + +instance VarExtractable RedHowAnnotation 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 122 "src/ehc/CHR/Instances.chs" #-} +instance CHREmptySubstitution VarMp where + chrEmptySubst = emptyVarMp + + +{-# LINE 132 "src/ehc/CHR/Instances.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 140 "src/ehc/CHR/Instances.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 156 "src/ehc/CHR/Instances.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 165 "src/ehc/CHR/Instances.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 178 "src/ehc/CHR/Instances.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 195 "src/ehc/CHR/Instances.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 304 "src/ehc/CHR/Instances.chs" #-} +instance IsCHRConstraint FIIn Constraint VarMp + +instance IsCHRGuard FIIn Guard VarMp + diff --git a/src/UHC/Light/Compiler/CHR/Key.hs b/src/UHC/Light/Compiler/CHR/Key.hs --- a/src/UHC/Light/Compiler/CHR/Key.hs +++ b/src/UHC/Light/Compiler/CHR/Key.hs @@ -1,13 +1,11 @@ module UHC.Light.Compiler.CHR.Key -( Key (..) -, TTKeyableOpts (..), defaultTTKeyableOpts -, TTKeyable (..) -, toTTKey ) +( Key (..) ) where import UHC.Light.Compiler.Base.Common -import UHC.Light.Compiler.Base.TreeTrie +import UHC.Util.TreeTrie import UHC.Util.Pretty import UHC.Util.Utils +import UHC.Util.CHR.Key import UHC.Light.Compiler.Ty import UHC.Light.Compiler.Ty.Pretty import UHC.Util.Serialize @@ -16,7 +14,7 @@ -{-# LINE 30 "src/ehc/CHR/Key.chs" #-} +{-# LINE 33 "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 @@ -24,10 +22,10 @@ | 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 + , Typeable ) -{-# LINE 54 "src/ehc/CHR/Key.chs" #-} +{-# LINE 57 "src/ehc/CHR/Key.chs" #-} instance Show Key where show (Key_HNm n) = "H:" ++ show n show (Key_UID n) = "U:" ++ show n @@ -35,7 +33,7 @@ show (Key_TyQu n) = "Q:" ++ show n show (Key_Ty n) = "T:" ++ show n -{-# LINE 68 "src/ehc/CHR/Key.chs" #-} +{-# LINE 71 "src/ehc/CHR/Key.chs" #-} instance PP Key where pp (Key_HNm n) = "H:" >|< n pp (Key_UID n) = "U:" >|< n @@ -43,33 +41,13 @@ pp (Key_TyQu n) = "Q:" >|< show n pp (Key_Ty n) = "T:" >|< n -{-# LINE 135 "src/ehc/CHR/Key.chs" #-} -data TTKeyableOpts - = TTKeyableOpts - { ttkoptsVarsAsWild :: Bool -- treat vars as wildcards - } - -defaultTTKeyableOpts = TTKeyableOpts True - -{-# LINE 144 "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 155 "src/ehc/CHR/Key.chs" #-} -toTTKey :: TTKeyable x => x -> TreeTrieKey Key -toTTKey = toTTKey' defaultTTKeyableOpts +{-# LINE 138 "src/ehc/CHR/Key.chs" #-} +type instance TrTrKey x = TTKey x -{-# LINE 160 "src/ehc/CHR/Key.chs" #-} -instance TTKeyable x => TreeTrieKeyable x Key where - toTreeTrieKey = toTTKey +instance TTKeyable x => TreeTrieKeyable x where + toTreeTrieKey = toTTKey -{-# LINE 169 "src/ehc/CHR/Key.chs" #-} +{-# LINE 149 "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 diff --git a/src/UHC/Light/Compiler/CHR/Solve.hs b/src/UHC/Light/Compiler/CHR/Solve.hs --- a/src/UHC/Light/Compiler/CHR/Solve.hs +++ b/src/UHC/Light/Compiler/CHR/Solve.hs @@ -1,576 +1,71 @@ 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'' ) +( module UHC.Util.CHR.Rule +, module UHC.Util.CHR.Solve.TreeTrie.Mono, IsCHRSolvable (..), SolveState, SolveTrace, SolveStep, CHRStore', CHRSolverConstraint +, CHRStore +, PartialOrdering (..), toOrdering, toPartialOrdering +, isLetProveCandidate, isLetProveFailure ) 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 UHC.Util.Serialize -import Control.Monad - - - -{-# LINE 91 "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 143 "src/ehc/CHR/Solve.chs" #-} -type CHRKey = CHRTrieKey -type UsedByKey = (CHRKey,Int) - -{-# LINE 148 "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 180 "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 188 "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 207 "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 235 "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 248 "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 265 "src/ehc/CHR/Solve.chs" #-} -type WorkTime = Int - -initWorkTime :: WorkTime -initWorkTime = 0 - -{-# LINE 276 "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 305 "src/ehc/CHR/Solve.chs" #-} -wlUsedInUnion :: WorkUsedInMap -> WorkUsedInMap -> WorkUsedInMap -wlUsedInUnion = Map.unionWith Set.union - -{-# LINE 310 "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 321 "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 353 "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 371 "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 381 "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 390 "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 405 "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 414 "src/ehc/CHR/Solve.chs" #-} -type LastQueryW = Map.Map WorkKey WorkTime -type LastQuery = Map.Map CHRKey LastQueryW - -emptyLastQuery :: LastQuery -emptyLastQuery = Map.empty - -{-# LINE 422 "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 450 "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 469 "src/ehc/CHR/Solve.chs" #-} -solveStateResetDone :: SolveState p i g s -> SolveState p i g s -solveStateResetDone s = s {stDoneCnstrSet = Set.empty} - -{-# LINE 474 "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 486 "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 530 "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) +import UHC.Util.CHR +import UHC.Util.CHR.Rule +import UHC.Util.Substitutable +import UHC.Light.Compiler.CHR.Instances +import UHC.Light.Compiler.CHR.Key +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.Ty.FitsInCommon2 +import UHC.Util.CHR.Solve.TreeTrie.Mono hiding (IsCHRSolvable (..),SolveState,SolveTrace,SolveStep,CHRStore) +import qualified UHC.Util.CHR.Solve.TreeTrie.Mono as Mono - -- 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 +{-# LINE 24 "src/ehc/CHR/Solve.chs" #-} +instance Mono.IsCHRSolvable FIIn Constraint Guard VarMp - -- 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 +type CHRSolverConstraint = Constraint - -- 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 +-- | (Class alias) API for solving requirements, hiding Mono/Poly differences +class ( Mono.IsCHRSolvable env c g s + ) => IsCHRSolvable env c g s - -- same, but now restricted to not used earlier as indicated by the worklist - r4 = filter (not . slvIsUsedByPropPart wlUsedIn) r3 +instance IsCHRSolvable FIIn Constraint Guard VarMp - -- 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 +type CHRStore' e c g s = Mono.CHRStore c g +type SolveState e c g s = Mono.SolveState c g s +type SolveTrace e c g s = Mono.SolveTrace c g s +type SolveStep e c g s = Mono.SolveStep c g s -{-# LINE 724 "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 89 "src/ehc/CHR/Solve.chs" #-} +type CHRStore = CHRStore' FIIn Constraint Guard VarMp -{-# LINE 755 "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 99 "src/ehc/CHR/Solve.chs" #-} +data PartialOrdering + = P_LT | P_EQ | P_GT | P_NE + deriving (Eq,Show) -{-# LINE 767 "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 +toPartialOrdering :: Ordering -> PartialOrdering +toPartialOrdering o + = case o of + EQ -> P_EQ + LT -> P_LT + GT -> P_GT -{-# LINE 780 "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 +toOrdering :: PartialOrdering -> Maybe Ordering +toOrdering o + = case o of + P_EQ -> Just EQ + P_LT -> Just LT + P_GT -> Just GT + _ -> Nothing -{-# LINE 805 "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 +{-# LINE 124 "src/ehc/CHR/Solve.chs" #-} +-- | Consider a pred for proving if: no free tvars, or its free tvars do not coincide with those globally used +isLetProveCandidate :: (VarExtractable x) => Set.Set (ExtrValVarKey x) -> x -> Bool +isLetProveCandidate glob x + = Set.null fv || Set.null (fv `Set.intersection` glob) + where fv = varFreeSet x -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 +isLetProveFailure :: (VarExtractable x) => Set.Set (ExtrValVarKey x) -> x -> Bool +isLetProveFailure glob x + = Set.null fv + where fv = varFreeSet x diff --git a/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs b/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs --- a/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs +++ b/src/UHC/Light/Compiler/CodeGen/BasicAnnot.hs @@ -38,9 +38,8 @@ {-# LINE 45 "src/ehc/CodeGen/BasicAnnot.chs" #-} deriving instance Typeable BasicSize -deriving instance Data BasicSize -{-# LINE 53 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 52 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance Show BasicSize where show BasicSize_Word8 = "w1" show BasicSize_Word16 = "w2" @@ -53,11 +52,11 @@ show BasicSize_Float = "f4" show BasicSize_Double = "f8" -{-# LINE 69 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 68 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance PP BasicSize where pp = pp . show -{-# LINE 75 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 74 "src/ehc/CodeGen/BasicAnnot.chs" #-} basicSizeOfMp :: Map.Map Int BasicSize basicSizeOfMp = Map.fromList @@ -70,7 +69,7 @@ basicSizeOf :: Int -> BasicSize basicSizeOf i = panicJust "BasicAnnot.basicSizeOf" $ Map.lookup i basicSizeOfMp -{-# LINE 111 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 110 "src/ehc/CodeGen/BasicAnnot.chs" #-} basicSizeIsSigned :: BasicSize -> Bool basicSizeIsSigned BasicSize_Int8 = True basicSizeIsSigned BasicSize_Int16 = True @@ -78,12 +77,12 @@ basicSizeIsSigned BasicSize_Int64 = True basicSizeIsSigned _ = False -{-# LINE 120 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 119 "src/ehc/CodeGen/BasicAnnot.chs" #-} basicSizeDouble, basicSizeFloat :: BasicSize basicSizeFloat = BasicSize_Float basicSizeDouble = BasicSize_Double -{-# LINE 291 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 290 "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, ... @@ -94,11 +93,10 @@ | 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" #-} +{-# LINE 304 "src/ehc/CodeGen/BasicAnnot.chs" #-} deriving instance Typeable BasicTy -deriving instance Data BasicTy -{-# LINE 313 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 311 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance Show BasicTy where show BasicTy_Word = "word" show BasicTy_SWord = "sword" @@ -107,20 +105,20 @@ show BasicTy_Double = "double" show BasicTy_SignedHalfWord = "int" -{-# LINE 325 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 323 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance PP BasicTy where pp = pp . show -{-# LINE 352 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 350 "src/ehc/CodeGen/BasicAnnot.chs" #-} data BasicAnnot = BasicAnnot_None deriving (Show,Eq) -{-# LINE 411 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 407 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance PP BasicAnnot where pp _ = pp "ANNOT" -{-# LINE 424 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 420 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance Serialize BasicTy where sput = sputEnum8 sget = sgetEnum8 @@ -129,7 +127,7 @@ sput = sputEnum8 sget = sgetEnum8 -{-# LINE 434 "src/ehc/CodeGen/BasicAnnot.chs" #-} +{-# LINE 430 "src/ehc/CodeGen/BasicAnnot.chs" #-} instance Serialize BasicAnnot where sput (BasicAnnot_None ) = sputWord8 0 sget = do diff --git a/src/UHC/Light/Compiler/CodeGen/Tag.hs b/src/UHC/Light/Compiler/CodeGen/Tag.hs --- a/src/UHC/Light/Compiler/CodeGen/Tag.hs +++ b/src/UHC/Light/Compiler/CodeGen/Tag.hs @@ -167,10 +167,9 @@ {-# LINE 204 "src/ehc/CodeGen/Tag.chs" #-} deriving instance Typeable CTag -deriving instance Data CTag -{-# LINE 214 "src/ehc/CodeGen/Tag.chs" #-} +{-# LINE 213 "src/ehc/CodeGen/Tag.chs" #-} instance Serialize CTag where sput = sputShared sget = sgetShared diff --git a/src/UHC/Light/Compiler/Config.hs b/src/UHC/Light/Compiler/Config.hs --- a/src/UHC/Light/Compiler/Config.hs +++ b/src/UHC/Light/Compiler/Config.hs @@ -66,12 +66,12 @@ , verMajor = "1" , verMinor = "1" , verMinorMinor = "9" - , verMinorMinorMinor = "1" + , verMinorMinorMinor = "2" , verQuality = "alpha" , verShort = "1.1" , verMedium = "1.1.9" - , verFull = "1.1.9.1" - , verAsNumber = "1010901" + , verFull = "1.1.9.2" + , verAsNumber = "1010902" , verProg = "ehc" } diff --git a/src/UHC/Light/Compiler/ConfigInstall.hs b/src/UHC/Light/Compiler/ConfigInstall.hs --- a/src/UHC/Light/Compiler/ConfigInstall.hs +++ b/src/UHC/Light/Compiler/ConfigInstall.hs @@ -11,7 +11,7 @@ cppOpts = fst $ parseCmdLineOpts Cmd_CPP "-Wno-invalid-pp-token" -- cppOpts = showCmdLineOpts cppOpts' -ehcSvnRevision = "master@c64f1799ad" +ehcSvnRevision = "master@a4b70ea5c6" ehcDefaultInplaceInstallDir = "/Volumes/Work/Programming/uhc/EHC/install" diff --git a/src/UHC/Light/Compiler/ConfigInternalVersions.hs b/src/UHC/Light/Compiler/ConfigInternalVersions.hs --- a/src/UHC/Light/Compiler/ConfigInternalVersions.hs +++ b/src/UHC/Light/Compiler/ConfigInternalVersions.hs @@ -18,14 +18,15 @@ internalVersionCombined :: InternalVersionCombined internalVersionCombined = internalVersionHI - .|. (internalVersionCore `shiftL` 8) - .|. (internalVersionCoreRun `shiftL` 16) - .|. (internalVersionTySys `shiftL` 24) - .|. (internalVersionCodeGen `shiftL` 32) + .|. (internalVersionCore `shiftL` 6) + .|. (internalVersionCoreRun `shiftL` 12) + .|. (internalVersionTySys `shiftL` 18) + .|. (internalVersionCodeGen `shiftL` 24) + .|. (internalVersionEH `shiftL` 30) -{-# LINE 35 "src/ehc/ConfigInternalVersions.chs" #-} +{-# LINE 36 "src/ehc/ConfigInternalVersions.chs" #-} -- | For variation in type inferencing -internalVersionTySys = mkInternalVersion 5 +internalVersionTySys = mkInternalVersion 1 -- | For variation in code gen internalVersionCodeGen = mkInternalVersion 1 @@ -34,8 +35,12 @@ internalVersionHI = mkInternalVersion 1 -- | For binary/serialized Core .cr/.bcr/.tcr etc files -internalVersionCore = mkInternalVersion 20 +internalVersionCore = mkInternalVersion 1 -- | For binary/serialized CoreRun .crr/.bcrr./tcrr etc files -internalVersionCoreRun = mkInternalVersion 11 +internalVersionCoreRun = mkInternalVersion 1 + +-- | For binary/serialized EH intermediate structures +internalVersionEH = mkInternalVersion 1 + diff --git a/src/UHC/Light/Compiler/Core.hs b/src/UHC/Light/Compiler/Core.hs --- a/src/UHC/Light/Compiler/Core.hs +++ b/src/UHC/Light/Compiler/Core.hs @@ -2,7 +2,6 @@ -- UUAGC 0.9.52.1 (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 (..) @@ -50,7 +49,6 @@ 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 @@ -97,8 +95,6 @@ - - -- | Explicit dummy instances instead of derived ones which not really are used except as context for PP instance Show CExpr where show _ = "CExpr" @@ -175,7 +171,6 @@ deriving instance Typeable CBindCateg -deriving instance Data CBindCateg @@ -622,13 +617,11 @@ 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 @@ -642,7 +635,6 @@ 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 @@ -652,7 +644,6 @@ 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 @@ -712,15 +703,15 @@ -- CAlt -------------------------------------------------------- data CAlt = CAlt_Alt {pat_CAlt_Alt :: !(CPat),expr_CAlt_Alt :: !(CExpr)} - deriving ( Data,Eq,Typeable) + deriving ( Eq,Typeable) -- CAltL ------------------------------------------------------- type CAltL = [CAlt] -- CBind ------------------------------------------------------- data CBind = CBind_Bind {nm_CBind_Bind :: !(HsName),bindAspects_CBind_Bind :: !(CBoundL)} - deriving ( Data,Eq,Typeable) + deriving ( Eq,Typeable) -- CBindAnn ---------------------------------------------------- -data CBindAnn = CBindAnn_Coe {coe_CBindAnn_Coe :: !(RelevCoe)} - deriving ( Data,Eq,Typeable) +data CBindAnn = CBindAnn_Coe {coe_CBindAnn_Coe :: !((()))} + deriving ( Eq,Typeable) -- CBindAnnL --------------------------------------------------- type CBindAnnL = [CBindAnn] -- CBindL ------------------------------------------------------ @@ -728,27 +719,26 @@ -- 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) + deriving ( 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) + deriving ( Typeable) -- CDataConL --------------------------------------------------- type CDataConL = [CDataCon] -- CDeclMeta --------------------------------------------------- data CDeclMeta = CDeclMeta_Data {tyNm_CDeclMeta_Data :: !(HsName),dataCons_CDeclMeta_Data :: !(CDataConL)} - deriving ( Data,Typeable) + deriving ( Typeable) -- CDeclMetaL -------------------------------------------------- type CDeclMetaL = [CDeclMeta] -- CExport ----------------------------------------------------- data CExport = CExport_Export {nm_CExport_Export :: !(HsName)} | CExport_ExportData {nm_CExport_ExportData :: !(HsName),mbConNmL_CExport_ExportData :: !((Maybe [HsName]))} - deriving ( Data,Eq,Ord,Typeable) + deriving ( Eq,Ord,Typeable) -- CExportL ---------------------------------------------------- type CExportL = [CExport] -- CExpr ------------------------------------------------------- @@ -774,15 +764,14 @@ | 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) + deriving ( 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) + deriving ( Eq,Typeable) -- CImport ----------------------------------------------------- data CImport = CImport_Import {nm_CImport_Import :: !(HsName)} - deriving ( Data,Eq,Ord,Typeable) + deriving ( Eq,Ord,Typeable) -- CImportL ---------------------------------------------------- type CImportL = [CImport] -- CMetaBind --------------------------------------------------- @@ -790,35 +779,35 @@ | CMetaBind_Function0 {} | CMetaBind_Function1 {} | CMetaBind_Apply0 {} - deriving ( Data,Enum,Eq,Typeable) + deriving ( 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) + deriving ( Eq,Typeable) -- CMetas ------------------------------------------------------ type CMetas = ( CMetaBind,CMetaVal) -- CModule ----------------------------------------------------- data CModule = CModule_Mod {moduleNm_CModule_Mod :: !(HsName),exports_CModule_Mod :: !(CExportL),imports_CModule_Mod :: !(CImportL),declMetas_CModule_Mod :: !(CDeclMetaL),expr_CModule_Mod :: !(CExpr)} - deriving ( Data,Typeable) + deriving ( 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) + deriving ( 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) + deriving ( Eq,Typeable) -- CPatFldL ---------------------------------------------------- type CPatFldL = [CPatFld] -- CPatRest ---------------------------------------------------- data CPatRest = CPatRest_Var {nm_CPatRest_Var :: !(HsName)} | CPatRest_Empty {} - deriving ( Data,Eq,Typeable) + deriving ( Eq,Typeable) -- CodeAGItf --------------------------------------------------- data CodeAGItf = CodeAGItf_AGItf {module_CodeAGItf_AGItf :: !(CModule)} - deriving ( Data,Typeable) + deriving ( Typeable) diff --git a/src/UHC/Light/Compiler/Core/BindExtract.hs b/src/UHC/Light/Compiler/Core/BindExtract.hs --- a/src/UHC/Light/Compiler/Core/BindExtract.hs +++ b/src/UHC/Light/Compiler/Core/BindExtract.hs @@ -36,7 +36,6 @@ = BoundSel { selBind :: Bool , selMeta :: ACoreBindAspectKeyS -> Bool - , selRelevTy :: ACoreBindAspectKeyS -> RelevTy -> Bool , selVal :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> Bool , selTy :: ACoreBindAspectKeyS -> Bool , selFFE :: Bool @@ -49,7 +48,6 @@ = BoundSel { selBind = False , selMeta = const False - , selRelevTy = \_ _ -> False , selVal = \_ _ _ -> False , selTy = const False , selFFE = False @@ -293,7 +291,7 @@ boundval : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local boundval : _ -} @@ -304,7 +302,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (CBindAnn_Coe coe_) of @@ -430,13 +428,6 @@ 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} @@ -445,14 +436,14 @@ visit 0: local boundval : _ local isSelected : _ - local _tup4 : _ + local _tup3 : _ alternative Ty: child aspectKeyS : {ACoreBindAspectKeyS} child ty : {Ty} visit 0: local boundval : _ local isSelected : _ - local _tup5 : _ + local _tup4 : _ alternative FFE: child callconv : {FFIWay} child expEnt : {ForeignEnt} @@ -461,7 +452,7 @@ visit 0: local boundval : _ local isSelected : _ - local _tup6 : _ + local _tup5 : _ -} -- cata sem_CBound :: CBound -> @@ -470,8 +461,6 @@ (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) = @@ -535,26 +524,6 @@ (case (__tup2) of { (_lhsOselvalYesL,_,_) -> ( _lhsOboundval,_lhsOselvalInsertYesM,_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 (mkSel _isSelected _boundval) of - { __tup3 -> - (case (__tup3) of - { (_,_,_lhsOselvalInsertYesM) -> - (case (__tup3) of - { (_,_lhsOselvalNoL,_) -> - (case (__tup3) of - { (_lhsOselvalYesL,_,_) -> - ( _lhsOboundval,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) })) sem_CBound_Val :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> @@ -571,12 +540,12 @@ (case (selVal _lhsIboundsel aspectKeyS_ mlev_ lbl_) of { _isSelected -> (case (mkSel _isSelected _boundval) of - { __tup4 -> - (case (__tup4) of + { __tup3 -> + (case (__tup3) of { (_,_,_lhsOselvalInsertYesM) -> - (case (__tup4) of + (case (__tup3) of { (_,_lhsOselvalNoL,_) -> - (case (__tup4) of + (case (__tup3) of { (_lhsOselvalYesL,_,_) -> ( _lhsOboundval,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) })) sem_CBound_Ty :: ACoreBindAspectKeyS -> @@ -591,12 +560,12 @@ (case (selTy _lhsIboundsel aspectKeyS_) of { _isSelected -> (case (mkSel _isSelected _boundval) of - { __tup5 -> - (case (__tup5) of + { __tup4 -> + (case (__tup4) of { (_,_,_lhsOselvalInsertYesM) -> - (case (__tup5) of + (case (__tup4) of { (_,_lhsOselvalNoL,_) -> - (case (__tup5) of + (case (__tup4) of { (_lhsOselvalYesL,_,_) -> ( _lhsOboundval,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) })) sem_CBound_FFE :: FFIWay -> @@ -615,12 +584,12 @@ (case (selFFE _lhsIboundsel) of { _isSelected -> (case (mkSel _isSelected _boundval) of - { __tup6 -> - (case (__tup6) of + { __tup5 -> + (case (__tup5) of { (_,_,_lhsOselvalInsertYesM) -> - (case (__tup6) of + (case (__tup5) of { (_,_lhsOselvalNoL,_) -> - (case (__tup6) of + (case (__tup5) of { (_lhsOselvalYesL,_,_) -> ( _lhsOboundval,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) })) -- CBoundL ----------------------------------------------------- @@ -1264,10 +1233,6 @@ child ty : {Ty} visit 0: local boundval : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local boundval : _ alternative Debug: child info : {String} visit 0: @@ -1278,8 +1243,6 @@ 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 @@ -1288,14 +1251,6 @@ 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 -> diff --git a/src/UHC/Light/Compiler/Core/Check.hs b/src/UHC/Light/Compiler/Core/Check.hs --- a/src/UHC/Light/Compiler/Core/Check.hs +++ b/src/UHC/Light/Compiler/Core/Check.hs @@ -293,7 +293,7 @@ undefNmMp : UndefNmMp alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -304,7 +304,7 @@ type T_CBindAnn = Int -> EHCOpts -> ( ErrSq,Bool,UndefNmMp) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev @@ -506,9 +506,6 @@ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas - alternative RelevTy: - child aspectKeyS : {ACoreBindAspectKeyS} - child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} @@ -536,8 +533,6 @@ (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) = @@ -642,29 +637,6 @@ (case (_cmetasIundefNmMp) of { _lhsOundefNmMp -> ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisSimple,_lhsOnotYetTransformed,_lhsOundefNmMp) }) }) }) }) }) }) }) })) -sem_CBound_RelevTy :: ACoreBindAspectKeyS -> - RelevTy -> - T_CBound -sem_CBound_RelevTy aspectKeyS_ relevTy_ = - (\ _lhsIevalCtx - _lhsIisGlobal - _lhsIisTopApp - _lhsIisTopTup - _lhsIletBindingsCateg - _lhsIlev - _lhsInm - _lhsIopts -> - (case (Seq.empty) of - { _lhsOerrs -> - (case (True) of - { _lhsOisFreeOfLam -> - (case (False) of - { _lhsOisSimple -> - (case (Set.empty) of - { _lhsOnotYetTransformed -> - (case (Map.empty) of - { _lhsOundefNmMp -> - ( _lhsOerrs,_lhsOisFreeOfLam,_lhsOisSimple,_lhsOnotYetTransformed,_lhsOundefNmMp) }) }) }) }) })) sem_CBound_Val :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> @@ -2426,8 +2398,6 @@ alternatives: alternative Ty: child ty : {Ty} - alternative Coe: - child coe : {RelevCoe} alternative Debug: child info : {String} -} @@ -2436,8 +2406,6 @@ 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 @@ -2447,18 +2415,6 @@ sem_CExprAnn_Ty :: Ty -> T_CExprAnn sem_CExprAnn_Ty ty_ = - (\ _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_ = (\ _lhsIlev _lhsIopts -> (case (Seq.empty) of diff --git a/src/UHC/Light/Compiler/Core/ExtractFFE.hs b/src/UHC/Light/Compiler/Core/ExtractFFE.hs --- a/src/UHC/Light/Compiler/Core/ExtractFFE.hs +++ b/src/UHC/Light/Compiler/Core/ExtractFFE.hs @@ -174,7 +174,7 @@ self : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local self : _ -} @@ -185,7 +185,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( FvS,([HsName]),CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (Set.empty) of @@ -334,11 +334,6 @@ 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} @@ -366,8 +361,6 @@ (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) = @@ -423,26 +416,6 @@ (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 -> @@ -1255,10 +1228,6 @@ child ty : {Ty} visit 0: local self : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local self : _ alternative Debug: child info : {String} visit 0: @@ -1269,8 +1238,6 @@ 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 @@ -1281,16 +1248,6 @@ (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 -> diff --git a/src/UHC/Light/Compiler/Core/FvS.hs b/src/UHC/Light/Compiler/Core/FvS.hs --- a/src/UHC/Light/Compiler/Core/FvS.hs +++ b/src/UHC/Light/Compiler/Core/FvS.hs @@ -132,7 +132,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -141,7 +141,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (Set.empty) of @@ -248,9 +248,6 @@ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas - alternative RelevTy: - child aspectKeyS : {ACoreBindAspectKeyS} - child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} @@ -272,8 +269,6 @@ (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) = @@ -313,18 +308,6 @@ (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 -> @@ -913,8 +896,6 @@ alternatives: alternative Ty: child ty : {Ty} - alternative Coe: - child coe : {RelevCoe} alternative Debug: child info : {String} -} @@ -923,8 +904,6 @@ 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 @@ -932,12 +911,6 @@ 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) }) diff --git a/src/UHC/Light/Compiler/Core/ModAsMap.hs b/src/UHC/Light/Compiler/Core/ModAsMap.hs --- a/src/UHC/Light/Compiler/Core/ModAsMap.hs +++ b/src/UHC/Light/Compiler/Core/ModAsMap.hs @@ -137,7 +137,7 @@ copy : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local copy : _ -} @@ -148,7 +148,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (CBindAnn_Coe coe_) of @@ -256,11 +256,6 @@ 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} @@ -288,8 +283,6 @@ (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) = @@ -322,15 +315,6 @@ (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 -> @@ -1150,10 +1134,6 @@ child ty : {Ty} visit 0: local copy : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local copy : _ alternative Debug: child info : {String} visit 0: @@ -1164,8 +1144,6 @@ 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 @@ -1174,14 +1152,6 @@ 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 -> diff --git a/src/UHC/Light/Compiler/Core/Pretty.hs b/src/UHC/Light/Compiler/Core/Pretty.hs --- a/src/UHC/Light/Compiler/Core/Pretty.hs +++ b/src/UHC/Light/Compiler/Core/Pretty.hs @@ -13,7 +13,6 @@ 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 @@ -27,8 +26,6 @@ - - ppCModule :: EHCOpts -> {- LamMp -> -} CModule -> PP_Doc ppCModule opts {- lamMp -} cmod = let t = wrap_CodeAGItf (sem_CodeAGItf (CodeAGItf_AGItf cmod)) @@ -230,24 +227,24 @@ _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 (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIppHow) of + { _patOppHow -> + (case (_lhsIopts) of + { _patOopts -> + (case (_lhsImlev) of + { _patOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (_lhsIvarPPMp) of + { _patOvarPPMp -> (case (pat_ _patOmlev _patOopts _patOppHow _patOvarPPMp) of { ( _patIfldNmL,_patIpp) -> (case (howDef _lhsIppHow (_patIpp >#< "->") (_exprIpp)) of @@ -289,24 +286,24 @@ _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 (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsImlev) of + { _hdOmlev -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> (case (hd_ _hdOmlev _hdOopts _hdOppHow _hdOvarPPMp) of { ( _hdIpp) -> (case (_hdIpp >-< _tlIpp) of @@ -417,9 +414,7 @@ pp : PP_Doc alternatives: alternative Coe: - child coe : {RelevCoe} - visit 0: - local pp : _ + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -432,18 +427,16 @@ HowPP -> VarPPMp -> ( PP_Doc) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsImlev _lhsIopts _lhsIppHow _lhsIvarPPMp -> - (case ("~" >#< ppRelevCoe _lhsIvarPPMp coe_) of - { _pp -> - (case (_pp) of - { _lhsOpp -> - ( _lhsOpp) }) })) + (case (empty) of + { _lhsOpp -> + ( _lhsOpp) })) -- CBindAnnL --------------------------------------------------- {- visit 0: @@ -482,16 +475,16 @@ _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 + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> (case (_lhsIppHow) of { _hdOppHow -> (case (_lhsIopts) of @@ -554,30 +547,30 @@ _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 (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsImlev) of + { _tlOmlev -> + (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 (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (tl_ _tlOmlev _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> (case (hd_1 _hdOminMetaLev _hdOopts _hdOppHow _hdOvarPPMp) of { ( _hdInm,_hdIpp) -> (case (_hdIpp >-< _tlIpp) of @@ -634,18 +627,6 @@ 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} @@ -655,7 +636,7 @@ local mlevHere : _ visit 1: local ppHow : _ - local _tup2 : _ + local _tup1 : _ local lev : _ local sep : _ local ppBound : _ @@ -691,8 +672,6 @@ (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) = @@ -735,14 +714,14 @@ _lhsIopts _lhsIppHow _lhsIvarPPMp -> - (case (_lhsIvarPPMp) of - { _exprOvarPPMp -> - (case (_lhsIppHow) of - { _exprOppHow -> - (case (_lhsIopts) of - { _exprOopts -> - (case (_mlevHere) of - { _exprOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_mlevHere) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case (_lhsIopts) of @@ -805,42 +784,6 @@ 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 -> @@ -861,16 +804,16 @@ _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 (if _mlevHere == _lhsIminMetaLev then _lhsIppHow else howHor) of + { _ppHow -> + (case (_ppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_mlevHere) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case (let asp | Set.null aspectKeyS_ || ACoreBindAspectKey_Default `Set.member` aspectKeyS_ @@ -882,18 +825,18 @@ , "@" ++ show mlev_ , not $ mlev_ == 0 && lbl_ == CLbl_None && Set.null aspectKeyS_ )) of - { __tup2 -> - (case (__tup2) of + { __tup1 -> + (case (__tup1) of { (_,_lev,_) -> (case ((if _mlevHere == _lhsIminMetaLev then "=" else "::") ++ (if _mlevHere > _lhsImlev then _lev else "")) of { _sep -> - (case (__tup2) of + (case (__tup1) of { (_ppBound,_,_) -> (case (ppBound _lhsIopts True (Just _lev) _sep _ppBound) of { _pp -> (case (_pp) of { _lhsOpp -> - (case (__tup2) of + (case (__tup1) of { (_,_,_mustPar) -> (case ([(_sep,_mustPar,_ppBound)]) of { _lhsOppBindInfoL -> @@ -955,14 +898,14 @@ _lhsIopts _lhsIppHow _lhsIvarPPMp -> - (case (_lhsIvarPPMp) of - { _exprOvarPPMp -> - (case (_lhsIppHow) of - { _exprOppHow -> - (case (_lhsIopts) of - { _exprOopts -> - (case (_lhsImlev) of - { _exprOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (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 @@ -1044,26 +987,26 @@ _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 (_lhsIppHow) of + { _tlOppHow -> + (case (_lhsIopts) of + { _tlOopts -> + (case (_lhsIminMetaLev) of + { _tlOminMetaLev -> + (case (_lhsIppHow) of + { _hdOppHow -> + (case (_lhsIopts) of + { _hdOopts -> + (case (_lhsIminMetaLev) of + { _hdOminMetaLev -> + (case (_lhsIvarPPMp) of + { _tlOvarPPMp -> + (case (_lhsInm) of + { _tlOnm -> + (case (tl_1 _tlOminMetaLev _tlOnm _tlOopts _tlOppHow _tlOvarPPMp) of + { ( _tlIpp,_tlIppBindInfoL,_tlIppL) -> + (case (_lhsIvarPPMp) of + { _hdOvarPPMp -> (case (_lhsInm) of { _hdOnm -> (case (hd_1 _hdOminMetaLev _hdOnm _hdOopts _hdOppHow _hdOvarPPMp) of @@ -1699,31 +1642,31 @@ _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 (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (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 (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case (_lhsIvarPPMp) of + { _bindsOvarPPMp -> (case (binds_ _bindsOmlev _bindsOopts _bindsOppHow _bindsOvarPPMp) of { ( _bindsIpp,_bindsIppL) -> (case (howDef _lhsIppHow ("let" >|< _ppCateg) (ppSemiTerminated _bindsIppL) >#< "in" >-< _bodyIpp) of @@ -1745,32 +1688,32 @@ _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 (_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 (_lhsIppHow) of + { _funcOppHow -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImlev) of + { _funcOmlev -> + (case (_lhsIvarPPMp) of + { _argOvarPPMp -> + (case (hsnUnknown) of + { _argOnm -> + (case (arg_1 _argOminMetaLev _argOnm _argOopts _argOppHow _argOvarPPMp) of + { ( _argIpp,_argIppBindInfoL) -> + (case (_lhsIvarPPMp) of + { _funcOvarPPMp -> (case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of { ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) -> (case ((_argIpp) : _funcIappArgPPL) of @@ -1802,30 +1745,30 @@ _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 (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (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 (_lhsIvarPPMp) of + { _bodyOvarPPMp -> + (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of + { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> + (case (_lhsIvarPPMp) of + { _bindOvarPPMp -> (case (bind_1 _bindOminMetaLev _bindOopts _bindOppHow _bindOvarPPMp) of { ( _bindInm,_bindIpp) -> (case (_bindIpp : _bodyIlamArgPPL) of @@ -1854,34 +1797,34 @@ _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 (_lhsIppHow) of + { _dfltOppHow -> + (case (_lhsIopts) of + { _dfltOopts -> + (case (_lhsImlev) of + { _dfltOmlev -> + (case (_lhsIppHow) of + { _altsOppHow -> + (case (_lhsIopts) of + { _altsOopts -> + (case (_lhsImlev) of + { _altsOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _dfltOvarPPMp -> + (case (dflt_ _dfltOmlev _dfltOopts _dfltOppHow _dfltOvarPPMp) of + { ( _dfltIappArgPPL,_dfltIappFunPP,_dfltIlamArgPPL,_dfltIlamBodyPP,_dfltIpp) -> + (case (_lhsIvarPPMp) of + { _altsOvarPPMp -> + (case (alts_ _altsOmlev _altsOopts _altsOppHow _altsOvarPPMp) of + { ( _altsIpp,_altsIppL) -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case ("case" >#< _exprIpp >#< "of" @@ -1906,14 +1849,14 @@ _lhsIvarPPMp -> (case ([]) of { _lhsOappArgPPL -> - (case (_lhsIvarPPMp) of - { _errorExprOvarPPMp -> - (case (_lhsIppHow) of - { _errorExprOppHow -> - (case (_lhsIopts) of - { _errorExprOopts -> - (case (_lhsImlev) of - { _errorExprOmlev -> + (case (_lhsIppHow) of + { _errorExprOppHow -> + (case (_lhsIopts) of + { _errorExprOopts -> + (case (_lhsImlev) of + { _errorExprOmlev -> + (case (_lhsIvarPPMp) of + { _errorExprOvarPPMp -> (case (errorExpr_ _errorExprOmlev _errorExprOopts _errorExprOppHow _errorExprOvarPPMp) of { ( _errorExprIappArgPPL,_errorExprIappFunPP,_errorExprIlamArgPPL,_errorExprIlamBodyPP,_errorExprIpp) -> (case (pp "FAIL" >#< failReason_ >-< whenMore _lhsIopts (indent 2 $ ppCurlys _errorExprIpp)) of @@ -1939,24 +1882,24 @@ _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 (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case (howDef _lhsIppHow (ppParens _exprIpp) ("-=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_])) of @@ -1983,34 +1926,34 @@ _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 (_lhsIppHow) of + { _fldExprOppHow -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImlev) of + { _fldExprOmlev -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _fldExprOvarPPMp -> + (case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of + { ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow ("+=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_]) (ppParens _fldExprIpp))) of @@ -2037,34 +1980,34 @@ _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 (_lhsIppHow) of + { _fldExprOppHow -> + (case (_lhsIopts) of + { _fldExprOopts -> + (case (_lhsImlev) of + { _fldExprOmlev -> + (case (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIppHow) of + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _fldExprOvarPPMp -> + (case (fldExpr_ _fldExprOmlev _fldExprOopts _fldExprOppHow _fldExprOvarPPMp) of + { ( _fldExprIappArgPPL,_fldExprIappFunPP,_fldExprIlamArgPPL,_fldExprIlamBodyPP,_fldExprIpp) -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> + (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of + { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> (case (howDef _lhsIppHow (ppParens _exprIpp) (howDef _lhsIppHow (":=" >|< ppCurlysCommas' [ppTag tag_,_offsetIpp,ppCNm' _lhsIopts nm_]) (ppParens _fldExprIpp))) of @@ -2153,14 +2096,14 @@ _lhsIvarPPMp -> (case ([]) of { _lhsOappArgPPL -> - (case (_lhsIvarPPMp) of - { _bodyOvarPPMp -> - (case (_lhsIppHow) of - { _bodyOppHow -> - (case (_lhsIopts) of - { _bodyOopts -> - (case (_lhsImlev) of - { _bodyOmlev -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> (case ("let --" >#< ppHole bindsUid_ >-< howDef _lhsIppHow (pp "in") _bodyIpp) of @@ -2203,14 +2146,14 @@ _lhsIvarPPMp -> (case ([]) of { _lhsOappArgPPL -> - (case (_lhsIvarPPMp) of - { _funcOvarPPMp -> - (case (_lhsIppHow) of - { _funcOppHow -> - (case (_lhsIopts) of - { _funcOopts -> - (case (_lhsImlev) of - { _funcOmlev -> + (case (_lhsIppHow) of + { _funcOppHow -> + (case (_lhsIopts) of + { _funcOopts -> + (case (_lhsImlev) of + { _funcOmlev -> + (case (_lhsIvarPPMp) of + { _funcOvarPPMp -> (case (func_ _funcOmlev _funcOopts _funcOppHow _funcOvarPPMp) of { ( _funcIappArgPPL,_funcIappFunPP,_funcIlamArgPPL,_funcIlamBodyPP,_funcIpp) -> (case (howDef _lhsIppHow (_funcIpp >#< "-- Impl") (ppHole uid_)) of @@ -2234,14 +2177,14 @@ _lhsIvarPPMp -> (case ([]) of { _lhsOappArgPPL -> - (case (_lhsIvarPPMp) of - { _bodyOvarPPMp -> - (case (_lhsIppHow) of - { _bodyOppHow -> - (case (_lhsIopts) of - { _bodyOopts -> - (case (_lhsImlev) of - { _bodyOmlev -> + (case (_lhsIppHow) of + { _bodyOppHow -> + (case (_lhsIopts) of + { _bodyOopts -> + (case (_lhsImlev) of + { _bodyOmlev -> + (case (_lhsIvarPPMp) of + { _bodyOvarPPMp -> (case (body_ _bodyOmlev _bodyOopts _bodyOppHow _bodyOvarPPMp) of { ( _bodyIappArgPPL,_bodyIappFunPP,_bodyIlamArgPPL,_bodyIlamBodyPP,_bodyIpp) -> (case (howDef _lhsIppHow ("\\" >|< ppHole uid_ >#< "-- Impl") ("->" >#< _bodyIpp)) of @@ -2265,18 +2208,18 @@ _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 + { _exprOppHow -> + (case (_lhsIopts) of + { _exprOopts -> + (case (_lhsImlev) of + { _exprOmlev -> + (case (_lhsIvarPPMp) of + { _exprOvarPPMp -> + (case (expr_ _exprOmlev _exprOopts _exprOppHow _exprOvarPPMp) of + { ( _exprIappArgPPL,_exprIappFunPP,_exprIlamArgPPL,_exprIlamBodyPP,_exprIpp) -> + (case (_lhsIvarPPMp) of + { _annOvarPPMp -> (case (_lhsIppHow) of { _annOppHow -> (case (_lhsIopts) of @@ -2311,10 +2254,6 @@ child ty : {Ty} visit 0: local pp : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local pp : _ alternative Debug: child info : {String} visit 0: @@ -2325,8 +2264,6 @@ 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 @@ -2347,18 +2284,6 @@ (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_ = @@ -2949,24 +2874,24 @@ { _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 (_lhsIppHow) of + { _offsetOppHow -> + (case (_lhsIopts) of + { _offsetOopts -> + (case (_lhsImlev) of + { _offsetOmlev -> + (case (_lhsIvarPPMp) of + { _fldAnnsOvarPPMp -> + (case (_lhsIppHow) of + { _fldAnnsOppHow -> + (case (_lhsIopts) of + { _fldAnnsOopts -> + (case (_lhsImlev) of + { _fldAnnsOmlev -> + (case (fldAnns_ _fldAnnsOmlev _fldAnnsOopts _fldAnnsOppHow _fldAnnsOvarPPMp) of + { ( _fldAnnsIpp,_fldAnnsIppL) -> + (case (_lhsIvarPPMp) of + { _offsetOvarPPMp -> (case (offset_ _offsetOmlev _offsetOopts _offsetOppHow _offsetOvarPPMp) of { ( _offsetIappArgPPL,_offsetIappFunPP,_offsetIlamArgPPL,_offsetIlamBodyPP,_offsetIpp) -> (case (whenMore _lhsIopts (ppCurlysCommas' [ppCNm' _lhsIopts lbl_,_offsetIpp ] >|< "=") >|< _bindIpp diff --git a/src/UHC/Light/Compiler/Core/Subst.hs b/src/UHC/Light/Compiler/Core/Subst.hs --- a/src/UHC/Light/Compiler/Core/Subst.hs +++ b/src/UHC/Light/Compiler/Core/Subst.hs @@ -406,7 +406,7 @@ cRepl : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cRepl : _ -} @@ -420,7 +420,7 @@ CExpr -> Bool -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIcSubst @@ -585,11 +585,6 @@ 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} @@ -617,8 +612,6 @@ (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) = @@ -686,18 +679,6 @@ (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 -> @@ -1872,10 +1853,6 @@ child ty : {Ty} visit 0: local cRepl : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cRepl : _ alternative Debug: child info : {String} visit 0: @@ -1886,8 +1863,6 @@ 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 @@ -1902,17 +1877,6 @@ _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 -> diff --git a/src/UHC/Light/Compiler/Core/ToCoreRun.hs b/src/UHC/Light/Compiler/Core/ToCoreRun.hs --- a/src/UHC/Light/Compiler/Core/ToCoreRun.hs +++ b/src/UHC/Light/Compiler/Core/ToCoreRun.hs @@ -569,7 +569,7 @@ stackDepth : Int alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -586,7 +586,7 @@ EHCOpts -> Int -> ( Int) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIrefOffset -> @@ -934,9 +934,6 @@ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas - alternative RelevTy: - child aspectKeyS : {ACoreBindAspectKeyS} - child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} @@ -979,8 +976,6 @@ (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) = @@ -1170,41 +1165,6 @@ 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 - _lhsInm - _lhsIrefOffset -> - (case (CR.emptyNm2RefMp) of - { _lhsOnm2refGath -> - (case (_lhsIrefOffset) of - { _lhsOrefOffset -> - (case ((let sem_CBound_RelevTy_1 :: T_CBound_1 - sem_CBound_RelevTy_1 = - (\ _lhsIimpNmLkup - _lhsIisTopApp - _lhsIisTopTup - _lhsIletBindingsCateg - _lhsImodNr - _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 -> @@ -4901,8 +4861,6 @@ alternatives: alternative Ty: child ty : {Ty} - alternative Coe: - child coe : {RelevCoe} alternative Debug: child info : {String} -} @@ -4911,8 +4869,6 @@ 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 @@ -4947,28 +4903,6 @@ in sem_CExprAnn_Ty_1)) of { ( sem_CExprAnn_1) -> ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExprAnn_1) }) }) })) -sem_CExprAnn_Coe :: RelevCoe -> - T_CExprAnn -sem_CExprAnn_Coe coe_ = - (\ _lhsIrefOffset -> - (case (CR.emptyNm2RefMp) of - { _lhsOnm2refGath -> - (case (_lhsIrefOffset) of - { _lhsOrefOffset -> - (case ((let sem_CExprAnn_Coe_1 :: T_CExprAnn_1 - sem_CExprAnn_Coe_1 = - (\ _lhsIimpNmLkup - _lhsIlev - _lhsImodNr - _lhsInm2ref - _lhsIopts - _lhsIstackDepth -> - (case (_lhsIstackDepth) of - { _lhsOstackDepth -> - ( _lhsOstackDepth) })) - in sem_CExprAnn_Coe_1)) of - { ( sem_CExprAnn_1) -> - ( _lhsOnm2refGath,_lhsOrefOffset,sem_CExprAnn_1) }) }) })) sem_CExprAnn_Debug :: String -> T_CExprAnn sem_CExprAnn_Debug info_ = @@ -5523,7 +5457,7 @@ { _creMod -> (case (declMetas_) of { ( _declMetasIcrmt) -> - (case (CR.Mod_Mod (CR.nm2RefMpInverse _nm2refNew) + (case (CR.Mod_Mod CR.emptyNm2RefMp moduleNm_ _lhsImodNr (_exprIstackDepthMax + 2 ) [CR.Import_Import i | i <- _importsIimpNmL] [CR.Export_Export e (CR.rrefEntry r) | (e,r) <- Rel.toList _nm2refNew] diff --git a/src/UHC/Light/Compiler/Core/ToGrin.hs b/src/UHC/Light/Compiler/Core/ToGrin.hs --- a/src/UHC/Light/Compiler/Core/ToGrin.hs +++ b/src/UHC/Light/Compiler/Core/ToGrin.hs @@ -397,7 +397,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -413,7 +413,7 @@ HsName -> EHCOpts -> ( FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIgUniq -> @@ -738,9 +738,6 @@ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas - alternative RelevTy: - child aspectKeyS : {ACoreBindAspectKeyS} - child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} @@ -766,8 +763,6 @@ (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) = @@ -917,43 +912,6 @@ 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 -> @@ -3459,8 +3417,6 @@ alternatives: alternative Ty: child ty : {Ty} - alternative Coe: - child coe : {RelevCoe} alternative Debug: child info : {String} -} @@ -3469,8 +3425,6 @@ 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 @@ -3499,25 +3453,6 @@ { _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 -> diff --git a/src/UHC/Light/Compiler/Core/Trf.hs b/src/UHC/Light/Compiler/Core/Trf.hs --- a/src/UHC/Light/Compiler/Core/Trf.hs +++ b/src/UHC/Light/Compiler/Core/Trf.hs @@ -26,9 +26,7 @@ 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 @@ -179,11 +177,6 @@ -- 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}) @@ -220,10 +213,6 @@ 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) diff --git a/src/UHC/Light/Compiler/Core/Trf/ANormal.hs b/src/UHC/Light/Compiler/Core/Trf/ANormal.hs --- a/src/UHC/Light/Compiler/Core/Trf/ANormal.hs +++ b/src/UHC/Light/Compiler/Core/Trf/ANormal.hs @@ -584,7 +584,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -600,7 +600,7 @@ Int -> HsName -> ( CBindAnn,FvS,UID,LevBindSq,Int,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIcvarIntroMp @@ -1093,11 +1093,6 @@ 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} @@ -1127,8 +1122,6 @@ (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) = @@ -1400,68 +1393,6 @@ ( _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 70, 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 73, 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 69, 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 -> @@ -5689,10 +5620,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -5703,8 +5630,6 @@ 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 @@ -5739,38 +5664,6 @@ -- 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 69, 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 diff --git a/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs b/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/Core/Trf/AnaRelevance.hs +++ /dev/null @@ -1,11720 +0,0 @@ - - --- UUAGC 0.9.52.1 (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.Util.Pretty -import UHC.Light.Compiler.AnaDomain.Pretty -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.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 90, 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 165, 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 169, column 17) - _patFldGivenTyL = - maybe (map freshLazy $ mkNewLevUIDL (length _patIfldNmL) _lUniq3) - snd _mbCTagEnv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 169, column 17) - _patFldUsedTyL = - map fresh $ mkNewLevUIDL (length _patIfldNmL) _lUniq2 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 169, column 17) - _patEnv = - gamFromAssocL $ zip _patIfldNmL _patFldUsedTyL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 175, column 17) - _patOpatFldTyL = - zip _patFldGivenTyL _patFldUsedTyL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 176, column 17) - _exprOenv = - gamAddGam _patEnv _lhsIenv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 310, 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 415, 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 225, column 17) - _hdOknTy = - _altKnDwTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 277, column 33) - __tup2 = - amsLE _lhsIrvarMp _altKnDwTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 277, column 33) - (_amsoDw,_) = - __tup2 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 277, column 33) - (_,_amsDw) = - __tup2 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 277, column 17) - _rvarMpDw = - amsLocalVarMp _amsDw |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 277, column 17) - _rvarMpUp = - _rvarMpDw - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 286, column 17) - _altNr = - _tlIaltNr + 1 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 295, column 17) - _altKnUpTy = - fresh _lUniq - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 297, column 17) - _altKnDwTy = - fresh _lUniq2 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 337, column 17) - _hereAltCoe = - _hdIcoe <.> (_hdFinalRVarMp `varUpd` amsoCoe _amsoDw) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) - _lhsOty = - _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 384, column 17) - _hdOrvarMp = - _rvarMpUp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 405, column 17) - _hdFinalRVarMp = - _altSolveVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 406, column 17) - _hdOfinalRVarMp = - _hdFinalRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 430, column 17) - _lhsOaltQualSL = - Set.unions [_hdIqualS, amsGathQual _amsDw] : _tlIaltQualSL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 460, column 17) - __tup3 = - hdAndTl' (panic "altSolveLVarMp") _lhsIaltSolveLVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 460, column 17) - (_altSolveVarMp,_) = - __tup3 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 460, column 17) - (_,_tlOaltSolveLVarMp) = - __tup3 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 621, 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 415, 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 285, column 17) - _altNr = - 0 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 366, column 17) - _lhsOty = - _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 431, 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 415, 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 606, column 17) - _cTrf = - CBind_Bind nm_ (_bindAspectsItyAspectL ++ _bindAspectsIvalAspectL ++ _bindAspectsIcTrf) - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - _bindAspectsIgathEnv - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, column 32) - _lhsOgathRecEnv = - _bindAspectsIgathRecEnv - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 415, 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 415, 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 415, 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 415, 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 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - _hdIgathEnv `gamUnion` _tlIgathEnv - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, 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 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, 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 83, column 17) - _whatAbove = - ExprIsBind _lhsInm - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 114, column 17) - _doBindStrict = - WhatToRelevInfer_InstToBot `elem` _lhsIwhatTo - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 115, 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 153, column 17) - _exprOenv = - gamAddGam _exprEnv _lhsIenv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, column 17) - _gathEnv = - gamSingleton _lhsInm _quantTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 195, 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 204, column 17) - _exprOknTy = - _exprKnTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 306, column 17) - _lhsOaltMbScrutTy = - do v <- _exprImbVar - renvLookup v _lhsIenv Map.empty - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 333, column 17) - _hereBindCoe = - _exprIcoe <.> maybe RelevCoe_Id (_finalRVarMp `varUpd`) _mbBindCoe - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 334, column 25) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 375, column 17) - _lhsOrvarMp = - _quantVarMp |+> _rvarMpExpr - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 402, column 17) - _finalRVarMp = - _lhsIfinalRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 412, column 17) - _extraBindRVarMp = - if _doBindStrict then _strictVarMp else emptyRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 425, column 17) - _lhsOqualS = - Set.unions [amsGathQual _amsBind, _exprIqualS] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 486, column 17) - _exprOboundRelevTyVarS = - _exprBoundS - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, 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 492, column 33) - (_ty,_,_,_,_) = - __tup5 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 33) - (_,_exprKnTy,_,_,_) = - __tup5 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 33) - (_,_,_exprEnv,_,_) = - __tup5 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 33) - (_,_,_,_exprBoundS,_) = - __tup5 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 33) - (_,_,_,_,_bindConstrain) = - __tup5 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 511, column 33) - __tup6 = - _bindConstrain _exprIrvarMp _exprKnTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 511, column 33) - (_amsBind,_) = - __tup6 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 511, column 33) - (_,_mbBindCoe) = - __tup6 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 17) - _rvarMpExpr = - amsLocalVarMp _amsBind |+> _exprIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, 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 514, column 33) - (_quantTy,_,_) = - __tup7 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, column 33) - (_,_quantVarMp,_) = - __tup7 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 514, column 33) - (_,_,_quantRemQualS) = - __tup7 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, column 17) - _bindTy = - _lhsIforQuantRVarMp `varUpd` _quantTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 524, 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 524, column 33) - (_strictTy,_) = - __tup8 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 524, column 33) - (_,_strictVarMp) = - __tup8 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, 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 492, 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 492, column 17) - _strictTy2 = - _lhsIfinalRVarMp `varUpd` _strictTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 492, 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 601, 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 630, 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 409, 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 191, column 32) - _lhsOgathEnv = - _gathEnv - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 572, column 32) - _lhsOtyAspectL = - _tyAspectL - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 334, column 25) - _lhsOcoe = - RelevCoe_Id - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - _cmetasIqualS - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 334, column 25) - _lhsOcoe = - RelevCoe_Id - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - Set.empty - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 83, column 17) - _whatAbove = - ExprIsBind _lhsInm - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 310, column 17) - _altMbScrutTy = - Nothing - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - _exprIqualS - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 334, column 25) - _lhsOcoe = - RelevCoe_Id - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - Set.empty - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 84, column 17) - _whatAbove = - ExprIsLam 0 Nothing - -- "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 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 334, column 25) - _lhsOcoe = - RelevCoe_Id - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - _exprIqualS - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - _hdIgathEnv `gamUnion` _tlIgathEnv - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - _hdIqualS `Set.union` _tlIqualS - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - _hdItyAspectL ++ _tlItyAspectL - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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 303, 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 409, 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 191, column 32) - _lhsOgathEnv = - emptyGam - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 192, 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 415, column 28) - _lhsOqualS = - Set.empty - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 572, column 32) - _lhsOtyAspectL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 573, 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)) --- CExport ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - cTrf : CExport - alternatives: - alternative Export: - child nm : {HsName} - visit 0: - local cTrf : _ - alternative ExportData: - child nm : {HsName} - child mbConNmL : {Maybe [HsName]} - visit 0: - local cTrf : _ --} --- cata -sem_CExport :: CExport -> - T_CExport -sem_CExport (CExport_Export _nm) = - (sem_CExport_Export _nm) -sem_CExport (CExport_ExportData _nm _mbConNmL) = - (sem_CExport_ExportData _nm _mbConNmL) --- semantic domain -type T_CExport = ( CExport) -sem_CExport_Export :: HsName -> - T_CExport -sem_CExport_Export nm_ = - (let _lhsOcTrf :: CExport - -- self rule - _cTrf = - CExport_Export nm_ - -- self rule - _lhsOcTrf = - _cTrf - in ( _lhsOcTrf)) -sem_CExport_ExportData :: HsName -> - (Maybe [HsName]) -> - T_CExport -sem_CExport_ExportData nm_ mbConNmL_ = - (let _lhsOcTrf :: CExport - -- self rule - _cTrf = - CExport_ExportData nm_ mbConNmL_ - -- self rule - _lhsOcTrf = - _cTrf - in ( _lhsOcTrf)) --- CExportL ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - cTrf : CExportL - alternatives: - alternative Cons: - child hd : CExport - child tl : CExportL - visit 0: - local cTrf : _ - alternative Nil: - visit 0: - local cTrf : _ --} --- cata -sem_CExportL :: CExportL -> - T_CExportL -sem_CExportL list = - (Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list)) --- semantic domain -type T_CExportL = ( CExportL) -sem_CExportL_Cons :: T_CExport -> - T_CExportL -> - T_CExportL -sem_CExportL_Cons hd_ tl_ = - (let _lhsOcTrf :: CExportL - _hdIcTrf :: CExport - _tlIcTrf :: CExportL - -- self rule - _cTrf = - (:) _hdIcTrf _tlIcTrf - -- self rule - _lhsOcTrf = - _cTrf - ( _hdIcTrf) = - hd_ - ( _tlIcTrf) = - tl_ - in ( _lhsOcTrf)) -sem_CExportL_Nil :: T_CExportL -sem_CExportL_Nil = - (let _lhsOcTrf :: CExportL - -- 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 75, 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 156, column 17) - _mbEnvTy = - fmap (relevtyInst _lUniq) (renvLookup _nm _lhsIenv _lhsIlamMp) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 157, column 33) - __tup10 = - maybe (top, Set.empty) id _mbEnvTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 157, column 33) - (_envTy,_) = - __tup10 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 157, column 33) - (_,_envQualS) = - __tup10 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 231, 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 231, column 33) - (_amso,_) = - __tup11 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 231, column 33) - (_,_ams) = - __tup11 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 316, column 17) - _lhsOcoe = - _lhsIfinalRVarMp `varUpd` amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 347, column 17) - _lhsOfunCoe = - last $ relevCoeToComposeList $ amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 359, column 17) - _lhsOty = - amsoHi _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 379, column 17) - _lhsOrvarMp = - amsLocalVarMp _ams |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 418, column 17) - _lhsOqualS = - Set.union _envQualS (amsGathQual _ams) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 591, column 17) - _dbg = - dbg _lhsIopts _envTy _lhsIknTy _amso _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 610, 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 75, 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 228, column 17) - _litTy = - bot - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - __tup13 = - amsLE _lhsIrvarMp _litTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - (_amso,_) = - __tup13 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - (_,_ams) = - __tup13 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 316, column 17) - _lhsOcoe = - _lhsIfinalRVarMp `varUpd` amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 347, column 17) - _lhsOfunCoe = - last $ relevCoeToComposeList $ amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 359, column 17) - _lhsOty = - amsoHi _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 379, column 17) - _lhsOrvarMp = - amsLocalVarMp _ams |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 421, column 17) - _lhsOqualS = - amsGathQual _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 592, column 17) - _dbg = - dbg _lhsIopts _litTy _lhsIknTy _amso _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 610, 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 75, 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 228, column 17) - _litTy = - bot - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - __tup14 = - amsLE _lhsIrvarMp _litTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - (_amso,_) = - __tup14 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 229, column 33) - (_,_ams) = - __tup14 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 316, column 17) - _lhsOcoe = - _lhsIfinalRVarMp `varUpd` amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 347, column 17) - _lhsOfunCoe = - last $ relevCoeToComposeList $ amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 359, column 17) - _lhsOty = - amsoHi _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 379, column 17) - _lhsOrvarMp = - amsLocalVarMp _ams |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 421, column 17) - _lhsOqualS = - amsGathQual _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 592, column 17) - _dbg = - dbg _lhsIopts _litTy _lhsIknTy _amso _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 610, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 252, 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 252, column 33) - (_tupTy,_) = - __tup15 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 252, column 33) - (_,_tupQualS) = - __tup15 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 256, column 33) - __tup16 = - amsLE _lhsIrvarMp _tupTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 256, column 33) - (_amso,_) = - __tup16 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 256, column 33) - (_,_ams) = - __tup16 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 316, column 17) - _lhsOcoe = - _lhsIfinalRVarMp `varUpd` amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 347, column 17) - _lhsOfunCoe = - last $ relevCoeToComposeList $ amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 359, column 17) - _lhsOty = - amsoHi _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 379, column 17) - _lhsOrvarMp = - amsLocalVarMp _ams |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 420, column 17) - _lhsOqualS = - Set.union _tupQualS (amsGathQual _ams) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 593, column 17) - _dbg = - dbg _lhsIopts _tupTy _lhsIknTy _amso _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 610, 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 75, column 17) - _whatAbove = - ExprIsOther - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 78, column 17) - _isTopLet = - whatExprIsBind _lhsIwhatAbove - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 109, 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 161, column 17) - _bindsOenv = - gamAddGam _bindsIgathRecEnv _lhsIenv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 162, column 17) - _bodyOenv = - gamAddGam _bindsIgathEnv _lhsIenv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, column 17) - _lhsOty = - RelevTy_Err "unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 381, column 17) - _bodyOrvarMp = - _bindsIextraBindRVarMp |+> _bindsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 389, column 17) - _bindsOforQuantRVarMp = - _bindsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 464, column 17) - _bindsCanParticpateInOuterSolving = - categ_ == CBindCateg_Strict - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 464, column 17) - _bindsQualSSubs = - Set.map (_bindsIrvarMp `varUpd`) _bindsIqualS - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 464, column 17) - _bindsQualSOuter = - if _bindsCanParticpateInOuterSolving then _bindsQualSSubs else Set.empty - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 464, 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 477, 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 477, 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 415, 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 73, 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 80, column 17) - _isTopApp' = - isNothing $ whatExprMbApp _lhsIwhatAbove - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 115, 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 207, column 17) - _argOknTy = - _argTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 208, 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 267, column 17) - _funTy = - case _funcIty of - t@(RelevTy_Fun _ _ _ (_:_) _) -> t - _ -> anaMkBotFun 1 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 270, 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 270, column 33) - (_argTy,_,_) = - __tup18 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 270, column 33) - (_,_resTy,_) = - __tup18 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 270, column 33) - (_,_,_resFunTy) = - __tup18 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 317, column 17) - _lhsOcoe = - if _lhsIisTopApp - then _lhsIfinalRVarMp `varUpd` _resCoe - else RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) - _hereArgCoe = - _argIcoe <.> (_lhsIfinalRVarMp `varUpd` _argCoe) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 324, column 17) - _hereFunCoe = - case _funcIwhatBelow of - ExprIsApp _ _ -> RelevCoe_Id - _ -> _funcIcoe - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 348, 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 348, column 17) - (_argCoe,_,_) = - __tup19 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 348, column 17) - (_,_resCoe,_) = - __tup19 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 348, column 17) - (_,_,_lhsOfunCoe) = - __tup19 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 360, column 17) - _lhsOty = - if _lhsIisTopApp then _resTy else _resFunTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 391, column 33) - _forQuantRVarMp = - emptyRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 613, 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 415, 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 Nothing) (\a -> ExprIsLam (a + 1) Nothing) $ whatExprMbLam _bodyIwhatBelow - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 69, column 17) - _whatAbove = - case _lhsIwhatAbove of - ExprIsLam a mbnm -> ExprIsLam (a + 1) mbnm - ExprIsBind nm -> ExprIsLam 1 (Just nm) - _ -> ExprIsLam 1 Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 79, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 328, column 17) - _hereBodyCoe = - case _bodyIwhatBelow of - ExprIsLam _ _ -> RelevCoe_Id - _ -> _bodyIcoe - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, column 17) - _lhsOty = - RelevTy_Err "unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 391, column 33) - _forQuantRVarMp = - emptyRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 612, 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 415, 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 75, 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 212, column 17) - _exprOknTy = - _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 222, column 17) - _altsOknTyCase = - _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 290, column 17) - _altsOaltNrMax = - _altsIaltNr - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 290, column 17) - _altsOaltId = - _lUniq - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 361, column 17) - _lhsOty = - _altsIty - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 380, column 17) - _lhsOrvarMp = - _altsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 422, column 17) - _lhsOqualS = - Set.unions [_exprIqualS, _altQualSIntersect] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 434, column 17) - _altQualSLSubs = - map (Set.map (_altsIrvarMp `varUpd`)) _altsIaltQualSL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 434, 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 434, column 17) - _altQualSLSolv = - map fst _altQualSLSolv1 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 434, column 17) - _altQualSIntersect = - foldr1 Set.intersection _altQualSLSolv - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 449, 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 449, column 17) - _altSolveLVarMp = - map snd _altQualSLSolv2 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 595, column 17) - _dbg = - dbgCase _lhsIopts _lhsIboundRelevTyVarS _altQualSLSubs _altQualSLSolv _altQualSIntersect - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 617, 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 75, 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 321, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 260, 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 260, column 33) - (_ffiTy,_) = - __tup22 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 260, column 33) - (_,_ffiQualS) = - __tup22 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) - __tup23 = - amsLE _lhsIrvarMp _ffiTy _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) - (_amso,_) = - __tup23 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 263, column 33) - (_,_ams) = - __tup23 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 316, column 17) - _lhsOcoe = - _lhsIfinalRVarMp `varUpd` amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 347, column 17) - _lhsOfunCoe = - last $ relevCoeToComposeList $ amsoCoe _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 359, column 17) - _lhsOty = - amsoHi _amso - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 379, column 17) - _lhsOrvarMp = - amsLocalVarMp _ams |+> _lhsIrvarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 419, column 17) - _lhsOqualS = - Set.union _ffiQualS (amsGathQual _ams) - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 594, column 17) - _dbg = - dbg _lhsIopts _ffiTy _lhsIknTy _amso _ams - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 610, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 75, 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 321, column 17) - _lhsOcoe = - RelevCoe_Id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 353, column 17) - _lhsOfunCoe = - RelevCoe_Err "CExpr.unimpl" - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 363, 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 415, 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 321, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 415, 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 exports : CExportL - 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 _exports _imports _declMetas _expr) = - (sem_CModule_Mod _moduleNm (sem_CExportL _exports) (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_CExportL -> - T_CImportL -> - T_CDeclMetaL -> - T_CExpr -> - T_CModule -sem_CModule_Mod moduleNm_ exports_ 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]) - _exportsIcTrf :: CExportL - _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 93, column 17) - _whatAbove = - ExprIsOther - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 102, column 17) - _exprOevalCtx = - EvalCtx_Eval - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 201, column 17) - _exprOknTy = - RelevTy_None - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 489, 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 415, column 28) - _lhsOqualS = - _exprIqualS - -- self rule - _cTrf = - CModule_Mod moduleNm_ _exportsIcTrf _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 - ( _exportsIcTrf) = - exports_ - ( _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 415, 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 415, 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 415, 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 415, 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 415, 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 87, column 17) - _whatAbove = - ExprIsOther - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 105, column 17) - _offsetOevalCtx = - EvalCtx_Eval - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/CommonCtxtPred.ag"(line 106, 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 185, column 17) - __tup25 = - hdAndTl' (panic $ "patFldTyL: " ++ show _fldNm) _lhsIpatFldTyL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 185, column 17) - (_patFldTy,_) = - __tup25 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 185, column 17) - (_,_lhsOpatFldTyL) = - __tup25 - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 186, column 17) - _fldCoe = - let (tgiven,tused) = _patFldTy - in RelevCoe_CastTy tgiven tused - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 216, column 17) - _offsetOknTy = - _lhsIknTy - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 310, column 17) - _altMbScrutTy = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 340, column 17) - _hereOffCoe = - _lhsIfinalRVarMp `varUpd` _offsetIcoe - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 340, column 17) - _hereFldCoe = - _lhsIfinalRVarMp `varUpd` _fldCoe - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 394, column 25) - _bindOforQuantRVarMp = - emptyRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 625, 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 415, 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 415, 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 415, 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 415, 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 415, 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 101, 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 107, column 17) - _howUnionGathLamInfo = - id - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 111, 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 143, column 17) - _gUniq = - uidStart - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 150, column 17) - _env = - emptyGam - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 372, column 17) - _rvarMp = - emptyRVarMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/AnaRelevance.ag"(line 399, 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 --- a/src/UHC/Light/Compiler/Core/Trf/AnnBasedSimplify.hs +++ b/src/UHC/Light/Compiler/Core/Trf/AnnBasedSimplify.hs @@ -260,7 +260,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -273,7 +273,7 @@ type T_CBindAnn = Int -> EHCOpts -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev @@ -456,12 +456,6 @@ 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} @@ -495,8 +489,6 @@ (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) = @@ -590,28 +582,6 @@ (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 -> @@ -2596,11 +2566,6 @@ visit 0: local cTrf : _ local prop : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ - local prop : _ alternative Debug: child info : {String} visit 0: @@ -2612,8 +2577,6 @@ 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 @@ -2630,20 +2593,6 @@ (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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs b/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs --- a/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs +++ b/src/UHC/Light/Compiler/Core/Trf/CAFGlobalAsArg.hs @@ -624,7 +624,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -643,7 +643,7 @@ Int -> FvS -> ( CBindAnn,FvS,Int,Int,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIargMp @@ -1232,11 +1232,6 @@ 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} @@ -1266,8 +1261,6 @@ (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) = @@ -1630,76 +1623,6 @@ ( _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 73, 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 98, 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 97, 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 -> @@ -5955,10 +5878,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -5969,8 +5888,6 @@ 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 @@ -6007,37 +5924,6 @@ -- 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 diff --git a/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs b/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs --- a/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs +++ b/src/UHC/Light/Compiler/Core/Trf/ConstProp.hs @@ -229,7 +229,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -242,7 +242,7 @@ type T_CBindAnn = Int -> EHCOpts -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev @@ -420,11 +420,6 @@ 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} @@ -454,8 +449,6 @@ (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) = @@ -534,23 +527,6 @@ (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 -> @@ -2131,10 +2107,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -2145,8 +2117,6 @@ 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 @@ -2159,16 +2129,6 @@ (\ _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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs b/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs --- a/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs +++ b/src/UHC/Light/Compiler/Core/Trf/ElimNonCodegenConstructs.hs @@ -165,7 +165,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -177,7 +177,7 @@ -- semantic domain type T_CBindAnn = EHCOpts -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIopts -> @@ -306,11 +306,6 @@ 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} @@ -338,8 +333,6 @@ (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) = @@ -381,16 +374,6 @@ (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 -> @@ -1205,10 +1188,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1219,8 +1198,6 @@ 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 @@ -1231,15 +1208,6 @@ 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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs b/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs --- a/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs +++ b/src/UHC/Light/Compiler/Core/Trf/ElimTrivApp.hs @@ -253,7 +253,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -266,7 +266,7 @@ type T_CBindAnn = Int -> EHCOpts -> ( CBindAnn,FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev @@ -476,11 +476,6 @@ 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} @@ -510,8 +505,6 @@ (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) = @@ -602,29 +595,6 @@ (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 -> @@ -2429,10 +2399,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -2443,8 +2409,6 @@ 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 @@ -2457,18 +2421,6 @@ (\ _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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs b/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs --- a/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs +++ b/src/UHC/Light/Compiler/Core/Trf/EraseExtractTysigCore.hs @@ -249,7 +249,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -262,7 +262,7 @@ type T_CBindAnn = LamMp -> EHCOpts -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlamMp @@ -440,14 +440,6 @@ 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} @@ -457,7 +449,7 @@ local cTrf : _ local boundval : _ local isSelected : _ - local _tup4 : _ + local _tup3 : _ alternative Ty: child aspectKeyS : {ACoreBindAspectKeyS} child ty : {Ty} @@ -465,7 +457,7 @@ local cTrf : _ local boundval : _ local isSelected : _ - local _tup5 : _ + local _tup4 : _ alternative FFE: child callconv : {FFIWay} child expEnt : {ForeignEnt} @@ -475,7 +467,7 @@ local cTrf : _ local boundval : _ local isSelected : _ - local _tup6 : _ + local _tup5 : _ -} -- cata sem_CBound :: CBound -> @@ -484,8 +476,6 @@ (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) = @@ -574,35 +564,6 @@ (case (__tup2) of { (_lhsOselvalYesL,_,_) | _lhsOselvalYesL `seq` (True) -> ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalInsertYesM,_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 (mkSel _isSelected _boundval) of - { __tup3 | __tup3 `seq` (True) -> - (case (__tup3) of - { (_,_,_lhsOselvalInsertYesM) | _lhsOselvalInsertYesM `seq` (True) -> - (case (__tup3) of - { (_,_lhsOselvalNoL,_) | _lhsOselvalNoL `seq` (True) -> - (case (__tup3) of - { (_lhsOselvalYesL,_,_) | _lhsOselvalYesL `seq` (True) -> - ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) })) sem_CBound_Val :: ACoreBindAspectKeyS -> MetaLev -> CLbl -> @@ -632,12 +593,12 @@ (case (selVal _lhsIboundsel aspectKeyS_ mlev_ lbl_) of { _isSelected | _isSelected `seq` (True) -> (case (mkSel _isSelected _boundval) of - { __tup4 | __tup4 `seq` (True) -> - (case (__tup4) of + { __tup3 | __tup3 `seq` (True) -> + (case (__tup3) of { (_,_,_lhsOselvalInsertYesM) | _lhsOselvalInsertYesM `seq` (True) -> - (case (__tup4) of + (case (__tup3) of { (_,_lhsOselvalNoL,_) | _lhsOselvalNoL `seq` (True) -> - (case (__tup4) of + (case (__tup3) of { (_lhsOselvalYesL,_,_) | _lhsOselvalYesL `seq` (True) -> ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) }) })) sem_CBound_Ty :: ACoreBindAspectKeyS -> @@ -661,12 +622,12 @@ (case (selTy _lhsIboundsel aspectKeyS_) of { _isSelected | _isSelected `seq` (True) -> (case (mkSel _isSelected _boundval) of - { __tup5 | __tup5 `seq` (True) -> - (case (__tup5) of + { __tup4 | __tup4 `seq` (True) -> + (case (__tup4) of { (_,_,_lhsOselvalInsertYesM) | _lhsOselvalInsertYesM `seq` (True) -> - (case (__tup5) of + (case (__tup4) of { (_,_lhsOselvalNoL,_) | _lhsOselvalNoL `seq` (True) -> - (case (__tup5) of + (case (__tup4) of { (_lhsOselvalYesL,_,_) | _lhsOselvalYesL `seq` (True) -> ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) })) sem_CBound_FFE :: FFIWay -> @@ -698,12 +659,12 @@ (case (selFFE _lhsIboundsel) of { _isSelected | _isSelected `seq` (True) -> (case (mkSel _isSelected _boundval) of - { __tup6 | __tup6 `seq` (True) -> - (case (__tup6) of + { __tup5 | __tup5 `seq` (True) -> + (case (__tup5) of { (_,_,_lhsOselvalInsertYesM) | _lhsOselvalInsertYesM `seq` (True) -> - (case (__tup6) of + (case (__tup5) of { (_,_lhsOselvalNoL,_) | _lhsOselvalNoL `seq` (True) -> - (case (__tup6) of + (case (__tup5) of { (_lhsOselvalYesL,_,_) | _lhsOselvalYesL `seq` (True) -> ( _lhsObindLamMp,_lhsOcBindL,_lhsOcTrf,_lhsOselvalInsertYesM,_lhsOselvalNoL,_lhsOselvalYesL) }) }) }) }) }) }) }) }) }) }) }) }) })) -- CBoundL ----------------------------------------------------- @@ -1658,10 +1619,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1672,8 +1629,6 @@ 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 @@ -1686,16 +1641,6 @@ (\ _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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs b/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs --- a/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs +++ b/src/UHC/Light/Compiler/Core/Trf/EtaRed.hs @@ -232,7 +232,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -244,7 +244,7 @@ -- semantic domain type T_CBindAnn = Int -> ( CBindAnn,FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev -> @@ -436,11 +436,6 @@ 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} @@ -470,8 +465,6 @@ (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) = @@ -553,28 +546,6 @@ (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 -> @@ -2307,10 +2278,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -2321,8 +2288,6 @@ 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 @@ -2333,17 +2298,6 @@ 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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs b/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs --- a/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs +++ b/src/UHC/Light/Compiler/Core/Trf/ExplicitStackTrace.hs @@ -470,7 +470,7 @@ debugLamMp : LamMp alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -486,7 +486,7 @@ EHCOpts -> Int -> ( CBindAnn,LamMp,Int) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlamMp @@ -878,12 +878,6 @@ 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} @@ -916,8 +910,6 @@ (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) = @@ -1163,49 +1155,6 @@ ( _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 -> @@ -4658,10 +4607,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -4672,8 +4617,6 @@ 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 @@ -4700,30 +4643,6 @@ -- 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 diff --git a/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs b/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs --- a/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs +++ b/src/UHC/Light/Compiler/Core/Trf/FixAfterParse.hs @@ -171,7 +171,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -183,7 +183,7 @@ -- semantic domain type T_CBindAnn = DataGam -> ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIdataGam -> @@ -312,11 +312,6 @@ 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} @@ -344,8 +339,6 @@ (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) = @@ -387,16 +380,6 @@ (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 -> @@ -1215,10 +1198,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1229,8 +1208,6 @@ 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 @@ -1241,15 +1218,6 @@ 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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs b/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs --- a/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs +++ b/src/UHC/Light/Compiler/Core/Trf/FloatToGlobal.hs @@ -275,7 +275,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -287,7 +287,7 @@ -- semantic domain type T_CBindAnn = Int -> ( (Seq.FastSeq (CBindCateg,Seq.FastSeq CBind)),CBindAnn,FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev -> @@ -522,11 +522,6 @@ 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} @@ -556,8 +551,6 @@ (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) = @@ -682,37 +675,6 @@ (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 -> @@ -2623,10 +2585,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -2637,8 +2595,6 @@ 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 @@ -2651,19 +2607,6 @@ (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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs b/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs --- a/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs +++ b/src/UHC/Light/Compiler/Core/Trf/InlineLetAlias.hs @@ -502,7 +502,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -517,7 +517,7 @@ Int -> NmMp -> ( CBindAnn,FvS,Int,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIcvarIntroMp @@ -964,11 +964,6 @@ 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} @@ -997,8 +992,6 @@ (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) = @@ -1246,68 +1239,6 @@ ( _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 73, 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 -> @@ -4069,10 +4000,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -4083,8 +4010,6 @@ 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 @@ -4112,29 +4037,6 @@ -- 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 diff --git a/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs b/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs --- a/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs +++ b/src/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.hs @@ -693,7 +693,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -713,7 +713,7 @@ Int -> FvS -> ( CBindAnn,FvS,Int,Int,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIargMp @@ -1326,11 +1326,6 @@ 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} @@ -1360,8 +1355,6 @@ (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) = @@ -1770,84 +1763,6 @@ ( _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 106, 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 73, column 36) - _lhsOcvarIntroExprMp = - Map.empty - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/LamGlobalAsArg.ag"(line 229, 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 85, 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 -> @@ -6638,10 +6553,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -6652,8 +6563,6 @@ 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 @@ -6692,38 +6601,6 @@ -- 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 diff --git a/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs b/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs --- a/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs +++ b/src/UHC/Light/Compiler/Core/Trf/LetDefBeforeUse.hs @@ -228,7 +228,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -240,7 +240,7 @@ -- semantic domain type T_CBindAnn = Int -> ( CBindAnn,DefMp,FvS,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIlev -> @@ -424,11 +424,6 @@ 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} @@ -456,8 +451,6 @@ (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) = @@ -521,26 +514,6 @@ (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 -> @@ -1599,10 +1572,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1613,8 +1582,6 @@ 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 @@ -1625,19 +1592,6 @@ 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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs b/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs --- a/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs +++ b/src/UHC/Light/Compiler/Core/Trf/LetFlattenStrict.hs @@ -158,7 +158,7 @@ cTrf : CBindAnn alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -169,7 +169,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( CBindAnn) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (CBindAnn_Coe coe_) of @@ -299,11 +299,6 @@ 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} @@ -331,8 +326,6 @@ (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) = @@ -382,22 +375,6 @@ (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 -> @@ -1505,10 +1482,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1519,8 +1492,6 @@ 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 @@ -1529,14 +1500,6 @@ 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 -> diff --git a/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs b/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs --- a/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs +++ b/src/UHC/Light/Compiler/Core/Trf/LetUnrec.hs @@ -246,7 +246,7 @@ useMp : UseMp alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 0: local cTrf : _ -} @@ -259,7 +259,7 @@ type T_CBindAnn = ([HsName]) -> Int -> ( CBindAnn,FvS,([HsName]),UseMp) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIinNmL @@ -467,11 +467,6 @@ 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} @@ -499,8 +494,6 @@ (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) = @@ -577,29 +570,6 @@ (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 -> @@ -1727,10 +1697,6 @@ child ty : {Ty} visit 0: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 0: - local cTrf : _ alternative Debug: child info : {String} visit 0: @@ -1741,8 +1707,6 @@ 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 @@ -1755,20 +1719,6 @@ (\ _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) -> diff --git a/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs b/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.hs +++ /dev/null @@ -1,3995 +0,0 @@ - - --- UUAGC 0.9.52.1 (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 - - - - - - - - - - - - - -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 117, 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 98, 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 149, 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 107, column 17) - _doWorkerWrapper = - isJust _lhsImbStrictArgsRes - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 112, column 17) - (_exprOlamArgAnaEvalL,_exprOanaEvalCtxt) = - maybe ([],top) tup123to23 _lhsImbStrictArgsRes - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 127, 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 127, 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 127, column 17) - _oldbinding = - if _doWorkerWrapper then [] else [_cTrf] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 142, 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 88, 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 77, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 114, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 146, 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 88, 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 77, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 91, column 17) - _gathStrictTyL = - if aspectKeyS_ == acbaspkeyStrict - then [relevTy_] - else [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 114, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 146, 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 88, 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 77, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 114, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 146, 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 88, 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 77, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 114, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 146, 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 88, 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 77, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 114, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 143, 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 88, 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 74, 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 124, column 32) - _lhsOcTrfBoundL = - _hdIcTrfBoundL ++ _tlIcTrfBoundL - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 88, 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 124, column 32) - _lhsOcTrfBoundL = - [] - -- use rule "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 88, 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)) --- CExport ----------------------------------------------------- -{- - visit 0: - synthesized attribute: - cTrf : CExport - alternatives: - alternative Export: - child nm : {HsName} - visit 0: - local cTrf : _ - alternative ExportData: - child nm : {HsName} - child mbConNmL : {Maybe [HsName]} - visit 0: - local cTrf : _ --} --- cata -sem_CExport :: CExport -> - T_CExport -sem_CExport (CExport_Export _nm) = - (sem_CExport_Export _nm) -sem_CExport (CExport_ExportData _nm _mbConNmL) = - (sem_CExport_ExportData _nm _mbConNmL) --- semantic domain -type T_CExport = ( CExport) -sem_CExport_Export :: HsName -> - T_CExport -sem_CExport_Export nm_ = - (let _lhsOcTrf :: CExport - -- self rule - _cTrf = - CExport_Export nm_ - -- self rule - _lhsOcTrf = - _cTrf - in ( _lhsOcTrf)) -sem_CExport_ExportData :: HsName -> - (Maybe [HsName]) -> - T_CExport -sem_CExport_ExportData nm_ mbConNmL_ = - (let _lhsOcTrf :: CExport - -- self rule - _cTrf = - CExport_ExportData nm_ mbConNmL_ - -- self rule - _lhsOcTrf = - _cTrf - in ( _lhsOcTrf)) --- CExportL ---------------------------------------------------- -{- - visit 0: - synthesized attribute: - cTrf : CExportL - alternatives: - alternative Cons: - child hd : CExport - child tl : CExportL - visit 0: - local cTrf : _ - alternative Nil: - visit 0: - local cTrf : _ --} --- cata -sem_CExportL :: CExportL -> - T_CExportL -sem_CExportL list = - (Prelude.foldr sem_CExportL_Cons sem_CExportL_Nil (Prelude.map sem_CExport list)) --- semantic domain -type T_CExportL = ( CExportL) -sem_CExportL_Cons :: T_CExport -> - T_CExportL -> - T_CExportL -sem_CExportL_Cons hd_ tl_ = - (let _lhsOcTrf :: CExportL - _hdIcTrf :: CExport - _tlIcTrf :: CExportL - -- self rule - _cTrf = - (:) _hdIcTrf _tlIcTrf - -- self rule - _lhsOcTrf = - _cTrf - ( _hdIcTrf) = - hd_ - ( _tlIcTrf) = - tl_ - in ( _lhsOcTrf)) -sem_CExportL_Nil :: T_CExportL -sem_CExportL_Nil = - (let _lhsOcTrf :: CExportL - -- 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 152, column 17) - _strictRef = - acbrefAspAnd acbaspkeyStrict ref_ - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 152, 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 159, column 17) - _lhsOcTrf = - CExpr_Var $ maybe ref_ (const _strictRef) _mbStrict - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 165, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 104, column 25) - _argOmbStrictArgsRes = - Nothing - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 167, 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 120, column 17) - (_argAnaEval,_bodyOlamArgAnaEvalL) = - hdAndTl' top _lhsIlamArgAnaEvalL - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 122, column 17) - _lamArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, column 17) - _lhsOappArgAnaEvalL = - [] - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 170, 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 exports : CExportL - 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 _exports _imports _declMetas _expr) = - (sem_CModule_Mod _moduleNm (sem_CExportL _exports) (sem_CImportL _imports) (sem_CDeclMetaL _declMetas) (sem_CExpr _expr)) --- semantic domain -type T_CModule = LamMp -> - EHCOpts -> - ( CModule,LamMp) -sem_CModule_Mod :: HsName -> - T_CExportL -> - T_CImportL -> - T_CDeclMetaL -> - T_CExpr -> - T_CModule -sem_CModule_Mod moduleNm_ exports_ imports_ declMetas_ expr_ = - (\ _lhsIlamMp - _lhsIopts -> - (let _anaEvalCtxt :: AnaEval - _lhsOcTrf :: CModule - _lhsOgathLamMp :: LamMp - _exprOanaEvalCtxt :: AnaEval - _exprOlamArgAnaEvalL :: ([AnaEval]) - _exprOlamMp :: LamMp - _exprOopts :: EHCOpts - _exportsIcTrf :: CExportL - _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 80, column 17) - _anaEvalCtxt = - top - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 117, column 17) - _lamArgAnaEvalL = - [] - -- self rule - _cTrf = - CModule_Mod moduleNm_ _exportsIcTrf _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 - ( _exportsIcTrf) = - exports_ - ( _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 83, column 17) - _anaEvalCtxt = - bot - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 117, 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 64, column 17) - _howUnionGathLamInfo = - Map.union _gathLamMp - -- "build/103/lib-ehc/UHC/Light/Compiler/Core/Trf/OptimizeStrictness.ag"(line 68, 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 --- a/src/UHC/Light/Compiler/Core/Trf/RenUniq.hs +++ b/src/UHC/Light/Compiler/Core/Trf/RenUniq.hs @@ -440,7 +440,7 @@ nmL : [HsName] alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} visit 1: local cTrf : _ -} @@ -457,7 +457,7 @@ HsName -> RenUniqOpts -> ( CBindAnn,([HsName])) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (\ _lhsIgIniq -> @@ -753,11 +753,6 @@ 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} @@ -787,8 +782,6 @@ (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) = @@ -909,31 +902,6 @@ 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 -> @@ -2842,10 +2810,6 @@ child ty : {Ty} visit 1: local cTrf : _ - alternative Coe: - child coe : {RelevCoe} - visit 1: - local cTrf : _ alternative Debug: child info : {String} visit 1: @@ -2856,8 +2820,6 @@ 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 @@ -2886,26 +2848,6 @@ { _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 -> diff --git a/src/UHC/Light/Compiler/Core/UsedModNms.hs b/src/UHC/Light/Compiler/Core/UsedModNms.hs --- a/src/UHC/Light/Compiler/Core/UsedModNms.hs +++ b/src/UHC/Light/Compiler/Core/UsedModNms.hs @@ -135,7 +135,7 @@ usedNmS : HsNameS alternatives: alternative Coe: - child coe : {RelevCoe} + child coe : {()} -} -- cata sem_CBindAnn :: CBindAnn -> @@ -144,7 +144,7 @@ (sem_CBindAnn_Coe _coe) -- semantic domain type T_CBindAnn = ( HsNameS) -sem_CBindAnn_Coe :: RelevCoe -> +sem_CBindAnn_Coe :: (()) -> T_CBindAnn sem_CBindAnn_Coe coe_ = (case (Set.empty) of @@ -237,9 +237,6 @@ alternative Meta: child aspectKeyS : {ACoreBindAspectKeyS} child cmetas : CMetas - alternative RelevTy: - child aspectKeyS : {ACoreBindAspectKeyS} - child relevTy : {RelevTy} alternative Val: child aspectKeyS : {ACoreBindAspectKeyS} child mlev : {MetaLev} @@ -261,8 +258,6 @@ (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) = @@ -294,14 +289,6 @@ (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 -> @@ -911,8 +898,6 @@ alternatives: alternative Ty: child ty : {Ty} - alternative Coe: - child coe : {RelevCoe} alternative Debug: child info : {String} -} @@ -921,8 +906,6 @@ 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 @@ -930,12 +913,6 @@ 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) }) diff --git a/src/UHC/Light/Compiler/CoreRun/Pretty.hs b/src/UHC/Light/Compiler/CoreRun/Pretty.hs --- a/src/UHC/Light/Compiler/CoreRun/Pretty.hs +++ b/src/UHC/Light/Compiler/CoreRun/Pretty.hs @@ -13,6 +13,7 @@ import UHC.Light.Compiler.Ty.Pretty import UHC.Light.Compiler.Base.CfgPP import UHC.Light.Compiler.Scanner.Common +import qualified UHC.Util.RelMap as RelMap import qualified Data.Vector as V import UHC.Light.Compiler.Foreign import UHC.Light.Compiler.Foreign.Pretty @@ -28,6 +29,8 @@ + + -- | Not all AST datatypes are expressed as AG, inherited info therefore implemented manually data InhPP = InhPP @@ -53,7 +56,9 @@ ppRRef :: InhPP -> RRef -> PP_Doc -- ppRRef inhpp r = ppMbPost ppCurly (ref2nmLookup r $ r2nInhPP inhpp) r -- ppRRef inhpp r = {- ppMbPost ppCurly (ref2nmLookup r $ r2nInhPP inhpp) -} pp r -ppRRef inhpp r = ppCmtExtra inhpp (maybe (pp "?") pp $ ref2nmLookup r $ r2nInhPP inhpp) $ pp r +ppRRef inhpp r -- = ppCmtExtra inhpp (maybe (pp "?") pp $ ref2nmLookup r $ r2nInhPP inhpp) $ pp r + = maybe r' (\i -> ppCmtExtra inhpp (pp i) r') $ ref2nmLookup r $ r2nInhPP inhpp + where r' = pp r @@ -155,9 +160,14 @@ -- AGItf ------------------------------------------------------- {- + visit 0: + synthesized attribute: + nm2refGath : Nm2RefMp alternatives: alternative AGItf: child module : Mod + visit 0: + local inhpp : _ -} -- cata sem_AGItf :: AGItf -> @@ -165,11 +175,19 @@ sem_AGItf (AGItf_AGItf _module) = (sem_AGItf_AGItf (sem_Mod _module)) -- semantic domain -type T_AGItf = ( ) +type T_AGItf = ( Nm2RefMp) sem_AGItf_AGItf :: T_Mod -> T_AGItf sem_AGItf_AGItf module_ = - ( ) + (case (mkEmptyInhPP defaultEHCOpts) of + { _inhpp -> + (case (_inhpp) of + { _moduleOinhpp -> + (case (module_ _moduleOinhpp) of + { ( _moduleInm2refGath,_moduleIpp) -> + (case (_moduleInm2refGath) of + { _lhsOnm2refGath -> + ( _lhsOnm2refGath) }) }) }) }) -- Alt --------------------------------------------------------- {- visit 0: @@ -473,6 +491,9 @@ -- Export ------------------------------------------------------ {- visit 0: + synthesized attribute: + nm2refGath : Nm2RefMp + visit 1: inherited attribute: inhpp : InhPP synthesized attribute: @@ -488,19 +509,30 @@ sem_Export (Export_Export _nm _offset) = (sem_Export_Export _nm _offset) -- semantic domain -type T_Export = InhPP -> - ( PP_Doc) +type T_Export = ( Nm2RefMp,T_Export_1) +type T_Export_1 = InhPP -> + ( PP_Doc) sem_Export_Export :: HsName -> Int -> T_Export sem_Export_Export nm_ offset_ = - (\ _lhsIinhpp -> - (case ("export" >#< ppDifficultNm nm_ >#< "=" >#< offset_) of - { _lhsOpp -> - ( _lhsOpp) })) + (case (RelMap.singleton nm_ (RRef_Mod offset_)) of + { _lhsOnm2refGath -> + (case ((let sem_Export_Export_1 :: T_Export_1 + sem_Export_Export_1 = + (\ _lhsIinhpp -> + (case ("export" >#< ppDifficultNm nm_ >#< "=" >#< offset_) of + { _lhsOpp -> + ( _lhsOpp) })) + in sem_Export_Export_1)) of + { ( sem_Export_1) -> + ( _lhsOnm2refGath,sem_Export_1) }) }) -- ExportL ----------------------------------------------------- {- visit 0: + synthesized attribute: + nm2refGath : Nm2RefMp + visit 1: inherited attribute: inhpp : InhPP synthesized attributes: @@ -518,34 +550,53 @@ sem_ExportL list = (Prelude.foldr sem_ExportL_Cons sem_ExportL_Nil (Prelude.map sem_Export list)) -- semantic domain -type T_ExportL = InhPP -> - ( PP_Doc,([PP_Doc])) +type T_ExportL = ( Nm2RefMp,T_ExportL_1) +type T_ExportL_1 = InhPP -> + ( PP_Doc,([PP_Doc])) sem_ExportL_Cons :: T_Export -> T_ExportL -> T_ExportL sem_ExportL_Cons hd_ tl_ = - (\ _lhsIinhpp -> - (case (_lhsIinhpp) of - { _tlOinhpp -> - (case (tl_ _tlOinhpp) of - { ( _tlIpp,_tlIppL) -> - (case (_lhsIinhpp) of - { _hdOinhpp -> - (case (hd_ _hdOinhpp) of - { ( _hdIpp) -> - (case (_hdIpp >-< _tlIpp) of - { _lhsOpp -> - (case (_hdIpp : _tlIppL) of - { _lhsOppL -> - ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) + (case (tl_) of + { ( _tlInm2refGath,tl_1) -> + (case (hd_) of + { ( _hdInm2refGath,hd_1) -> + (case (_hdInm2refGath `nm2refUnion` _tlInm2refGath) of + { _lhsOnm2refGath -> + (case ((let sem_ExportL_Cons_1 :: T_ExportL_1 + sem_ExportL_Cons_1 = + (\ _lhsIinhpp -> + (case (_lhsIinhpp) of + { _tlOinhpp -> + (case (tl_1 _tlOinhpp) of + { ( _tlIpp,_tlIppL) -> + (case (_lhsIinhpp) of + { _hdOinhpp -> + (case (hd_1 _hdOinhpp) of + { ( _hdIpp) -> + (case (_hdIpp >-< _tlIpp) of + { _lhsOpp -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) }) }) }) }) })) + in sem_ExportL_Cons_1)) of + { ( sem_ExportL_1) -> + ( _lhsOnm2refGath,sem_ExportL_1) }) }) }) }) sem_ExportL_Nil :: T_ExportL sem_ExportL_Nil = - (\ _lhsIinhpp -> - (case (empty) of - { _lhsOpp -> - (case ([]) of - { _lhsOppL -> - ( _lhsOpp,_lhsOppL) }) })) + (case (emptyNm2RefMp) of + { _lhsOnm2refGath -> + (case ((let sem_ExportL_Nil_1 :: T_ExportL_1 + sem_ExportL_Nil_1 = + (\ _lhsIinhpp -> + (case (empty) of + { _lhsOpp -> + (case ([]) of + { _lhsOppL -> + ( _lhsOpp,_lhsOppL) }) })) + in sem_ExportL_Nil_1)) of + { ( sem_ExportL_1) -> + ( _lhsOnm2refGath,sem_ExportL_1) }) }) -- Import ------------------------------------------------------ {- visit 0: @@ -749,7 +800,8 @@ visit 0: inherited attribute: inhpp : InhPP - synthesized attribute: + synthesized attributes: + nm2refGath : Nm2RefMp pp : PP_Doc alternatives: alternative Mod: @@ -772,15 +824,15 @@ (sem_Mod_Mod _ref2nm _moduleNm _moduleNr _stkDepth (sem_ImportL _imports) (sem_ExportL _exports) (sem_MetaL _metas) _binds (sem_MbExp _mbbody)) -- semantic domain type T_Mod = InhPP -> - ( PP_Doc) + ( Nm2RefMp,PP_Doc) data Inh_Mod = Inh_Mod {inhpp_Inh_Mod :: !(InhPP)} -data Syn_Mod = Syn_Mod {pp_Syn_Mod :: !(PP_Doc)} +data Syn_Mod = Syn_Mod {nm2refGath_Syn_Mod :: !(Nm2RefMp),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)) + (let ( _lhsOnm2refGath,_lhsOpp) = sem _lhsIinhpp + in (Syn_Mod _lhsOnm2refGath _lhsOpp)) sem_Mod_Mod :: Ref2Nm -> HsName -> (Maybe Int) -> @@ -793,31 +845,35 @@ T_Mod sem_Mod_Mod ref2nm_ moduleNm_ moduleNr_ stkDepth_ imports_ exports_ metas_ binds_ mbbody_ = (\ _lhsIinhpp -> - (case (r2nAdd ref2nm_ _lhsIinhpp) of - { _inhpp -> - (case (_inhpp) of - { _mbbodyOinhpp -> - (case (mbbody_ _mbbodyOinhpp) of - { ( _mbbodyIpp,_mbbodyIppMb) -> + (case (exports_) of + { ( _exportsInm2refGath,exports_1) -> + (case (_exportsInm2refGath) of + { _lhsOnm2refGath -> + (case (r2nAdd _exportsInm2refGath _lhsIinhpp) of + { _inhpp -> (case (_inhpp) of - { _metasOinhpp -> - (case (metas_ _metasOinhpp) of - { ( _metasIpp,_metasIppL) -> + { _mbbodyOinhpp -> + (case (mbbody_ _mbbodyOinhpp) of + { ( _mbbodyIpp,_mbbodyIppMb) -> (case (_inhpp) of - { _exportsOinhpp -> - (case (exports_ _exportsOinhpp) of - { ( _exportsIpp,_exportsIppL) -> + { _metasOinhpp -> + (case (metas_ _metasOinhpp) of + { ( _metasIpp,_metasIppL) -> (case (_inhpp) of - { _importsOinhpp -> - (case (imports_ _importsOinhpp) of - { ( _importsIpp,_importsIppL) -> - (case ((ppSemi $ "module" >#< ppCoreNm moduleNm_ >#< stkDepth_ >|< maybe empty (" ->" >#<) _mbbodyIppMb) - >-< ppBindItems _importsIppL - >-< ppBindItems _exportsIppL - >-< ppBindItems _metasIppL - >-< ppBinds'' _inhpp RRef_Mod 0 binds_) of - { _lhsOpp -> - ( _lhsOpp) }) }) }) }) }) }) }) }) }) })) + { _exportsOinhpp -> + (case (exports_1 _exportsOinhpp) of + { ( _exportsIpp,_exportsIppL) -> + (case (_inhpp) of + { _importsOinhpp -> + (case (imports_ _importsOinhpp) of + { ( _importsIpp,_importsIppL) -> + (case ((ppSemi $ "module" >#< ppCoreNm moduleNm_ >#< stkDepth_ >|< maybe empty (" ->" >#<) _mbbodyIppMb) + >-< ppBindItems _importsIppL + >-< ppBindItems _exportsIppL + >-< ppBindItems _metasIppL + >-< ppBinds'' _inhpp RRef_Mod 0 binds_) of + { _lhsOpp -> + ( _lhsOnm2refGath,_lhsOpp) }) }) }) }) }) }) }) }) }) }) }) })) -- Pat --------------------------------------------------------- {- visit 0: diff --git a/src/UHC/Light/Compiler/EH/MainAG.hs b/src/UHC/Light/Compiler/EH/MainAG.hs --- a/src/UHC/Light/Compiler/EH/MainAG.hs +++ b/src/UHC/Light/Compiler/EH/MainAG.hs @@ -59,11 +59,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,14 +118,14 @@ 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),importUsedModules_Inh_AGItf :: !(ImportUsedModules),isMainMod_Inh_AGItf :: !(Bool),kiGam_Inh_AGItf :: !(KiGam),moduleImportExportImpl_Inh_AGItf :: !(ModuleImportExportImpl),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),trpp_Syn_AGItf :: !(TrPP)} +data Inh_AGItf = Inh_AGItf {chrStore_Inh_AGItf :: !(CHRStore),clDfGam_Inh_AGItf :: !(ClassDefaultGam),clGam_Inh_AGItf :: !(ClGam),dataGam_Inh_AGItf :: !(DataGam),gUniq_Inh_AGItf :: !(UID),idQualGam_Inh_AGItf :: !(IdQualGam),importUsedModules_Inh_AGItf :: !(ImportUsedModules),isMainMod_Inh_AGItf :: !(Bool),kiGam_Inh_AGItf :: !(KiGam),moduleImportExportImpl_Inh_AGItf :: !(ModuleImportExportImpl),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 :: !(CHRStore),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),ppAST_Syn_AGItf :: !(PP_Doc),topTyPP_Syn_AGItf :: !(PP_Doc),trpp_Syn_AGItf :: !(TrPP)} wrap_AGItf :: T_AGItf -> Inh_AGItf -> Syn_AGItf wrap_AGItf sem (Inh_AGItf _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIimportUsedModules _lhsIisMainMod _lhsIkiGam _lhsImoduleImportExportImpl _lhsImoduleNm _lhsIopts _lhsIpolGam _lhsItyGam _lhsItyKiGam _lhsIvalGam) | sem `seq` ((Inh_AGItf _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIimportUsedModules _lhsIisMainMod _lhsIkiGam _lhsImoduleImportExportImpl _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,_lhsOtrpp) | True = sem _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIimportUsedModules _lhsIisMainMod _lhsIkiGam _lhsImoduleImportExportImpl _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 _lhsOtrpp)) + (let ( _lhsOallErrSq,_lhsOcmodule,_lhsOgUniq,_lhsOgathChrStore,_lhsOgathClDfGam,_lhsOgathClGam,_lhsOgathDataGam,_lhsOgathHiddenExports,_lhsOgathKiGam,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathPolGam,_lhsOgathTyGam,_lhsOgathTyKiGam,_lhsOgathValGam,_lhsOmbOrphan,_lhsOpp,_lhsOppAST,_lhsOtopTyPP,_lhsOtrpp) | True = sem _lhsIchrStore _lhsIclDfGam _lhsIclGam _lhsIdataGam _lhsIgUniq _lhsIidQualGam _lhsIimportUsedModules _lhsIisMainMod _lhsIkiGam _lhsImoduleImportExportImpl _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 _lhsOppAST _lhsOtopTyPP _lhsOtrpp)) -- CaseAlt ----------------------------------------------------- -- cata sem_CaseAlt :: CaseAlt -> diff --git a/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs b/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs --- a/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_AGItf.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -87,7 +88,7 @@ {- visit 0: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam clGam : ClGam dataGam : DataGam @@ -107,7 +108,7 @@ synthesized attributes: allErrSq : ErrSq cmodule : CModule - gathChrStore : ScopedPredStore + gathChrStore : CHRStore gathClDfGam : ClassDefaultGam gathClGam : ClGam gathDataGam : DataGam @@ -121,6 +122,7 @@ gathValGam : ValGam mbOrphan : Maybe (Set.Set HsName) pp : PP_Doc + ppAST : PP_Doc topTyPP : PP_Doc trpp : TrPP alternatives: @@ -187,6 +189,7 @@ local gathMentrelFilterMp : _ local errTopPP : _ local extraPP : _ + local trppHere : _ -} sem_AGItf_AGItf :: T_Expr -> T_AGItf @@ -408,7 +411,7 @@ (case (ExprCtxt_Top) of { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (defaultFIEnv { feEHCOpts = _lhsIopts , fePredScope = _predScope @@ -534,9 +537,13 @@ (case (_extraPP >-< _exprIpp >-< _errTopPP) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (ppTy (tyQuantifyClosed _exprIty)) of - { _lhsOtopTyPP | _lhsOtopTyPP `seq` (True) -> - (case (_exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcmodule,_lhsOgUniq,_lhsOgathChrStore,_lhsOgathClDfGam,_lhsOgathClGam,_lhsOgathDataGam,_lhsOgathHiddenExports,_lhsOgathKiGam,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathPolGam,_lhsOgathTyGam,_lhsOgathTyKiGam,_lhsOgathValGam,_lhsOmbOrphan,_lhsOpp,_lhsOtopTyPP,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["AGItf","AGItf"] [] [_exprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (ppTy (tyQuantifyClosed _exprIty)) of + { _lhsOtopTyPP | _lhsOtopTyPP `seq` (True) -> + (case (_exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcmodule,_lhsOgUniq,_lhsOgathChrStore,_lhsOgathClDfGam,_lhsOgathClGam,_lhsOgathDataGam,_lhsOgathHiddenExports,_lhsOgathKiGam,_lhsOgathLamMp,_lhsOgathMentrelFilterMp,_lhsOgathPolGam,_lhsOgathTyGam,_lhsOgathTyKiGam,_lhsOgathValGam,_lhsOmbOrphan,_lhsOpp,_lhsOppAST,_lhsOtopTyPP,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs b/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs --- a/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_CaseAlt.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,7 +118,7 @@ finTyKiGam : TyKiGam tyTyTySigFreeTvarS : TyVarIdS synthesized attribute: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) visit 5: inherited attributes: knPatTy : Ty @@ -126,7 +127,7 @@ patTyVarMp : VarMp visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam fiOpts : FIOpts knTy : Ty @@ -136,7 +137,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp visit 7: inherited attributes: @@ -157,6 +158,7 @@ gathTvKiVarMp : VarMp patTy : Ty pp : PP_Doc + ppAST : PP_Doc ralt : RAlt ralt' : RAlt trpp : TrPP @@ -176,6 +178,7 @@ local tySigVarMp : _ local extraPP : _ local pp : _ + local trppHere : _ -} sem_CaseAlt_Pat :: Range -> T_PatExpr -> @@ -492,13 +495,13 @@ (case (_patExprItopNm) of { _patExprOceParentNm | _patExprOceParentNm `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_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 _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_patExprIallErrSq `Seq.union` _exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -517,15 +520,19 @@ { _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 (_patExprItrpp >< _exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_exprIty) of - { _lhsOty | _lhsOty `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOralt,_lhsOralt',_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["CaseAlt","Pat"] [] [_patExprIppAST,_exprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (_patExprItrpp >< _exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_exprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppAST,_lhsOralt,_lhsOralt',_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_CaseAlt_Pat_7)) of { ( sem_CaseAlt_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlt_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs b/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs --- a/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_CaseAlts.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,7 +118,7 @@ finTyKiGam : TyKiGam tyTyTySigFreeTvarS : TyVarIdS synthesized attribute: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) visit 5: inherited attributes: knPatTy : Ty @@ -129,7 +130,7 @@ ty : Ty visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam fiOpts : FIOpts tvKiVarMp : VarMp @@ -138,7 +139,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp visit 7: inherited attributes: @@ -159,6 +160,7 @@ gathTvKiVarMp : VarMp patTy : Ty pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] raltL : [RAlt] raltL' : [RAlt] @@ -168,8 +170,11 @@ child hd : CaseAlt child tl : CaseAlts visit 7: + local trppHere : _ local extraPP : _ alternative Nil: + visit 7: + local trppHere : _ -} sem_CaseAlts_Cons :: T_CaseAlt -> T_CaseAlts -> @@ -469,11 +474,11 @@ (case (_lhsImoduleNm) of { _hdOmoduleNm | _hdOmoduleNm `seq` (True) -> (case (hd_7 _hdOcSubst _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOfinTyVarMp _hdOfinValGam _hdOmoduleNm _hdOrangeMp _hdOsysfEnv _hdOtr) of - { ( _hdIallErrSq,_hdIcSubst,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTy,_hdIpp,_hdIralt,_hdIralt',_hdItrpp,_hdIty) | True -> + { ( _hdIallErrSq,_hdIcSubst,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTy,_hdIpp,_hdIppAST,_hdIralt,_hdIralt',_hdItrpp,_hdIty) | True -> (case (_hdIcSubst) of { _tlOcSubst | _tlOcSubst `seq` (True) -> (case (tl_7 _tlOcSubst _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOfinTyVarMp _tlOfinValGam _tlOmoduleNm _tlOrangeMp _tlOsysfEnv _tlOtr) of - { ( _tlIallErrSq,_tlIcSubst,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTy,_tlIpp,_tlIppL,_tlIraltL,_tlIraltL',_tlItrpp) | True -> + { ( _tlIallErrSq,_tlIcSubst,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTy,_tlIpp,_tlIppAST,_tlIppL,_tlIraltL,_tlIraltL',_tlItrpp) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_tlIcSubst) of @@ -488,17 +493,21 @@ { _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) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppL,_lhsOraltL,_lhsOraltL',_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["CaseAlts","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `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) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOraltL,_lhsOraltL',_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_CaseAlts_Cons_7)) of { ( sem_CaseAlts_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlts_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))) @@ -652,15 +661,19 @@ { _lhsOpatTy | _lhsOpatTy `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case ([]) of - { _lhsOraltL | _lhsOraltL `seq` (True) -> + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["CaseAlts","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> (case ([]) of - { _lhsOraltL' | _lhsOraltL' `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppL,_lhsOraltL,_lhsOraltL',_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }))))))))))) + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOraltL | _lhsOraltL `seq` (True) -> + (case ([]) of + { _lhsOraltL' | _lhsOraltL' `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTy,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOraltL,_lhsOraltL',_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_CaseAlts_Nil_7)) of { ( sem_CaseAlts_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOtyVarMp,sem_CaseAlts_7) }) }) }) }))))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataConstr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -125,13 +126,13 @@ synthesized attributes: fldSelGam : ValGam fldUpdGam : ValGam - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp visit 5: inherited attributes: chrEvidBindMp : EvidKeyToCBindMap chrScopeBindMp : PredScopeToCBindMap - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam clGam : ClGam finKiVarMp : VarMp @@ -158,6 +159,7 @@ gathMentrelFilterMp : ModEntRelFilterMp gathTvKiVarMp : VarMp pp : PP_Doc + ppAST : PP_Doc trpp : TrPP tyCBindL : CBindL valCBindL : CBindL @@ -230,6 +232,8 @@ visit 5: local dupErrs : _ local pp : _ + local trppHere : _ + local ppAST : _ intra range : {Range} intra dataConGadtFldTyL : _ intra mbGadtFO : _ @@ -513,7 +517,7 @@ (case (_lhsIclGam) of { _mbGadtTyExprOclGam | _mbGadtTyExprOclGam `seq` (True) -> (case (mbGadtTyExpr_4 _mbGadtTyExprOclGam _mbGadtTyExprOfinKiVarMp _mbGadtTyExprOfinTyKiGam _mbGadtTyExprOfinTyVarMp _mbGadtTyExprOkiGam _mbGadtTyExprOmoduleNm _mbGadtTyExprOopts _mbGadtTyExprOsysfEnv _mbGadtTyExprOtr _mbGadtTyExprOtyKiGlobFreeTvarS _mbGadtTyExprOtyTyGlobFreeTvarS _mbGadtTyExprOtyTyTySigFreeTvarS _mbGadtTyExprOvalTyGlobFreeTvarS) of - { ( _mbGadtTyExprIallErrSq,_mbGadtTyExprIclMissNmS,_mbGadtTyExprIclNmS,_mbGadtTyExprIerrSq,_mbGadtTyExprIgathMentrelFilterMp,_mbGadtTyExprIpp,_mbGadtTyExprIppMb,_mbGadtTyExprItrpp,_mbGadtTyExprItyGam,_mbGadtTyExprItyKiGam,_mbGadtTyExprItyVarWildMp) | True -> + { ( _mbGadtTyExprIallErrSq,_mbGadtTyExprIclMissNmS,_mbGadtTyExprIclNmS,_mbGadtTyExprIerrSq,_mbGadtTyExprIgathMentrelFilterMp,_mbGadtTyExprIpp,_mbGadtTyExprIppAST,_mbGadtTyExprIppMb,_mbGadtTyExprItrpp,_mbGadtTyExprItyGam,_mbGadtTyExprItyKiGam,_mbGadtTyExprItyVarWildMp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _fieldsOvalTyGlobFreeTvarS | _fieldsOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -559,7 +563,7 @@ (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 _fieldsOtr _fieldsOtvKiVarMp _fieldsOtyKiGlobFreeTvarS _fieldsOtyTyGlobFreeTvarS _fieldsOtyTyTySigFreeTvarS _fieldsOvalTyGlobFreeTvarS) of - { ( _fieldsIallErrSq,_fieldsIerrSq,_fieldsIgathMentrelFilterMp,_fieldsIgathTvKiVarMp,_fieldsIpatTyVarMp,_fieldsIpp,_fieldsIppL,_fieldsItrpp) | True -> + { ( _fieldsIallErrSq,_fieldsIerrSq,_fieldsIgathMentrelFilterMp,_fieldsIgathTvKiVarMp,_fieldsIpatTyVarMp,_fieldsIpp,_fieldsIppAST,_fieldsIppL,_fieldsItrpp) | True -> (case (_fieldsIallErrSq `Seq.union` _mbGadtTyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (let nms = assocLKeys $ gamToOnlyDups _fieldsIfldSelGam @@ -589,13 +593,22 @@ { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_fieldsItrpp >< _mbGadtTyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataConstr","Constr"] [ppTrNm conNm_] + [ _fieldsIppAST + , _mbGadtTyExprIppAST + ] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_fieldsItrpp >< _mbGadtTyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) in sem_DataConstr_Constr_5)) of { ( sem_DataConstr_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstr_5) }) }) }) }) }) }) }) }) }) }) }) }) })))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs b/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataConstrs.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -125,13 +126,13 @@ synthesized attributes: fldSelGam : ValGam fldUpdGam : ValGam - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp visit 5: inherited attributes: chrEvidBindMp : EvidKeyToCBindMap chrScopeBindMp : PredScopeToCBindMap - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam clGam : ClGam finKiVarMp : VarMp @@ -158,6 +159,7 @@ gathMentrelFilterMp : ModEntRelFilterMp gathTvKiVarMp : VarMp pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP tyCBindL : CBindL @@ -166,7 +168,11 @@ alternative Cons: child hd : DataConstr child tl : DataConstrs + visit 5: + local trppHere : _ alternative Nil: + visit 5: + local trppHere : _ -} sem_DataConstrs_Cons :: T_DataConstr -> T_DataConstrs -> @@ -410,7 +416,7 @@ (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 _tlOtr _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalGam _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpp,_tlIppL,_tlItrpp,_tlItyCBindL,_tlIvalCBindL) | True -> + { ( _tlIallErrSq,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpp,_tlIppAST,_tlIppL,_tlItrpp,_tlItyCBindL,_tlIvalCBindL) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsIvalGam) of @@ -454,7 +460,7 @@ (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 _hdOtr _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalGam _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpp,_hdItrpp,_hdItyCBindL,_hdIvalCBindL) | True -> + { ( _hdIallErrSq,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpp,_hdIppAST,_hdItrpp,_hdItyCBindL,_hdIvalCBindL) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIerrSq `Seq.union` _tlIerrSq) of @@ -469,15 +475,19 @@ { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> (case (_hdIpp >-< _tlIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_hdIpp : _tlIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataConstrs","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) in sem_DataConstrs_Cons_5)) of { ( sem_DataConstrs_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstrs_5) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))) @@ -625,15 +635,19 @@ { _lhsOgathTvKiVarMp | _lhsOgathTvKiVarMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataConstrs","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> (case ([]) of - { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyCBindL | _lhsOtyCBindL `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOffeCBindL,_lhsOffiCBindL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))))))))))) in sem_DataConstrs_Nil_5)) of { ( sem_DataConstrs_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOpatTyVarMp,_lhsOpatValGam,sem_DataConstrs_5) }) }) }) }) }) }) })))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataField.hs b/src/UHC/Light/Compiler/EH/MainAG_DataField.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataField.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataField.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -114,14 +115,14 @@ synthesized attributes: fldSelGam : ValGam fldUpdGam : ValGam - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp kiL : TyL visit 5: inherited attributes: chrEvidBindMp : EvidKeyToCBindMap chrScopeBindMp : PredScopeToCBindMap - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam clGam : ClGam finKiVarMp : VarMp @@ -148,6 +149,7 @@ gathMentrelFilterMp : ModEntRelFilterMp gathTvKiVarMp : VarMp pp : PP_Doc + ppAST : PP_Doc trpp : TrPP alternatives: alternative Field: @@ -167,6 +169,9 @@ local fldUpdGam : _ intra fldTyL : {FldTyL} intra nrFieldsForLabel : {Int} + visit 5: + local trppHere : _ + local ppAST : _ -} sem_DataField_Field :: Range -> (Maybe [HsName]) -> @@ -347,7 +352,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_tyExprIerrSq) of @@ -362,9 +367,15 @@ Just l -> ppCommas' l >#< "::" >#< _tyExprIpp Nothing -> _tyExprIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataField","Field"] [pp (maybe [] (map ppTrNm) mbLabels_)] [_tyExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))))) in sem_DataField_Field_5)) of { ( sem_DataField_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataField_5) }) }) }) }) }) }) }) }) }) }) })))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFieldExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -121,10 +122,10 @@ inherited attribute: dataGam : DataGam synthesized attribute: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam fiOpts : FIOpts tvKiVarMp : VarMp @@ -144,7 +145,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp noLetQuantTyVarIdS : TyVarIdS ty : Ty @@ -171,6 +172,7 @@ gathTvKiVarMp : VarMp mbDti : Maybe DataTagInfo pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP alternatives: @@ -218,6 +220,8 @@ local pp : _ local gTy : {Ty} local gathMentrelFilterMp : _ + local trppHere : _ + local ppAST : _ intra fe : {FIEnv} intra lUniq : {UID} intra _tup13 : _ @@ -261,6 +265,8 @@ local nmErrs : {ErrL} local pp : _ local gathMentrelFilterMp : _ + local trppHere : _ + local ppAST : _ intra _tup15 : _ intra fo_ : {FIOut} intra range : {Range} @@ -290,6 +296,8 @@ local dfeCExpr : _ local fuCExprL : _ local pp : _ + local trppHere : _ + local ppAST : _ -} sem_DataFieldExpr_Upd :: Range -> T_DataFieldExpr -> @@ -636,13 +644,13 @@ (case (_lhsIdgi) of { _dataFieldExprOdgi | _dataFieldExprOdgi `seq` (True) -> (case (dataFieldExpr_8 _dataFieldExprOcSubst _dataFieldExprOchrEvidBindMp _dataFieldExprOchrScopeBindMp _dataFieldExprOdgi _dataFieldExprOfinTyVarMp _dataFieldExprOfinValGam _dataFieldExprOmoduleNm _dataFieldExprOrangeMp _dataFieldExprOsysfEnv _dataFieldExprOtr) of - { ( _dataFieldExprIallErrSq,_dataFieldExprIcSubst,_dataFieldExprIdfeCBindL,_dataFieldExprIdfeCExpr,_dataFieldExprIerrSq,_dataFieldExprIfuCExprL,_dataFieldExprIgathMentrelFilterMp,_dataFieldExprIgathTvKiVarMp,_dataFieldExprImbDti,_dataFieldExprIpp,_dataFieldExprIppL,_dataFieldExprItrpp) | True -> + { ( _dataFieldExprIallErrSq,_dataFieldExprIcSubst,_dataFieldExprIdfeCBindL,_dataFieldExprIdfeCExpr,_dataFieldExprIerrSq,_dataFieldExprIfuCExprL,_dataFieldExprIgathMentrelFilterMp,_dataFieldExprIgathTvKiVarMp,_dataFieldExprImbDti,_dataFieldExprIpp,_dataFieldExprIppAST,_dataFieldExprIppL,_dataFieldExprItrpp) | 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 _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_dataFieldExprIallErrSq `Seq.union` _exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -686,11 +694,17 @@ { _lhsOmbDti | _lhsOmbDti `seq` (True) -> (case (_dataFieldExprIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pp : _dataFieldExprIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_dataFieldExprItrpp >< _exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFieldExpr","Upd"] [ppTrNm nm_] [_dataFieldExprIppAST,_exprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pp : _dataFieldExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_dataFieldExprItrpp >< _exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) in sem_DataFieldExpr_Upd_8)) of { ( sem_DataFieldExpr_8) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))) @@ -906,11 +920,17 @@ { _lhsOmbDti | _lhsOmbDti `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFieldExpr","Con"] [ppTrNm nm_] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) in sem_DataFieldExpr_Con_8)) of { ( sem_DataFieldExpr_8) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }))))) @@ -1172,7 +1192,7 @@ (case (ExprCtxt_Top) of { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -1201,11 +1221,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFieldExpr","Expr"] [] [_exprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdfeCBindL,_lhsOdfeCExpr,_lhsOerrSq,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOmbDti,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))) in sem_DataFieldExpr_Expr_8)) of { ( sem_DataFieldExpr_8) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOty,_lhsOtyVarMp,sem_DataFieldExpr_8) }) }) }) }) }) }) }))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFieldPatExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,7 +118,7 @@ finTyKiGam : TyKiGam tyTyTySigFreeTvarS : TyVarIdS synthesized attribute: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) visit 5: inherited attributes: fiOpts : FIOpts @@ -128,7 +129,7 @@ valGam : ValGam visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam tvKiVarMp : VarMp tyTyGlobFreeTvarS : TyVarIdS @@ -136,7 +137,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp scopeGam : ScopeGam ty : Ty @@ -164,6 +165,7 @@ gathTvKiVarMp : VarMp patCRest : CPatRest pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP valCBindL : CBindL @@ -208,6 +210,8 @@ local pp : _ local ioffset : _ local gathMentrelFilterMp : _ + local trppHere : _ + local ppAST : _ intra _tup18 : _ intra fo_ : {FIOut} intra range : {Range} @@ -252,6 +256,8 @@ local nmErrs : {ErrL} local pp : _ local gathMentrelFilterMp : _ + local trppHere : _ + local ppAST : _ intra _tup20 : _ intra fo_ : {FIOut} intra range : {Range} @@ -611,11 +617,11 @@ (case (_lhsIceParentNm) of { _dataFieldPatExprOceParentNm | _dataFieldPatExprOceParentNm `seq` (True) -> (case (dataFieldPatExpr_7 _dataFieldPatExprOcSubst _dataFieldPatExprOceParentNm _dataFieldPatExprOchrEvidBindMp _dataFieldPatExprOchrScopeBindMp _dataFieldPatExprOfinTyVarMp _dataFieldPatExprOfinValGam _dataFieldPatExprOmoduleNm _dataFieldPatExprOrangeMp _dataFieldPatExprOsysfEnv _dataFieldPatExprOtr _dataFieldPatExprOtySigVarMp) of - { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppL,_dataFieldPatExprItrpp,_dataFieldPatExprIvalCBindL) | True -> + { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppAST,_dataFieldPatExprIppL,_dataFieldPatExprItrpp,_dataFieldPatExprIvalCBindL) | True -> (case (_dataFieldPatExprIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_dataFieldPatExprIallErrSq `Seq.union` _patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_patExprIcSubst) of @@ -648,13 +654,19 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_dataFieldPatExprIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pp : _dataFieldPatExprIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_dataFieldPatExprItrpp >< _patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_dataFieldPatExprIvalCBindL ++ _patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFieldPatExpr","Ext"] [ppTrNm nm_] [_dataFieldPatExprIppAST,_patExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pp : _dataFieldPatExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_dataFieldPatExprItrpp >< _patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_dataFieldPatExprIvalCBindL ++ _patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_DataFieldPatExpr_Ext_7)) of { ( sem_DataFieldPatExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_DataFieldPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -869,13 +881,19 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFieldPatExpr","Con"] [ppTrNm nm_] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOdti,_lhsOerrSq,_lhsOfldL,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_DataFieldPatExpr_Con_7)) of { ( sem_DataFieldPatExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_DataFieldPatExpr_7) }) }) }) }) }) }) })))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs b/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs --- a/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_DataFields.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -114,14 +115,14 @@ synthesized attributes: fldSelGam : ValGam fldUpdGam : ValGam - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp kiL : TyL visit 5: inherited attributes: chrEvidBindMp : EvidKeyToCBindMap chrScopeBindMp : PredScopeToCBindMap - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam clGam : ClGam finKiVarMp : VarMp @@ -148,13 +149,18 @@ gathMentrelFilterMp : ModEntRelFilterMp gathTvKiVarMp : VarMp pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP alternatives: alternative Cons: child hd : DataField child tl : DataFields + visit 5: + local trppHere : _ alternative Nil: + visit 5: + local trppHere : _ -} sem_DataFields_Cons :: T_DataField -> T_DataFields -> @@ -374,7 +380,7 @@ (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 _hdOtr _hdOtvKiVarMp _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTyVarMp,_hdIpp,_hdItrpp) | True -> + { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIpatTyVarMp,_hdIpp,_hdIppAST,_hdItrpp) | True -> (case (_hdIpatTyVarMp) of { _tlOpatTyVarMp | _tlOpatTyVarMp `seq` (True) -> (case (_lhsIopts) of @@ -402,7 +408,7 @@ (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 _tlOtr _tlOtvKiVarMp _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTyVarMp,_tlIpp,_tlIppL,_tlItrpp) | True -> + { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIpatTyVarMp,_tlIpp,_tlIppAST,_tlIppL,_tlItrpp) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIerrSq `Seq.union` _tlIerrSq) of @@ -415,11 +421,15 @@ { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> (case (_hdIpp >-< _tlIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_hdIpp : _tlIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFields","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))))) in sem_DataFields_Cons_5)) of { ( sem_DataFields_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataFields_5) }) }) }) }) }) }) }) }) }) }) }) }) })))) @@ -549,11 +559,15 @@ { _lhsOpatTyVarMp | _lhsOpatTyVarMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) })))))))))))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["DataFields","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatTyVarMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))))) in sem_DataFields_Nil_5)) of { ( sem_DataFields_5) | True -> ( _lhsOfldSelGam,_lhsOfldUpdGam,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOkiL,_lhsOkiVarMp,sem_DataFields_5) }) }) }) }) }) }) })))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_Decl.hs b/src/UHC/Light/Compiler/EH/MainAG_Decl.hs # 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 --- a/src/UHC/Light/Compiler/EH/MainAG_Decls.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_Decls.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -157,8 +158,8 @@ inherited attribute: dataGam : DataGam synthesized attributes: - chrClassDeclSq : Seq.FastSeq (CHRClassDecl Pred RedHowAnnotation) - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrClassDeclSq : Seq.FastSeq (CHRClassDecl) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) gathClDfGam : ClassDefaultGam visit 12: inherited attributes: @@ -170,7 +171,7 @@ patValGam : ValGam visit 13: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam tyTyGlobFreeTvarS : TyVarIdS valGam : ValGam @@ -178,7 +179,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp intlTyKiGam : TyKiGam noLetQuantTyVarIdS : TyVarIdS @@ -209,6 +210,7 @@ gathTvKiVarMp : VarMp orphanS : Set.Set HsName pp : PP_Doc + ppAST : PP_Doc trpp : TrPP tyCBindL : CBindL valCBindL : CBindL @@ -218,7 +220,10 @@ child tl : Decls visit 14: local errPP : _ + local trppHere : _ alternative Nil: + visit 14: + local trppHere : _ -} sem_Decls_Cons :: T_Decl -> T_Decls -> @@ -678,11 +683,11 @@ (case (_lhsIisStrict) of { _hdOisStrict | _hdOisStrict `seq` (True) -> (case (hd_14 _hdOcSubst _hdOchrEvidBindMp _hdOchrScopeBindMp _hdOfinTyVarMp _hdOfinValGam _hdOisStrict _hdOkiSigGam _hdOmoduleNm _hdOrangeMp _hdOsysfEnv _hdOtr) of - { ( _hdIallErrSq,_hdIbangEvalL,_hdIcSubst,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathHiddenExports,_hdIgathLamMp,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIorphanS,_hdIpp,_hdItrpp,_hdItyCBindL,_hdIvalCBindL) | True -> + { ( _hdIallErrSq,_hdIbangEvalL,_hdIcSubst,_hdIerrSq,_hdIffeCBindL,_hdIffiCBindL,_hdIgathHiddenExports,_hdIgathLamMp,_hdIgathMentrelFilterMp,_hdIgathTvKiVarMp,_hdIorphanS,_hdIpp,_hdIppAST,_hdItrpp,_hdItyCBindL,_hdIvalCBindL) | True -> (case (_hdIcSubst) of { _tlOcSubst | _tlOcSubst `seq` (True) -> (case (tl_14 _tlOcSubst _tlOchrEvidBindMp _tlOchrScopeBindMp _tlOfinTyVarMp _tlOfinValGam _tlOisStrict _tlOkiSigGam _tlOmoduleNm _tlOrangeMp _tlOsysfEnv _tlOtr) of - { ( _tlIallErrSq,_tlIbangEvalL,_tlIcSubst,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathHiddenExports,_tlIgathLamMp,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIorphanS,_tlIpp,_tlItrpp,_tlItyCBindL,_tlIvalCBindL) | True -> + { ( _tlIallErrSq,_tlIbangEvalL,_tlIcSubst,_tlIerrSq,_tlIffeCBindL,_tlIffiCBindL,_tlIgathHiddenExports,_tlIgathLamMp,_tlIgathMentrelFilterMp,_tlIgathTvKiVarMp,_tlIorphanS,_tlIpp,_tlIppAST,_tlItrpp,_tlItyCBindL,_tlIvalCBindL) | True -> (case (Seq.unions [_hdIerrSq, _hdIallErrSq, _tlIallErrSq]) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIbangEvalL ++ _tlIbangEvalL) of @@ -711,13 +716,17 @@ >-< _errPP >-< _tlIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["Decls","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_Decls_Cons_14)) of { ( sem_Decls_14) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOintlTyKiGam,_lhsOnoLetQuantTyVarIdS,_lhsOscopeGam,_lhsOtyVarMp,sem_Decls_14) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -983,12 +992,16 @@ (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["Decls","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOtrpp,_lhsOtyCBindL,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_Decls_Nil_14)) of { ( sem_Decls_14) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOintlTyKiGam,_lhsOnoLetQuantTyVarIdS,_lhsOscopeGam,_lhsOtyVarMp,sem_Decls_14) }) }) }) }) }) }) })))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_Expr.hs b/src/UHC/Light/Compiler/EH/MainAG_Expr.hs # 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 --- a/src/UHC/Light/Compiler/EH/MainAG_ExprAnn.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_ExprAnn.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam diff --git a/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs b/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs --- a/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_FuncDep.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -114,6 +115,7 @@ funcDeps : [ClsFuncDep] gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc range : Range trpp : TrPP alternatives: @@ -122,6 +124,8 @@ child fromTvs : TyVars child toTvs : TyVars visit 3: + local trppHere : _ + local ppAST : _ local range : {Range} -} sem_FuncDep_Dep :: Range -> @@ -223,7 +227,7 @@ (case (_lhsIfinKiVarMp) of { _toTvsOfinKiVarMp | _toTvsOfinKiVarMp `seq` (True) -> (case (toTvs_4 _toTvsOfinKiVarMp _toTvsOfinTyKiGam _toTvsOfinTyVarMp _toTvsOmoduleNm _toTvsOopts _toTvsOsysfEnv _toTvsOtr _toTvsOtyKiGlobFreeTvarS _toTvsOtyTyGlobFreeTvarS _toTvsOtyTyTySigFreeTvarS _toTvsOvalTyGlobFreeTvarS) of - { ( _toTvsIallErrSq,_toTvsIerrSq,_toTvsIgathMentrelFilterMp,_toTvsInmL,_toTvsIpp,_toTvsIppL,_toTvsItrpp) | True -> + { ( _toTvsIallErrSq,_toTvsIerrSq,_toTvsIgathMentrelFilterMp,_toTvsInmL,_toTvsIpp,_toTvsIppAST,_toTvsIppL,_toTvsItrpp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _fromTvsOvalTyGlobFreeTvarS | _fromTvsOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -247,7 +251,7 @@ (case (_lhsIfinKiVarMp) of { _fromTvsOfinKiVarMp | _fromTvsOfinKiVarMp `seq` (True) -> (case (fromTvs_4 _fromTvsOfinKiVarMp _fromTvsOfinTyKiGam _fromTvsOfinTyVarMp _fromTvsOmoduleNm _fromTvsOopts _fromTvsOsysfEnv _fromTvsOtr _fromTvsOtyKiGlobFreeTvarS _fromTvsOtyTyGlobFreeTvarS _fromTvsOtyTyTySigFreeTvarS _fromTvsOvalTyGlobFreeTvarS) of - { ( _fromTvsIallErrSq,_fromTvsIerrSq,_fromTvsIgathMentrelFilterMp,_fromTvsInmL,_fromTvsIpp,_fromTvsIppL,_fromTvsItrpp) | True -> + { ( _fromTvsIallErrSq,_fromTvsIerrSq,_fromTvsIgathMentrelFilterMp,_fromTvsInmL,_fromTvsIpp,_fromTvsIppAST,_fromTvsIppL,_fromTvsItrpp) | True -> (case (_fromTvsIallErrSq `Seq.union` _toTvsIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_fromTvsIerrSq `Seq.union` _toTvsIerrSq) of @@ -259,13 +263,19 @@ { _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) -> - (case (_fromTvsItrpp >< _toTvsItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["FuncDep","Dep"] [] [_fromTvsIppAST,_toTvsIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (rangeUnions [hsrange_, _fromTvsIrange, _toTvsIrange ]) of + { _range | _range `seq` (True) -> + (case (_range) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (_fromTvsItrpp >< _toTvsItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_FuncDep_Dep_3)) of { ( sem_FuncDep_3) | True -> ( _lhsOtyKiGam,sem_FuncDep_3) }) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs b/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs --- a/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_FuncDeps.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -114,6 +115,7 @@ funcDeps : [ClsFuncDep] gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] range : Range trpp : TrPP @@ -121,7 +123,11 @@ alternative Cons: child hd : FuncDep child tl : FuncDeps + visit 3: + local trppHere : _ alternative Nil: + visit 3: + local trppHere : _ -} sem_FuncDeps_Cons :: T_FuncDep -> T_FuncDeps -> @@ -219,7 +225,7 @@ (case (_lhsIclsTyArgs) of { _tlOclsTyArgs | _tlOclsTyArgs `seq` (True) -> (case (tl_3 _tlOclsTyArgs _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtr _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIerrSq,_tlIfuncDeps,_tlIgathMentrelFilterMp,_tlIpp,_tlIppL,_tlIrange,_tlItrpp) | True -> + { ( _tlIallErrSq,_tlIerrSq,_tlIfuncDeps,_tlIgathMentrelFilterMp,_tlIpp,_tlIppAST,_tlIppL,_tlIrange,_tlItrpp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -245,7 +251,7 @@ (case (_lhsIclsTyArgs) of { _hdOclsTyArgs | _hdOclsTyArgs `seq` (True) -> (case (hd_3 _hdOclsTyArgs _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtr _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIerrSq,_hdIfuncDeps,_hdIgathMentrelFilterMp,_hdIpp,_hdIrange,_hdItrpp) | True -> + { ( _hdIallErrSq,_hdIerrSq,_hdIfuncDeps,_hdIgathMentrelFilterMp,_hdIpp,_hdIppAST,_hdIrange,_hdItrpp) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIerrSq `Seq.union` _tlIerrSq) of @@ -256,13 +262,17 @@ { _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) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["FuncDeps","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdIrange `rangeUnion` _tlIrange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_FuncDeps_Cons_3)) of { ( sem_FuncDeps_3) | True -> ( _lhsOtyKiGam,sem_FuncDeps_3) }) }) }) }) }) }))) @@ -328,13 +338,17 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (emptyRange) of - { _lhsOrange | _lhsOrange `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["FuncDeps","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOfuncDeps,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOrange,_lhsOtrpp) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_FuncDeps_Nil_3)) of { ( sem_FuncDeps_3) | True -> ( _lhsOtyKiGam,sem_FuncDeps_3) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_KiExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,6 +118,7 @@ errSq : ErrSq gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc trpp : TrPP alternatives: alternative Con: @@ -251,9 +253,11 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (empty) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_Con_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) @@ -339,9 +343,11 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }))))))))))))) + (case (empty) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_Var_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }) }))) @@ -443,7 +449,7 @@ (case (_lhsIfinKiVarMp) of { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> (case (arg_3 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOmoduleNm _argOopts _argOsysfEnv _argOtr _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of - { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argItrpp) | True -> + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argIppAST,_argItrpp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _funcOvalTyGlobFreeTvarS | _funcOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -467,7 +473,7 @@ (case (_lhsIfinKiVarMp) of { _funcOfinKiVarMp | _funcOfinKiVarMp `seq` (True) -> (case (func_3 _funcOfinKiVarMp _funcOfinTyKiGam _funcOfinTyVarMp _funcOmoduleNm _funcOopts _funcOsysfEnv _funcOtr _funcOtyKiGlobFreeTvarS _funcOtyTyGlobFreeTvarS _funcOtyTyTySigFreeTvarS _funcOvalTyGlobFreeTvarS) of - { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp,_funcItrpp) | True -> + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp,_funcIppAST,_funcItrpp) | True -> (case (_funcIallErrSq `Seq.union` _argIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_funcIappArgPPL ++ [_argIpp]) of @@ -484,9 +490,11 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_funcItrpp >< _argItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_funcIppAST >-< _argIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_funcItrpp >< _argItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_App_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }) }) }))) @@ -577,7 +585,7 @@ (case (_lhsIfinKiVarMp) of { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtr _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of - { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprItrpp) | True -> + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprIppAST,_kiExprItrpp) | True -> (case (_kiExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -595,9 +603,11 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_kiExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_kiExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_kiExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_AppTop_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) @@ -688,7 +698,7 @@ (case (_lhsIfinKiVarMp) of { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtr _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of - { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprItrpp) | True -> + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprIppAST,_kiExprItrpp) | True -> (case (_kiExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -705,9 +715,11 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_kiExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_kiExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_kiExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_Parens_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) @@ -799,7 +811,7 @@ (case (_lhsIfinKiVarMp) of { _kiExprOfinKiVarMp | _kiExprOfinKiVarMp `seq` (True) -> (case (kiExpr_3 _kiExprOfinKiVarMp _kiExprOfinTyKiGam _kiExprOfinTyVarMp _kiExprOmoduleNm _kiExprOopts _kiExprOsysfEnv _kiExprOtr _kiExprOtyKiGlobFreeTvarS _kiExprOtyTyGlobFreeTvarS _kiExprOtyTyTySigFreeTvarS _kiExprOvalTyGlobFreeTvarS) of - { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprItrpp) | True -> + { ( _kiExprIallErrSq,_kiExprIappArgPPL,_kiExprIappFunNm,_kiExprIappFunPP,_kiExprIerrSq,_kiExprIgathMentrelFilterMp,_kiExprIpp,_kiExprIppAST,_kiExprItrpp) | True -> (case (_kiExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -816,9 +828,11 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_kiExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_kiExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_kiExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_KiExpr_Ann_3)) of { ( sem_KiExpr_3) | True -> ( _lhsOki,_lhsOkiGam,sem_KiExpr_3) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs --- a/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_KiExprAnn.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam diff --git a/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_MbTyExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -129,6 +130,7 @@ errSq : ErrSq gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc ppMb : Maybe PP_Doc trpp : TrPP tyGam : TyGam @@ -137,7 +139,13 @@ alternatives: alternative Just: child just : TyExpr + visit 4: + local trppHere : _ + local ppAST : _ alternative Nothing: + visit 4: + local trppHere : _ + local ppAST : _ -} sem_MbTyExpr_Just :: T_TyExpr -> T_MbTyExpr @@ -260,7 +268,7 @@ (case (_lhsIfinKiVarMp) of { _justOfinKiVarMp | _justOfinKiVarMp `seq` (True) -> (case (just_8 _justOfinKiVarMp _justOfinTyKiGam _justOfinTyVarMp _justOkiGam _justOmoduleNm _justOopts _justOsysfEnv _justOtr _justOtyKiGlobFreeTvarS _justOtyTyGlobFreeTvarS _justOtyTyTySigFreeTvarS _justOvalTyGlobFreeTvarS) of - { ( _justIallErrSq,_justIappArgPPL,_justIappFunNm,_justIappFunPP,_justIclMissNmS,_justIclNmS,_justIerrSq,_justIgathMentrelFilterMp,_justIpp,_justItrpp,_justItyWildL) | True -> + { ( _justIallErrSq,_justIappArgPPL,_justIappFunNm,_justIappFunPP,_justIclMissNmS,_justIclNmS,_justIerrSq,_justIgathMentrelFilterMp,_justIpp,_justIppAST,_justItrpp,_justItyWildL) | True -> (case (_justIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_justIclMissNmS) of @@ -273,17 +281,23 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_justIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (Just _justIpp) of - { _lhsOppMb | _lhsOppMb `seq` (True) -> - (case (_justItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["MbTyExpr","Just"] [] [_justIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (Just _justIpp) of + { _lhsOppMb | _lhsOppMb `seq` (True) -> + (case (_justItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppMb,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) in sem_MbTyExpr_Just_4)) of { ( sem_MbTyExpr_4) | True -> ( _lhsOintlTyKiGam,_lhsOkiVarMp,sem_MbTyExpr_4) }) }) }) }) }) }) })))) @@ -372,17 +386,23 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (Nothing) of - { _lhsOppMb | _lhsOppMb `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["MbTyExpr","Nothing"] [] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (Nothing) of + { _lhsOppMb | _lhsOppMb `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppMb,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) in sem_MbTyExpr_Nothing_4)) of { ( sem_MbTyExpr_4) | True -> ( _lhsOintlTyKiGam,_lhsOkiVarMp,sem_MbTyExpr_4) }) }) })))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_PatExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -117,7 +118,7 @@ finTyKiGam : TyKiGam tyTyTySigFreeTvarS : TyVarIdS synthesized attributes: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) topNm : HsName visit 5: inherited attribute: @@ -139,7 +140,7 @@ valGam : ValGam visit 7: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam tvKiVarMp : VarMp tyTyGlobFreeTvarS : TyVarIdS @@ -148,7 +149,7 @@ tyVarMp : VarMp synthesized attributes: cpNm : RPatNm - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp scopeGam : ScopeGam ty : Ty @@ -178,6 +179,7 @@ isBang : Bool patCRest : CPatRest pp : PP_Doc + ppAST : PP_Doc rpat : RPat trpp : TrPP valCBindL : CBindL @@ -217,6 +219,7 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ local finalTy : _ local fe : {FIEnv} local finalTyExpanded : _ @@ -261,6 +264,7 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ local finalTy : _ local fe : {FIEnv} local finalTyExpanded : _ @@ -331,15 +335,16 @@ intra fo_fitP_ : {FIOut} intra range : {Range} intra ty_g_ : {Ty} + intra patFunTy : {Ty} intra tvarv1_ : {Ty} intra fe : {FIEnv} - intra patFunTy : {Ty} visit 8: local appFunNm : _ local pp : _ local nmErrs : {ErrL} local fsRPatL : _ local gathMentrelFilterMp : _ + local trppHere : _ local knPatTy : {Ty} local finalTy : _ local finalTyExpanded : _ @@ -357,11 +362,11 @@ intra fo_fitP_ : {FIOut} intra range : {Range} intra ty_g_ : {Ty} + intra patFunTy : {Ty} intra tvarv1_ : {Ty} intra ty : {Ty} intra fe : {FIEnv} intra cpNm : {RPatNm} - intra patFunTy : {Ty} alternative Var: child hsrange : {Range} child nm : {HsName} @@ -417,6 +422,7 @@ intra fe : {FIEnv} visit 8: local pp : _ + local trppHere : _ local finalTy : _ local finalTyExpanded : _ local sysfty : _ @@ -477,6 +483,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ local rpat : _ intra cpNm : {RPatNm} alternative App: @@ -498,6 +505,7 @@ visit 8: local _tup187 : _ local pp : _ + local trppHere : _ alternative AppTop: child hsrange : {Range} child patExpr : PatExpr @@ -550,6 +558,7 @@ visit 8: local pp : _ local arityErrs : {ErrL} + local trppHere : _ local appFunNm : _ local finalTy : _ local finalTyExpanded : _ @@ -585,6 +594,7 @@ local mbTopNm : {Maybe HsName} visit 8: local pp : _ + local trppHere : _ alternative Ann: child hsrange : {Range} child ann : PatExprAnn @@ -631,6 +641,7 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ intra fo_ : {FIOut} intra range : {Range} alternative SConst: @@ -674,6 +685,7 @@ intra fe : {FIEnv} visit 8: local pp : _ + local trppHere : _ local finalTy : _ local finalTyExpanded : _ local sysfty : _ @@ -719,6 +731,8 @@ local appFunNm : _ local pp : _ local fsRPatL : _ + local trppHere : _ + local ppAST : _ local finalTy : _ local fe : {FIEnv} local finalTyExpanded : _ @@ -769,6 +783,8 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ local finalTy : _ local fe : {FIEnv} local finalTyExpanded : _ @@ -1103,31 +1119,35 @@ { _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 (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","IConst"] [_pp] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_IConst_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) @@ -1340,31 +1360,35 @@ { _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 (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","CConst"] [_pp] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_CConst_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) @@ -1621,39 +1645,43 @@ { _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 (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm ++ (showPP $ ppParens _finKnPatTy)) emptyDataGamInfo - $ dataGamLookup _tyConNm $ _lhsIdataGam) of - { _dgi | _dgi `seq` (True) -> - (case (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) emptyDataTagInfo - $ 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 ((_lhsItr TraceOn_EhValGam $ ["PatExpr.Con" >#< hsnUn nm_] ++ [ "ty_g_=" >#< ppTy _ty_g_, "@lhs.patTyVarMp |=> ty_g_=" >#< ppTy (_lhsIpatTyVarMp `varUpd` _ty_g_), "patFunTy=" >#< ppTy _patFunTy ])) of - { _trpp | _trpp `seq` (True) -> - (case (_trpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case ((_lhsItr TraceOn_EhValGam $ ["PatExpr.Con" >#< hsnUn nm_] ++ [ "ty_g_=" >#< ppTy _ty_g_, "@lhs.patTyVarMp |=> ty_g_=" >#< ppTy (_lhsIpatTyVarMp `varUpd` _ty_g_), "patFunTy=" >#< ppTy _patFunTy ])) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","Con"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm ++ (showPP $ ppParens _finKnPatTy)) emptyDataGamInfo + $ dataGamLookup _tyConNm $ _lhsIdataGam) of + { _dgi | _dgi `seq` (True) -> + (case (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) emptyDataTagInfo + $ 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 (_trppHere) of + { _trpp | _trpp `seq` (True) -> + (case (_trpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Con_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) })))))))) @@ -1905,23 +1933,27 @@ { _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 (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","Var"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Var_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) })))))))) @@ -2244,7 +2276,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -2271,15 +2303,19 @@ { _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 (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","VarAs"] [ppTrNm nm_] [_patExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_patExprIrpat {rcpPNm = _cpNm}) of + { _rpat | _rpat `seq` (True) -> + (case (_rpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_VarAs_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -2664,13 +2700,13 @@ (case (_lhsIceParentNm) of { _funcOceParentNm | _funcOceParentNm `seq` (True) -> (case (func_8 _funcOcSubst _funcOceParentNm _funcOchrEvidBindMp _funcOchrScopeBindMp _funcOfinTyVarMp _funcOfinValGam _funcOmoduleNm _funcOrangeMp _funcOsysfEnv _funcOtr _funcOtySigVarMp) of - { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIcSubst,_funcIerrSq,_funcIfsRPatL,_funcIgathMentrelFilterMp,_funcIgathTvKiVarMp,_funcIisBang,_funcIpatCRest,_funcIpp,_funcIrpat,_funcItrpp,_funcIvalCBindL) | True -> + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIcSubst,_funcIerrSq,_funcIfsRPatL,_funcIgathMentrelFilterMp,_funcIgathTvKiVarMp,_funcIisBang,_funcIpatCRest,_funcIpp,_funcIppAST,_funcIrpat,_funcItrpp,_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 _argOtr _argOtySigVarMp) of - { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIcSubst,_argIerrSq,_argIfsRPatL,_argIgathMentrelFilterMp,_argIgathTvKiVarMp,_argIisBang,_argIpatCRest,_argIpp,_argIrpat,_argItrpp,_argIvalCBindL) | True -> + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIcSubst,_argIerrSq,_argIfsRPatL,_argIgathMentrelFilterMp,_argIgathTvKiVarMp,_argIisBang,_argIpatCRest,_argIpp,_argIppAST,_argIrpat,_argItrpp,_argIvalCBindL) | True -> (case (_funcIallErrSq `Seq.union` _argIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (mkExtAppPP (_funcIappFunNm,_funcIappFunPP,_funcIappArgPPL) @@ -2700,13 +2736,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_argIrpat) of - { _lhsOrpat | _lhsOrpat `seq` (True) -> - (case (_funcItrpp >< _argItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_funcIvalCBindL ++ _argIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","App"] [] [_funcIppAST,_argIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_argIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_funcItrpp >< _argItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_funcIvalCBindL ++ _argIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_App_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -3024,7 +3064,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -3054,49 +3094,53 @@ { _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 (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm ++ (showPP $ ppParens _finKnPatTy)) emptyDataGamInfo - $ dataGamLookup _tyConNm $ _lhsIdataGam) of - { _dgi | _dgi `seq` (True) -> - (case (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) emptyDataTagInfo - $ 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 (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","AppTop"] [] [_patExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dgi: " ++ show _tyConNm ++ (showPP $ ppParens _finKnPatTy)) emptyDataGamInfo + $ dataGamLookup _tyConNm $ _lhsIdataGam) of + { _dgi | _dgi `seq` (True) -> + (case (ehcOptFromJust _lhsIopts ("PatExpr.{AppTop,Con}.dti: " ++ show _tyConNm ++ "." ++ show _appFunNm) emptyDataTagInfo + $ 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 (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_AppTop_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -3377,7 +3421,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -3404,13 +3448,17 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_patExprIrpat) of - { _lhsOrpat | _lhsOrpat `seq` (True) -> - (case (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","Parens"] [] [_patExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Parens_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -3692,7 +3740,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -3719,13 +3767,15 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_patExprIrpat) of - { _lhsOrpat | _lhsOrpat `seq` (True) -> - (case (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_patExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Ann_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -4049,7 +4099,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_lhsIclGam) of { _tyExprOclGam | _tyExprOclGam `seq` (True) -> (case (tyExpr_7 _tyExprOclGam) of @@ -4079,7 +4129,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq `Seq.union` _patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -4108,13 +4158,17 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_patExprIrpat) of - { _lhsOrpat | _lhsOrpat `seq` (True) -> - (case (_tyExprItrpp >< _patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","TypeAs"] [] [_patExprIppAST,_tyExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_patExprIrpat) of + { _lhsOrpat | _lhsOrpat `seq` (True) -> + (case (_tyExprItrpp >< _patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_TypeAs_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -4339,23 +4393,27 @@ { _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 (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","SConst"] [_pp] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `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 (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_SConst_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) })))))))) @@ -4643,7 +4701,7 @@ (case (_lhsIcSubst) of { _recPatExprOcSubst | _recPatExprOcSubst `seq` (True) -> (case (recPatExpr_7 _recPatExprOcSubst _recPatExprOceParentNm _recPatExprOchrEvidBindMp _recPatExprOchrScopeBindMp _recPatExprOfinTyVarMp _recPatExprOfinValGam _recPatExprOmoduleNm _recPatExprOrangeMp _recPatExprOsysfEnv _recPatExprOtr _recPatExprOtySigVarMp) of - { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppL,_recPatExprItrpp,_recPatExprIvalCBindL) | True -> + { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppAST,_recPatExprIppL,_recPatExprItrpp,_recPatExprIvalCBindL) | True -> (case (_recPatExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (reverse _recPatExprIppL) of @@ -4675,48 +4733,54 @@ { _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 (_recPatExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","Rec"] [] [_recPatExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `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 (_recPatExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Rec_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -5000,7 +5064,7 @@ (case (_lhsIcSubst) of { _dataFieldPatExprOcSubst | _dataFieldPatExprOcSubst `seq` (True) -> (case (dataFieldPatExpr_7 _dataFieldPatExprOcSubst _dataFieldPatExprOceParentNm _dataFieldPatExprOchrEvidBindMp _dataFieldPatExprOchrScopeBindMp _dataFieldPatExprOfinTyVarMp _dataFieldPatExprOfinValGam _dataFieldPatExprOmoduleNm _dataFieldPatExprOrangeMp _dataFieldPatExprOsysfEnv _dataFieldPatExprOtr _dataFieldPatExprOtySigVarMp) of - { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppL,_dataFieldPatExprItrpp,_dataFieldPatExprIvalCBindL) | True -> + { ( _dataFieldPatExprIallErrSq,_dataFieldPatExprIcSubst,_dataFieldPatExprIdti,_dataFieldPatExprIerrSq,_dataFieldPatExprIfldL,_dataFieldPatExprIfsRPatL,_dataFieldPatExprIgathMentrelFilterMp,_dataFieldPatExprIgathTvKiVarMp,_dataFieldPatExprIpatCRest,_dataFieldPatExprIpp,_dataFieldPatExprIppAST,_dataFieldPatExprIppL,_dataFieldPatExprItrpp,_dataFieldPatExprIvalCBindL) | True -> (case (_dataFieldPatExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -5027,64 +5091,70 @@ { _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 - { __tup198 | __tup198 `seq` (True) -> - (case (__tup198) of - { (_,_,_rpatBind0) | _rpatBind0 `seq` (True) -> - (case (__tup198) 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 (_dataFieldPatExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ((emptyRCEEnv _lhsIopts) { rceValGam = _lhsIvalGam, rceDataGam = _lhsIdataGam, rceTyVarMp = _lhsIfinTyVarMp }) of - { _rceEnv | _rceEnv `seq` (True) -> - (case (_dataFieldPatExprIvalCBindL) of - { _valCBindLSub | _valCBindLSub `seq` (True) -> - (case (__tup198) 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,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PatExpr","DataFields"] [] [_dataFieldPatExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `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 + { __tup198 | __tup198 `seq` (True) -> + (case (__tup198) of + { (_,_,_rpatBind0) | _rpatBind0 `seq` (True) -> + (case (__tup198) 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 (_dataFieldPatExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ((emptyRCEEnv _lhsIopts) { rceValGam = _lhsIvalGam, rceDataGam = _lhsIdataGam, rceTyVarMp = _lhsIfinTyVarMp }) of + { _rceEnv | _rceEnv `seq` (True) -> + (case (_dataFieldPatExprIvalCBindL) of + { _valCBindLSub | _valCBindLSub `seq` (True) -> + (case (__tup198) 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,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_DataFields_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -5371,7 +5441,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -5398,31 +5468,33 @@ { _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 (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_patExprIppAST) of + { _lhsOppAST | _lhsOppAST `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 (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Irrefutable_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -5709,7 +5781,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -5736,17 +5808,19 @@ { _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 (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_patExprIppAST) of + { _lhsOppAST | _lhsOppAST `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 (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Bang_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -6049,7 +6123,7 @@ (case (ExprCtxt_Top) of { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -6093,17 +6167,19 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (__tup202) 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 (_exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (_exprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (__tup202) 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 (_exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOcSubst,_lhsOerrSq,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisBang,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOrpat,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_PatExpr_Expr_8)) of { ( sem_PatExpr_8) | True -> ( _lhsOcpNm,_lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_PatExpr_8) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs --- a/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_PatExprAnn.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam diff --git a/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_PrExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -145,6 +146,7 @@ errSq : ErrSq gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc pr : Pred trpp : TrPP alternatives: @@ -206,6 +208,8 @@ local nmErrs : {ErrL} local pp : _ local gathMentrelFilterMp : _ + local trppHere : _ + local ppAST : _ local trpp : _ intra _tup205 : _ intra _tup206 : _ @@ -234,6 +238,8 @@ intra pr : {Pred} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ intra pr : {Pred} alternative Forall: child hsrange : {Range} @@ -296,6 +302,8 @@ intra pr : {Pred} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ intra pr : {Pred} alternative DynVar: child hsrange : {Range} @@ -319,6 +327,8 @@ intra pr : {Pred} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ intra pr : {Pred} alternative Eq: child hsrange : {Range} @@ -351,6 +361,8 @@ intra pr : {Pred} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ intra pr : {Pred} -} sem_PrExpr_Class :: Range -> @@ -533,7 +545,7 @@ (case (_lhsIclGam) of { _tyExprsOclGam | _tyExprsOclGam `seq` (True) -> (case (tyExprs_6 _tyExprsOclGam _tyExprsOfinKiVarMp _tyExprsOfinTyKiGam _tyExprsOfinTyVarMp _tyExprsOkiGam _tyExprsOknPolCtx _tyExprsOmoduleNm _tyExprsOopts _tyExprsOsysfEnv _tyExprsOtr _tyExprsOtyKiGlobFreeTvarS _tyExprsOtyTyGlobFreeTvarS _tyExprsOtyTyTySigFreeTvarS _tyExprsOvalTyGlobFreeTvarS) of - { ( _tyExprsIallErrSq,_tyExprsIclMissNmS,_tyExprsIclNmS,_tyExprsIerrSq,_tyExprsIgathMentrelFilterMp,_tyExprsIpp,_tyExprsIppL,_tyExprsItrpp) | True -> + { ( _tyExprsIallErrSq,_tyExprsIclMissNmS,_tyExprsIclNmS,_tyExprsIerrSq,_tyExprsIgathMentrelFilterMp,_tyExprsIpp,_tyExprsIppAST,_tyExprsIppL,_tyExprsItrpp) | True -> (case (_tyExprsIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (__tup205) of @@ -564,14 +576,19 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case ((_lhsItr TraceOn_EhClsGam $ ["Class" >#< nm_] ++ [ "clGam=" >#< ppGam _lhsIclGam ]) - >< _tyExprsItrpp) of - { _trpp | _trpp `seq` (True) -> - (case (_trpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case ((_lhsItr TraceOn_EhClsGam $ ["Class" >#< nm_] ++ [ "clGam=" >#< ppGam _lhsIclGam ])) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PrExpr","Class"] [ppTrNm nm_] [_tyExprsIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_trppHere >< _tyExprsItrpp) of + { _trpp | _trpp `seq` (True) -> + (case (_trpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_Class_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }) }) }) }) }) }))) @@ -784,7 +801,7 @@ (case (_lhsIfinKiVarMp) of { _resOfinKiVarMp | _resOfinKiVarMp `seq` (True) -> (case (res_8 _resOfinKiVarMp _resOfinTyKiGam _resOfinTyVarMp _resOkiGam _resOmoduleNm _resOopts _resOsysfEnv _resOtr _resOtyKiGlobFreeTvarS _resOtyTyGlobFreeTvarS _resOtyTyTySigFreeTvarS _resOvalTyGlobFreeTvarS) of - { ( _resIallErrSq,_resIclMissNmS,_resIclNmS,_resIerrSq,_resIgathMentrelFilterMp,_resIpp,_resIpr,_resItrpp) | True -> + { ( _resIallErrSq,_resIclMissNmS,_resIclNmS,_resIerrSq,_resIgathMentrelFilterMp,_resIpp,_resIppAST,_resIpr,_resItrpp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _argOvalTyGlobFreeTvarS | _argOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -810,7 +827,7 @@ (case (_lhsIfinKiVarMp) of { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> (case (arg_8 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOkiGam _argOmoduleNm _argOopts _argOsysfEnv _argOtr _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of - { ( _argIallErrSq,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argIpr,_argItrpp) | True -> + { ( _argIallErrSq,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argIppAST,_argIpr,_argItrpp) | True -> (case (_argIallErrSq `Seq.union` _resIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_argIclMissNmS `Set.union` _resIclMissNmS) of @@ -825,11 +842,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case (_argItrpp >< _resItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PrExpr","Arrow"] [] [_argIppAST,_resIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_argItrpp >< _resItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_Arrow_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }) }) }) }) }))) @@ -1027,7 +1050,7 @@ (case (_lhsIfinKiVarMp) of { _prExprOfinKiVarMp | _prExprOfinKiVarMp `seq` (True) -> (case (prExpr_8 _prExprOfinKiVarMp _prExprOfinTyKiGam _prExprOfinTyVarMp _prExprOkiGam _prExprOmoduleNm _prExprOopts _prExprOsysfEnv _prExprOtr _prExprOtyKiGlobFreeTvarS _prExprOtyTyGlobFreeTvarS _prExprOtyTyTySigFreeTvarS _prExprOvalTyGlobFreeTvarS) of - { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIpr,_prExprItrpp) | True -> + { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIppAST,_prExprIpr,_prExprItrpp) | True -> (case (_prExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_prExprIclMissNmS) of @@ -1042,11 +1065,13 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case (_prExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (_prExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_prExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_Forall_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) @@ -1227,7 +1252,7 @@ (case (_lhsIclGam) of { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtr _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of - { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL,_rowTyExprItrpp) | True -> + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppAST,_rowTyExprIppL,_rowTyExprItrpp) | True -> (case (_rowTyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_rowTyExprIclMissNmS) of @@ -1242,11 +1267,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case (_rowTyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PrExpr","Lacks"] [ppTrNm nm_] [_rowTyExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_rowTyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_Lacks_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }))) @@ -1427,7 +1458,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_tyExprIclMissNmS) of @@ -1442,11 +1473,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PrExpr","DynVar"] [ppTrNm nm_] [_tyExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_DynVar_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) @@ -1662,7 +1699,7 @@ (case (_lhsIfinKiVarMp) of { _tyExpr2OfinKiVarMp | _tyExpr2OfinKiVarMp `seq` (True) -> (case (tyExpr2_8 _tyExpr2OfinKiVarMp _tyExpr2OfinTyKiGam _tyExpr2OfinTyVarMp _tyExpr2OkiGam _tyExpr2OmoduleNm _tyExpr2Oopts _tyExpr2OsysfEnv _tyExpr2Otr _tyExpr2OtyKiGlobFreeTvarS _tyExpr2OtyTyGlobFreeTvarS _tyExpr2OtyTyTySigFreeTvarS _tyExpr2OvalTyGlobFreeTvarS) of - { ( _tyExpr2IallErrSq,_tyExpr2IappArgPPL,_tyExpr2IappFunNm,_tyExpr2IappFunPP,_tyExpr2IclMissNmS,_tyExpr2IclNmS,_tyExpr2IerrSq,_tyExpr2IgathMentrelFilterMp,_tyExpr2Ipp,_tyExpr2Itrpp,_tyExpr2ItyWildL) | True -> + { ( _tyExpr2IallErrSq,_tyExpr2IappArgPPL,_tyExpr2IappFunNm,_tyExpr2IappFunPP,_tyExpr2IclMissNmS,_tyExpr2IclNmS,_tyExpr2IerrSq,_tyExpr2IgathMentrelFilterMp,_tyExpr2Ipp,_tyExpr2IppAST,_tyExpr2Itrpp,_tyExpr2ItyWildL) | True -> (case (_lhsIclGam) of { _tyExpr1OclGam | _tyExpr1OclGam `seq` (True) -> (case (tyExpr1_7 _tyExpr1OclGam) of @@ -1692,7 +1729,7 @@ (case (_lhsIfinKiVarMp) of { _tyExpr1OfinKiVarMp | _tyExpr1OfinKiVarMp `seq` (True) -> (case (tyExpr1_8 _tyExpr1OfinKiVarMp _tyExpr1OfinTyKiGam _tyExpr1OfinTyVarMp _tyExpr1OkiGam _tyExpr1OmoduleNm _tyExpr1Oopts _tyExpr1OsysfEnv _tyExpr1Otr _tyExpr1OtyKiGlobFreeTvarS _tyExpr1OtyTyGlobFreeTvarS _tyExpr1OtyTyTySigFreeTvarS _tyExpr1OvalTyGlobFreeTvarS) of - { ( _tyExpr1IallErrSq,_tyExpr1IappArgPPL,_tyExpr1IappFunNm,_tyExpr1IappFunPP,_tyExpr1IclMissNmS,_tyExpr1IclNmS,_tyExpr1IerrSq,_tyExpr1IgathMentrelFilterMp,_tyExpr1Ipp,_tyExpr1Itrpp,_tyExpr1ItyWildL) | True -> + { ( _tyExpr1IallErrSq,_tyExpr1IappArgPPL,_tyExpr1IappFunNm,_tyExpr1IappFunPP,_tyExpr1IclMissNmS,_tyExpr1IclNmS,_tyExpr1IerrSq,_tyExpr1IgathMentrelFilterMp,_tyExpr1Ipp,_tyExpr1IppAST,_tyExpr1Itrpp,_tyExpr1ItyWildL) | True -> (case (_tyExpr1IallErrSq `Seq.union` _tyExpr2IallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_tyExpr1IclMissNmS `Set.union` _tyExpr2IclMissNmS) of @@ -1707,11 +1744,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_pr) of - { _lhsOpr | _lhsOpr `seq` (True) -> - (case (_tyExpr1Itrpp >< _tyExpr2Itrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["PrExpr","Eq"] [] [_tyExpr1IppAST,_tyExpr2IppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pr) of + { _lhsOpr | _lhsOpr `seq` (True) -> + (case (_tyExpr1Itrpp >< _tyExpr2Itrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOpr,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_PrExpr_Eq_8)) of { ( sem_PrExpr_8) | True -> ( _lhsOevTy,sem_PrExpr_8) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs b/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs --- a/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_PrExprs.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -116,6 +117,7 @@ gathMentrelFilterMp : ModEntRelFilterMp intlTyKiGam : TyKiGam pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] prL : [Pred] range : Range @@ -242,7 +244,7 @@ (case (_lhsIclGam) of { _tlOclGam | _tlOclGam `seq` (True) -> (case (tl_ _tlOclGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOgUniq _tlOkiGam _tlOkiVarMp _tlOknPolCtx _tlOmoduleNm _tlOopts _tlOpolGam _tlOpolVarMp _tlOsysfEnv _tlOtr _tlOtyGam _tlOtyKiGam _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgUniq,_tlIgathMentrelFilterMp,_tlIintlTyKiGam,_tlIkiVarMp,_tlIpolVarMp,_tlIpp,_tlIppL,_tlIprL,_tlIrange,_tlItrpp,_tlItyGam,_tlItyKiGam,_tlItyL,_tlItyVarWildMp) | True -> + { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgUniq,_tlIgathMentrelFilterMp,_tlIintlTyKiGam,_tlIkiVarMp,_tlIpolVarMp,_tlIpp,_tlIppAST,_tlIppL,_tlIprL,_tlIrange,_tlItrpp,_tlItyGam,_tlItyKiGam,_tlItyL,_tlItyVarWildMp) | True -> (case (_lhsIclGam) of { _hdOclGam | _hdOclGam `seq` (True) -> (case (hd_7 _hdOclGam) of @@ -272,7 +274,7 @@ (case (_lhsIfinKiVarMp) of { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> (case (hd_8 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOkiGam _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtr _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdIpr,_hdItrpp) | True -> + { ( _hdIallErrSq,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdIppAST,_hdIpr,_hdItrpp) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIclMissNmS `Set.union` _tlIclMissNmS) of @@ -293,23 +295,25 @@ { _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 (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) + (case (_hdIppAST >-< _tlIppAST) of + { _lhsOppAST | _lhsOppAST `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 (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOprL,_lhsOrange,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) sem_PrExprs_Nil :: T_PrExprs @@ -374,21 +378,23 @@ { _lhsOpolVarMp | _lhsOpolVarMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> + (case (empty) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> (case ([]) of - { _lhsOprL | _lhsOprL `seq` (True) -> - (case (emptyRange) of - { _lhsOrange | _lhsOrange `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) + { _lhsOppL | _lhsOppL `seq` (True) -> + (case ([]) of + { _lhsOprL | _lhsOprL `seq` (True) -> + (case (emptyRange) of + { _lhsOrange | _lhsOrange `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOprL,_lhsOrange,_lhsOtrpp,_lhsOtyGam,_lhsOtyKiGam,_lhsOtyL,_lhsOtyVarWildMp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_RecExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -123,10 +124,10 @@ chained attribute: positionalFldNmL : [HsName] synthesized attribute: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam fiOpts : FIOpts knTy : Ty @@ -137,7 +138,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp noLetQuantTyVarIdS : TyVarIdS visit 7: @@ -161,6 +162,7 @@ gathTvKiVarMp : VarMp isExtFromEmpty : Bool pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] recCExpr : CExpr trpp : TrPP @@ -193,6 +195,8 @@ intra range : {Range} visit 7: local pp : _ + local trppHere : _ + local ppAST : _ local recCExpr : _ local ty : {Ty} intra fo_ : {FIOut} @@ -248,6 +252,8 @@ local knRecHasLab : {Bool} local offset : _ local rcexpr : _ + local trppHere : _ + local ppAST : _ local ty : {Ty} intra nm : {HsName} intra positionalNm : {HsName} @@ -303,6 +309,8 @@ local knRecHasLab : {Bool} local offset : _ local rcexpr : _ + local trppHere : _ + local ppAST : _ local ty : {Ty} intra foKnRec : {FIOut} intra range : {Range} @@ -315,6 +323,8 @@ local range : {Range} visit 7: local pp : _ + local trppHere : _ + local ppAST : _ local recCExpr : _ -} sem_RecExpr_Empty :: Range -> @@ -473,19 +483,25 @@ { _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 (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecExpr","Empty"] [] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `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 (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOrecCExpr,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_RecExpr_Empty_7)) of { ( sem_RecExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }))))))))))) @@ -862,13 +878,13 @@ (case (_lhsImoduleNm) of { _recExprOmoduleNm | _recExprOmoduleNm `seq` (True) -> (case (recExpr_7 _recExprOcSubst _recExprOchrEvidBindMp _recExprOchrScopeBindMp _recExprOfinTyVarMp _recExprOfinValGam _recExprOmoduleNm _recExprOrangeMp _recExprOsysfEnv _recExprOtr) of - { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppL,_recExprIrecCExpr,_recExprItrpp,_recExprIty) | True -> + { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppAST,_recExprIppL,_recExprIrecCExpr,_recExprItrpp,_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 _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_recExprIallErrSq `Seq.union` _exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -899,17 +915,23 @@ { _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 (_recExprItrpp >< _exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecExpr","Ext"] [ppTrNm _nm] [_recExprIppAST,_exprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pp : _recExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recExprIrecCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (_recExprItrpp >< _exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOrecCExpr,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_RecExpr_Ext_7)) of { ( sem_RecExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) @@ -1282,13 +1304,13 @@ (case (_lhsImoduleNm) of { _recExprOmoduleNm | _recExprOmoduleNm `seq` (True) -> (case (recExpr_7 _recExprOcSubst _recExprOchrEvidBindMp _recExprOchrScopeBindMp _recExprOfinTyVarMp _recExprOfinValGam _recExprOmoduleNm _recExprOrangeMp _recExprOsysfEnv _recExprOtr) of - { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppL,_recExprIrecCExpr,_recExprItrpp,_recExprIty) | True -> + { ( _recExprIallErrSq,_recExprIcSubst,_recExprIerrSq,_recExprIextNm,_recExprIfuCExprL,_recExprIgathMentrelFilterMp,_recExprIgathTvKiVarMp,_recExprIisExtFromEmpty,_recExprIpp,_recExprIppAST,_recExprIppL,_recExprIrecCExpr,_recExprItrpp,_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 _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_recExprIallErrSq `Seq.union` _exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -1319,17 +1341,23 @@ { _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 (_recExprItrpp >< _exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `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,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecExpr","Upd"] [ppTrNm nm_] [_recExprIppAST,_exprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_pp : _recExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recExprIrecCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (_recExprItrpp >< _exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `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,_lhsOppAST,_lhsOppL,_lhsOrecCExpr,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_RecExpr_Upd_7)) of { ( sem_RecExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) @@ -1568,7 +1596,7 @@ (case (ExprCtxt_Top) of { _exprOexprCtxt | _exprOexprCtxt `seq` (True) -> (case (expr_7 _exprOcSubst _exprOchrEvidBindMp _exprOchrScopeBindMp _exprOexprCtxt _exprOfinTyVarMp _exprOfinValGam _exprOmoduleNm _exprOrangeMp _exprOsysfEnv _exprOtr) 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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprItrpp) | True -> + { ( _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,_exprIletValMainCBindL,_exprIorphanS,_exprIpp,_exprIppAST,_exprItrpp) | True -> (case (_exprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_exprIcSubst) of @@ -1589,17 +1617,23 @@ { _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 (_exprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_exprIty) of - { _lhsOty | _lhsOty `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppL,_lhsOrecCExpr,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecExpr","Expr"] [] [_exprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_exprIcexpr) of + { _recCExpr | _recCExpr `seq` (True) -> + (case (_recCExpr) of + { _lhsOrecCExpr | _lhsOrecCExpr `seq` (True) -> + (case (_exprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_exprIty) of + { _lhsOty | _lhsOty `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfuCExprL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOisExtFromEmpty,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOrecCExpr,_lhsOtrpp,_lhsOty) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) in sem_RecExpr_Expr_7)) of { ( sem_RecExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOnoLetQuantTyVarIdS,_lhsOtyVarMp,sem_RecExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_RecPatExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -119,7 +120,7 @@ chained attribute: positionalFldNmL : [HsName] synthesized attributes: - chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope) + chrInstDeclSq : Seq.FastSeq (CHRScopedInstanceDecl) hasAFldRef : Bool visit 5: inherited attributes: @@ -132,7 +133,7 @@ valGam : ValGam visit 6: inherited attributes: - chrStore : ScopedPredStore + chrStore : CHRStore clDfGam : ClassDefaultGam tvKiVarMp : VarMp tyTyGlobFreeTvarS : TyVarIdS @@ -140,7 +141,7 @@ chained attribute: tyVarMp : VarMp synthesized attributes: - gathCnstrMp : CHRPredOccCnstrMp + gathCnstrMp : ConstraintToInfoMap gathRangeMp : RangeMp scopeGam : ScopeGam ty : Ty @@ -167,6 +168,7 @@ gathTvKiVarMp : VarMp patCRest : CPatRest pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP valCBindL : CBindL @@ -199,6 +201,8 @@ intra range : {Range} visit 7: local pp : _ + local trppHere : _ + local ppAST : _ intra fo_ : {FIOut} intra range : {Range} alternative Ext: @@ -251,6 +255,8 @@ visit 7: local pp : _ local offset : _ + local trppHere : _ + local ppAST : _ intra fo_ : {FIOut} intra range : {Range} intra prUid : {PredOccId} @@ -263,6 +269,8 @@ local range : {Range} visit 7: local pp : _ + local trppHere : _ + local ppAST : _ -} sem_RecPatExpr_Empty :: Range -> T_RecPatExpr @@ -440,13 +448,19 @@ { _lhsOpatCRest | _lhsOpatCRest `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecPatExpr","Empty"] [] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_RecPatExpr_Empty_7)) of { ( sem_RecPatExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) })))))))) @@ -855,13 +869,13 @@ (case (_lhsIceParentNm) of { _recPatExprOceParentNm | _recPatExprOceParentNm `seq` (True) -> (case (recPatExpr_7 _recPatExprOcSubst _recPatExprOceParentNm _recPatExprOchrEvidBindMp _recPatExprOchrScopeBindMp _recPatExprOfinTyVarMp _recPatExprOfinValGam _recPatExprOmoduleNm _recPatExprOrangeMp _recPatExprOsysfEnv _recPatExprOtr _recPatExprOtySigVarMp) of - { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppL,_recPatExprItrpp,_recPatExprIvalCBindL) | True -> + { ( _recPatExprIallErrSq,_recPatExprIcSubst,_recPatExprIerrSq,_recPatExprIextNm,_recPatExprIfsRPatL,_recPatExprIgathMentrelFilterMp,_recPatExprIgathTvKiVarMp,_recPatExprIpatCRest,_recPatExprIpp,_recPatExprIppAST,_recPatExprIppL,_recPatExprItrpp,_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 _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_recPatExprIallErrSq `Seq.union` _patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_patExprIcSubst) of @@ -886,13 +900,19 @@ { _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 (_recPatExprItrpp >< _patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_recPatExprIvalCBindL ++ _patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecPatExpr","Ext"] [ppTrNm _nm] [_recPatExprIppAST,_patExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (ppFld "=" (Just _positionalNm) _nm (pp _nm) _patExprIpp : _recPatExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_recPatExprItrpp >< _patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_recPatExprIvalCBindL ++ _patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_RecPatExpr_Ext_7)) of { ( sem_RecPatExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) @@ -1158,7 +1178,7 @@ (case (_lhsIcSubst) of { _patExprOcSubst | _patExprOcSubst `seq` (True) -> (case (patExpr_8 _patExprOcSubst _patExprOceParentNm _patExprOchrEvidBindMp _patExprOchrScopeBindMp _patExprOfinTyVarMp _patExprOfinValGam _patExprOmoduleNm _patExprOrangeMp _patExprOsysfEnv _patExprOtr _patExprOtySigVarMp) of - { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> + { ( _patExprIallErrSq,_patExprIappArgPPL,_patExprIappFunNm,_patExprIappFunPP,_patExprIcSubst,_patExprIerrSq,_patExprIfsRPatL,_patExprIgathMentrelFilterMp,_patExprIgathTvKiVarMp,_patExprIisBang,_patExprIpatCRest,_patExprIpp,_patExprIppAST,_patExprIrpat,_patExprItrpp,_patExprIvalCBindL) | True -> (case (_patExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_patExprIcSubst) of @@ -1179,13 +1199,19 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_patExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_patExprIvalCBindL) of - { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> - ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RecPatExpr","Expr"] [] [_patExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_patExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_patExprIvalCBindL) of + { _lhsOvalCBindL | _lhsOvalCBindL `seq` (True) -> + ( _lhsOallErrSq,_lhsOcSubst,_lhsOerrSq,_lhsOextNm,_lhsOfsRPatL,_lhsOgathMentrelFilterMp,_lhsOgathTvKiVarMp,_lhsOpatCRest,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp,_lhsOvalCBindL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_RecPatExpr_Expr_7)) of { ( sem_RecPatExpr_7) | True -> ( _lhsOgathCnstrMp,_lhsOgathRangeMp,_lhsOscopeGam,_lhsOty,_lhsOtyVarMp,sem_RecPatExpr_7) }) }) }) }) }) }) }) }) }) }) }) }) })))))))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_RowTyExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -136,6 +137,7 @@ extNm : HsName gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP alternatives: @@ -143,6 +145,9 @@ child hsrange : {Range} visit 0: local range : {Range} + visit 6: + local trppHere : _ + local ppAST : _ alternative Ext: child hsrange : {Range} child rowTyExpr : RowTyExpr @@ -173,6 +178,8 @@ intra nm : {HsName} intra positionalNm : {HsName} visit 6: + local trppHere : _ + local ppAST : _ intra nm : {HsName} intra positionalNm : {HsName} alternative Var: @@ -209,6 +216,8 @@ intra range : {Range} visit 6: local pp : _ + local trppHere : _ + local ppAST : _ intra fo_ : {FIOut} intra range : {Range} -} @@ -306,11 +315,17 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RowTyExpr","Empty"] [] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) in sem_RowTyExpr_Empty_6)) of { ( sem_RowTyExpr_6) | True -> ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }))) @@ -511,7 +526,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _rowTyExprOvalTyGlobFreeTvarS | _rowTyExprOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -539,7 +554,7 @@ (case (_lhsIclGam) of { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtr _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of - { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL,_rowTyExprItrpp) | True -> + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppAST,_rowTyExprIppL,_rowTyExprItrpp) | True -> (case (_rowTyExprIallErrSq `Seq.union` _tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_rowTyExprIclMissNmS `Set.union` _tyExprIclMissNmS) of @@ -554,11 +569,17 @@ { _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) -> - (case (_rowTyExprItrpp >< _tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RowTyExpr","Ext"] [ppTrNm _nm] [_rowTyExprIppAST,_tyExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (ppFld "::" (Just _positionalNm) _nm (pp _nm) _tyExprIpp : _rowTyExprIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_rowTyExprItrpp >< _tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) in sem_RowTyExpr_Ext_6)) of { ( sem_RowTyExpr_6) | True -> ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }) }) }) }) }) }) }))) @@ -695,11 +716,17 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["RowTyExpr","Var"] [ppTrNm nm_] [] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOextNm,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))))) in sem_RowTyExpr_Var_6)) of { ( sem_RowTyExpr_6) | True -> ( _lhsOkiVarMp,_lhsOtyVarWildMp,sem_RowTyExpr_6) }) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs --- a/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExpr.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -150,6 +151,7 @@ errSq : ErrSq gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc trpp : TrPP tyWildL : TyL alternatives: @@ -204,6 +206,7 @@ local nmErrs : {ErrL} local nmPolErrs : {ErrL} local gathMentrelFilterMp : _ + local trppHere : _ intra _tup231 : _ intra _tup228 : _ intra foPol : {FIOut} @@ -249,6 +252,7 @@ visit 8: local _tup233 : _ local pp : _ + local trppHere : _ intra fo_ : {FIOut} intra range : {Range} alternative AppTop: @@ -272,6 +276,7 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ intra range : {Range} alternative Parens: child hsrange : {Range} @@ -280,6 +285,7 @@ local range : {Range} visit 8: local pp : _ + local trppHere : _ alternative Ann: child hsrange : {Range} child ann : TyExprAnn @@ -325,6 +331,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ alternative Mono: child hsrange : {Range} visit 0: @@ -360,6 +367,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ alternative Var: child hsrange : {Range} child nm : {HsName} @@ -412,6 +420,7 @@ intra range : {Range} visit 8: local pp : _ + local trppHere : _ intra foPol : {FIOut} intra range : {Range} alternative VarWild: @@ -456,6 +465,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ alternative Quant: child hsrange : {Range} child qu : {TyQu} @@ -493,6 +503,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ alternative Row: child hsrange : {Range} child rowTyExpr : RowTyExpr @@ -513,6 +524,8 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ alternative Pred: child hsrange : {Range} child prExpr : PrExpr @@ -520,6 +533,8 @@ local range : {Range} visit 8: local pp : _ + local trppHere : _ + local ppAST : _ alternative Impls: child hsrange : {Range} visit 0: @@ -619,6 +634,7 @@ intra ty : {Ty} visit 8: local pp : _ + local trppHere : _ -} sem_TyExpr_Con :: Range -> HsName -> @@ -764,10 +780,14 @@ (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Con"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Con_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -1000,7 +1020,7 @@ (case (_lhsIfinKiVarMp) of { _argOfinKiVarMp | _argOfinKiVarMp `seq` (True) -> (case (arg_8 _argOfinKiVarMp _argOfinTyKiGam _argOfinTyVarMp _argOkiGam _argOmoduleNm _argOopts _argOsysfEnv _argOtr _argOtyKiGlobFreeTvarS _argOtyTyGlobFreeTvarS _argOtyTyTySigFreeTvarS _argOvalTyGlobFreeTvarS) of - { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argItrpp,_argItyWildL) | True -> + { ( _argIallErrSq,_argIappArgPPL,_argIappFunNm,_argIappFunPP,_argIclMissNmS,_argIclNmS,_argIerrSq,_argIgathMentrelFilterMp,_argIpp,_argIppAST,_argItrpp,_argItyWildL) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _funcOvalTyGlobFreeTvarS | _funcOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -1026,7 +1046,7 @@ (case (_lhsIfinKiVarMp) of { _funcOfinKiVarMp | _funcOfinKiVarMp `seq` (True) -> (case (func_8 _funcOfinKiVarMp _funcOfinTyKiGam _funcOfinTyVarMp _funcOkiGam _funcOmoduleNm _funcOopts _funcOsysfEnv _funcOtr _funcOtyKiGlobFreeTvarS _funcOtyTyGlobFreeTvarS _funcOtyTyTySigFreeTvarS _funcOvalTyGlobFreeTvarS) of - { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIclMissNmS,_funcIclNmS,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp,_funcItrpp,_funcItyWildL) | True -> + { ( _funcIallErrSq,_funcIappArgPPL,_funcIappFunNm,_funcIappFunPP,_funcIclMissNmS,_funcIclNmS,_funcIerrSq,_funcIgathMentrelFilterMp,_funcIpp,_funcIppAST,_funcItrpp,_funcItyWildL) | True -> (case (_funcIallErrSq `Seq.union` _argIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (mkExtAppPP (_funcIappFunNm,_funcIappFunPP,_funcIappArgPPL) @@ -1052,11 +1072,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_funcItrpp >< _argItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_funcItyWildL ++ _argItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","App"] [] [_funcIppAST,_argIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_funcItrpp >< _argItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_funcItyWildL ++ _argItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_App_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }) }) }) }) }) }))) @@ -1232,7 +1256,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -1254,11 +1278,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_tyExprItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","AppTop"] [] [_tyExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_AppTop_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) @@ -1434,7 +1462,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -1455,11 +1483,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_tyExprItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Parens"] [] [_tyExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Parens_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) @@ -1642,7 +1674,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -1663,11 +1695,13 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_tyExprItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (_tyExprIppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Ann_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) @@ -1822,10 +1856,14 @@ (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Wild"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Wild_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -1980,10 +2018,14 @@ (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Mono"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Mono_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -2153,10 +2195,14 @@ (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Var"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Var_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -2318,10 +2364,14 @@ (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","VarWild"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_VarWild_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -2520,7 +2570,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -2541,11 +2591,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_tyExprItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Quant"] [text (showTyQu qu_),ppTrNm tyVar_] [_tyExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Quant_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -2725,7 +2779,7 @@ (case (_lhsIclGam) of { _rowTyExprOclGam | _rowTyExprOclGam `seq` (True) -> (case (rowTyExpr_6 _rowTyExprOclGam _rowTyExprOfinKiVarMp _rowTyExprOfinTyKiGam _rowTyExprOfinTyVarMp _rowTyExprOkiGam _rowTyExprOmoduleNm _rowTyExprOopts _rowTyExprOsysfEnv _rowTyExprOtr _rowTyExprOtyKiGlobFreeTvarS _rowTyExprOtyTyGlobFreeTvarS _rowTyExprOtyTyTySigFreeTvarS _rowTyExprOvalTyGlobFreeTvarS) of - { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppL,_rowTyExprItrpp) | True -> + { ( _rowTyExprIallErrSq,_rowTyExprIclMissNmS,_rowTyExprIclNmS,_rowTyExprIerrSq,_rowTyExprIextNm,_rowTyExprIgathMentrelFilterMp,_rowTyExprIpp,_rowTyExprIppAST,_rowTyExprIppL,_rowTyExprItrpp) | True -> (case (_rowTyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (reverse _rowTyExprIppL) of @@ -2747,11 +2801,17 @@ { _pp | _pp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_rowTyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Row"] [] [_rowTyExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_rowTyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Row_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -2927,7 +2987,7 @@ (case (_lhsIfinKiVarMp) of { _prExprOfinKiVarMp | _prExprOfinKiVarMp `seq` (True) -> (case (prExpr_8 _prExprOfinKiVarMp _prExprOfinTyKiGam _prExprOfinTyVarMp _prExprOkiGam _prExprOmoduleNm _prExprOopts _prExprOsysfEnv _prExprOtr _prExprOtyKiGlobFreeTvarS _prExprOtyTyGlobFreeTvarS _prExprOtyTyTySigFreeTvarS _prExprOvalTyGlobFreeTvarS) of - { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIpr,_prExprItrpp) | True -> + { ( _prExprIallErrSq,_prExprIclMissNmS,_prExprIclNmS,_prExprIerrSq,_prExprIgathMentrelFilterMp,_prExprIpp,_prExprIppAST,_prExprIpr,_prExprItrpp) | True -> (case (_prExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -2948,11 +3008,17 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_prExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Pred"] [] [_prExprIppAST] _trppHere) of + { _ppAST | _ppAST `seq` (True) -> + (case (_ppAST) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_prExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Pred_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }) }) }))) @@ -3104,11 +3170,13 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (empty) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Impls_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -3254,11 +3322,13 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case ([]) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (empty) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case ([]) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_NoImpls_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) @@ -3468,7 +3538,7 @@ (case (_lhsIfinKiVarMp) of { _tyExprOfinKiVarMp | _tyExprOfinKiVarMp `seq` (True) -> (case (tyExpr_8 _tyExprOfinKiVarMp _tyExprOfinTyKiGam _tyExprOfinTyVarMp _tyExprOkiGam _tyExprOmoduleNm _tyExprOopts _tyExprOsysfEnv _tyExprOtr _tyExprOtyKiGlobFreeTvarS _tyExprOtyTyGlobFreeTvarS _tyExprOtyTyTySigFreeTvarS _tyExprOvalTyGlobFreeTvarS) of - { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprItrpp,_tyExprItyWildL) | True -> + { ( _tyExprIallErrSq,_tyExprIappArgPPL,_tyExprIappFunNm,_tyExprIappFunPP,_tyExprIclMissNmS,_tyExprIclNmS,_tyExprIerrSq,_tyExprIgathMentrelFilterMp,_tyExprIpp,_tyExprIppAST,_tyExprItrpp,_tyExprItyWildL) | True -> (case (_tyExprIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case ([]) of @@ -3489,11 +3559,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_pp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_tyExprItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - (case (_tyExprItyWildL) of - { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> - ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExpr","Lam"] [ppTrNm tyVar_] [_tyExprIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_tyExprItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + (case (_tyExprItyWildL) of + { _lhsOtyWildL | _lhsOtyWildL `seq` (True) -> + ( _lhsOallErrSq,_lhsOappArgPPL,_lhsOappFunNm,_lhsOappFunPP,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOtrpp,_lhsOtyWildL) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))) in sem_TyExpr_Lam_8)) of { ( sem_TyExpr_8) | True -> ( _lhsOevTy,sem_TyExpr_8) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs --- a/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExprAnn.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs b/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs --- a/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_TyExprs.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -137,6 +138,7 @@ errSq : ErrSq gathMentrelFilterMp : ModEntRelFilterMp pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP alternatives: @@ -149,7 +151,11 @@ local lUniq_17_polCtx : {UID} local polCtxVar : {Polarity} intra _tup252 : _ + visit 6: + local trppHere : _ alternative Nil: + visit 6: + local trppHere : _ -} sem_TyExprs_Cons :: T_TyExpr -> T_TyExprs -> @@ -319,7 +325,7 @@ (case (_lhsIclGam) of { _tlOclGam | _tlOclGam `seq` (True) -> (case (tl_6 _tlOclGam _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOkiGam _tlOknPolCtx _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtr _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIpp,_tlIppL,_tlItrpp) | True -> + { ( _tlIallErrSq,_tlIclMissNmS,_tlIclNmS,_tlIerrSq,_tlIgathMentrelFilterMp,_tlIpp,_tlIppAST,_tlIppL,_tlItrpp) | True -> (case (_lhsIclGam) of { _hdOclGam | _hdOclGam `seq` (True) -> (case (hd_7 _hdOclGam) of @@ -349,7 +355,7 @@ (case (_lhsIfinKiVarMp) of { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> (case (hd_8 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOkiGam _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtr _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIappArgPPL,_hdIappFunNm,_hdIappFunPP,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdItrpp,_hdItyWildL) | True -> + { ( _hdIallErrSq,_hdIappArgPPL,_hdIappFunNm,_hdIappFunPP,_hdIclMissNmS,_hdIclNmS,_hdIerrSq,_hdIgathMentrelFilterMp,_hdIpp,_hdIppAST,_hdItrpp,_hdItyWildL) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIclMissNmS `Set.union` _tlIclMissNmS) of @@ -362,11 +368,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (_hdIpp >-< _tlIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_hdIpp : _tlIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExprs","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) })))))))))))))))) in sem_TyExprs_Cons_6)) of { ( sem_TyExprs_6) | True -> ( _lhsOgathTyVarPolGam,_lhsOkiL,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_TyExprs_6) }) }) }) }) }) }) }) }) }))) @@ -477,11 +487,15 @@ { _lhsOgathMentrelFilterMp | _lhsOgathMentrelFilterMp `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) })))))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyExprs","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOclMissNmS,_lhsOclNmS,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) })))))))))))))))) in sem_TyExprs_Nil_6)) of { ( sem_TyExprs_6) | True -> ( _lhsOgathTyVarPolGam,_lhsOkiL,_lhsOkiVarMp,_lhsOtyVarWildMp,sem_TyExprs_6) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs b/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs --- a/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_TyVar.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -122,6 +123,7 @@ gathMentrelFilterMp : ModEntRelFilterMp nm : HsName pp : PP_Doc + ppAST : PP_Doc trpp : TrPP alternatives: alternative Var: @@ -146,6 +148,8 @@ local ki : {Ty} intra _tup256 : _ intra _tup254 : _ + visit 4: + local trppHere : _ -} sem_TyVar_Var :: Range -> HsName -> @@ -241,8 +245,12 @@ (case (pp nm_) of { _lhsOpp | _lhsOpp `seq` (True) -> (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnm,_lhsOpp,_lhsOtrpp) }) }) }) }) }) }))))))))))))) + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyVar","Var"] [ppTrNm nm_] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnm,_lhsOpp,_lhsOppAST,_lhsOtrpp) }) }) }) }) }) }) }) }))))))))))))) in sem_TyVar_Var_4)) of { ( sem_TyVar_4) | True -> ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOki,_lhsOpolVarL,_lhsOty,_lhsOtyKiGam,sem_TyVar_4) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs b/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs --- a/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_TyVars.hs @@ -60,11 +60,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -122,13 +123,18 @@ gathMentrelFilterMp : ModEntRelFilterMp nmL : [HsName] pp : PP_Doc + ppAST : PP_Doc ppL : [PP_Doc] trpp : TrPP alternatives: alternative Cons: child hd : TyVar child tl : TyVars + visit 4: + local trppHere : _ alternative Nil: + visit 4: + local trppHere : _ -} sem_TyVars_Cons :: T_TyVar -> T_TyVars -> @@ -240,7 +246,7 @@ (case (_lhsIfinKiVarMp) of { _tlOfinKiVarMp | _tlOfinKiVarMp `seq` (True) -> (case (tl_4 _tlOfinKiVarMp _tlOfinTyKiGam _tlOfinTyVarMp _tlOmoduleNm _tlOopts _tlOsysfEnv _tlOtr _tlOtyKiGlobFreeTvarS _tlOtyTyGlobFreeTvarS _tlOtyTyTySigFreeTvarS _tlOvalTyGlobFreeTvarS) of - { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlInmL,_tlIpp,_tlIppL,_tlItrpp) | True -> + { ( _tlIallErrSq,_tlIerrSq,_tlIgathMentrelFilterMp,_tlInmL,_tlIpp,_tlIppAST,_tlIppL,_tlItrpp) | True -> (case (_lhsIvalTyGlobFreeTvarS) of { _hdOvalTyGlobFreeTvarS | _hdOvalTyGlobFreeTvarS `seq` (True) -> (case (_lhsItyTyTySigFreeTvarS) of @@ -264,7 +270,7 @@ (case (_lhsIfinKiVarMp) of { _hdOfinKiVarMp | _hdOfinKiVarMp `seq` (True) -> (case (hd_4 _hdOfinKiVarMp _hdOfinTyKiGam _hdOfinTyVarMp _hdOmoduleNm _hdOopts _hdOsysfEnv _hdOtr _hdOtyKiGlobFreeTvarS _hdOtyTyGlobFreeTvarS _hdOtyTyTySigFreeTvarS _hdOvalTyGlobFreeTvarS) of - { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdInm,_hdIpp,_hdItrpp) | True -> + { ( _hdIallErrSq,_hdIerrSq,_hdIgathMentrelFilterMp,_hdInm,_hdIpp,_hdIppAST,_hdItrpp) | True -> (case (_hdIallErrSq `Seq.union` _tlIallErrSq) of { _lhsOallErrSq | _lhsOallErrSq `seq` (True) -> (case (_hdIerrSq `Seq.union` _tlIerrSq) of @@ -275,11 +281,15 @@ { _lhsOnmL | _lhsOnmL `seq` (True) -> (case (_hdIpp >-< _tlIpp) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case (_hdIpp : _tlIppL) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (_hdItrpp >< _tlItrpp) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyVars","Cons"] [] [_hdIppAST,_tlIppAST] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case (_hdIpp : _tlIppL) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (_hdItrpp >< _tlItrpp) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }) }))))))))))))) in sem_TyVars_Cons_4)) of { ( sem_TyVars_4) | True -> ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOkiL,_lhsOpolVarL,_lhsOtyKiGam,_lhsOtyL,sem_TyVars_4) }) }) }) }) }) }) }) }) }) }) }))) @@ -360,11 +370,15 @@ { _lhsOnmL | _lhsOnmL `seq` (True) -> (case (empty) of { _lhsOpp | _lhsOpp `seq` (True) -> - (case ([]) of - { _lhsOppL | _lhsOppL `seq` (True) -> - (case (trppEmpty) of - { _lhsOtrpp | _lhsOtrpp `seq` (True) -> - ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }))))))))))))) + (case (trppEmpty) of + { _trppHere | _trppHere `seq` (True) -> + (case (ppNestTrPP _lhsIopts ["TyVars","Nil"] [] [] _trppHere) of + { _lhsOppAST | _lhsOppAST `seq` (True) -> + (case ([]) of + { _lhsOppL | _lhsOppL `seq` (True) -> + (case (trppEmpty) of + { _lhsOtrpp | _lhsOtrpp `seq` (True) -> + ( _lhsOallErrSq,_lhsOerrSq,_lhsOgathMentrelFilterMp,_lhsOnmL,_lhsOpp,_lhsOppAST,_lhsOppL,_lhsOtrpp) }) }) }) }) }) }) }) }) }))))))))))))) in sem_TyVars_Nil_4)) of { ( sem_TyVars_4) | True -> ( _lhsOgathTyVarPolGam,_lhsOintlTyKiGam,_lhsOkiL,_lhsOpolVarL,_lhsOtyKiGam,_lhsOtyL,sem_TyVars_4) }) }) }) }) }) }) }))) diff --git a/src/UHC/Light/Compiler/EH/MainAG_common.hs b/src/UHC/Light/Compiler/EH/MainAG_common.hs --- a/src/UHC/Light/Compiler/EH/MainAG_common.hs +++ b/src/UHC/Light/Compiler/EH/MainAG_common.hs @@ -59,11 +59,12 @@ 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.Util.CHR import UHC.Light.Compiler.CHR.Constraint -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.Pred.ToCHR import UHC.Light.Compiler.Pred.Heuristics +import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.CHR.Solve import UHC.Light.Compiler.Pred.EvidenceToCore import UHC.Light.Compiler.Gam.ClassDefaultGam @@ -234,11 +235,11 @@ -gathMentrelFilterMpFromSimplifyResult :: HsName -> SimplifyResult p RedHowAnnotation g m -> ModEntRelFilterMp +gathMentrelFilterMpFromSimplifyResult :: HsName -> SimplifyResult -> ModEntRelFilterMp gathMentrelFilterMpFromSimplifyResult moduleNm simpRes = mentrelFilterMpUnions [ mentrelFilterMpSingleton [moduleNm] IdOcc_Val nm - | (Reduction {cnstrInfo=RedHow_ByInstance nm _ _}) <- chrSolveStateDoneConstraints $ simpresSolveState simpRes + | (Reduction {cnstrInfo=RedHow_ByInstance nm _ _}) <- (filterMb fromSolverConstraint $ chrSolveStateDoneConstraints $ simpresSolveState simpRes :: [Constraint]) ] @@ -262,15 +263,15 @@ 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 + { simpToProveHereCnstrMp :: !ConstraintToInfoMap -- new constraints to prove + , simpAllCnstrMp :: !ConstraintToInfoMap -- all constraints to prove, including previous + , simpRemCnstrTraceMp :: !ConstraintToInfoTraceMp -- 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 + , simpCannotCnstrTraceMp :: !ConstraintToInfoTraceMp -- cannot be proven , simpVarMp :: !VarMp -- additional substitution - , simpEvidMp :: !CHRPredOccEvidMp -- map from constraint/pred occurrence to evidence + , simpEvidMp :: !InfoToEvidenceMap -- map from constraint/pred occurrence to evidence , simpEnv :: !FIIn - , simpRes :: !(SimplifyResult CHRPredOcc RedHowAnnotation Guard VarMp) -- simplification work done at a previous call + , simpRes :: !(SimplifyResult) -- simplification work done at a previous call , simpErrs :: ![Err] -- errors } @@ -279,11 +280,11 @@ simplify' :: [SimplifyHow] - -> ScopedPredStore -- available CHR rules + -> CHRStore -- available CHR rules -> ClassDefaultGam -- environment/gam for defaulting - -> Heuristic CHRPredOcc RedHowAnnotation -- graph reduction heuristic + -> Heuristic -- graph reduction heuristic -> ([CHRIntermediateUntilAssume] -> ([CHRIntermediateUntilAssume],[CHRIntermediateUntilAssume])) -- partition into ambiguous predicates (and others), for defaulting - -> CHRPredOccCnstrMp -- constraints already proven a previous call + -> ConstraintToInfoMap -- constraints already proven a previous call -> State SimplifyState () simplify' simplifyHow chrStore clDfGam heur partitionUnresolved2AmbigAndOthers toProveHereCnstrMpPrev = do { s <- get @@ -368,12 +369,7 @@ ; 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 + where 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 @@ -415,20 +411,20 @@ simplify :: [SimplifyHow] -- config -> FIIn -- environment - -> ScopedPredStore -- available CHR rules + -> CHRStore -- available CHR rules -> ClassDefaultGam -- environment/gam for defaulting - -> Heuristic CHRPredOcc RedHowAnnotation -- graph reduction heuristic + -> Heuristic -- 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 + -> ConstraintToInfoMap -- constraints already proven a previous call + -> ConstraintToInfoMap -- constraints to prove + -> SimplifyResult -- simplification work done at a previous call + -> ( ConstraintToInfoMap -- canonicalized to be proven constraints + , ConstraintToInfoTraceMp -- remaining to be proven, as Assume's + , ConstraintToInfoTraceMp -- 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 + , SimplifyResult -- simplification work, for a next call + , InfoToEvidenceMap -- map from constraint/pred occurrence to evidence , EvidCBindL -- bindings which can be directly inserted , EvidKeyToCBindMap -- map from occurrence to binding, globally , PredScopeToCBindMap -- map from predscope to binding, per predscope opening/intro @@ -1149,7 +1145,7 @@ -mkPrvErr :: RangeMp -> Range -> CHRPredOccCnstrTraceMp -> [Err] +mkPrvErr :: RangeMp -> Range -> ConstraintToInfoTraceMp -> [Err] mkPrvErr rm r m = if Map.null m then [] @@ -1167,6 +1163,19 @@ +ppNestTrPP :: PP a => EHCOpts -> [a] -> [PP_Doc] -> [PP_Doc] -> TrPP -> PP_Doc +ppNestTrPP opts nms attrs ps trpp + = ppListSep "" "" "_" nms + >#< ( (if null attrs then empty else ppSpaced attrs) + >-< trpp + ) + >-< indent 2 (vlist ps) + +ppTrNm :: HsName -> PP_Doc +ppTrNm = text . show . show + + + tyGamLookupOrAdd :: UID -> HsName -> TyGam -> TyGam -> (TyGamInfo,TyGam) tyGamLookupOrAdd uniq nm tyGamLkup tyGam = case tyGamLookup nm tyGamLkup of @@ -1264,7 +1273,7 @@ type RangeMp = Map.Map Pred [Range] -cnstrMpToRangeMp :: CHRPredOccCnstrMp -> RangeMp +cnstrMpToRangeMp :: ConstraintToInfoMap -> RangeMp cnstrMpToRangeMp m = Map.unionsWith (++) [ Map.singleton (cpoPr p) [cpoRange p] | (Prove p) <- Map.keys m ] @@ -1356,7 +1365,7 @@ -- AGItf ------------------------------------------------------- -- semantic domain -type T_AGItf = ScopedPredStore -> +type T_AGItf = CHRStore -> ClassDefaultGam -> ClGam -> DataGam -> @@ -1372,7 +1381,7 @@ 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,TrPP) + ( ErrSq,CModule,UID,CHRStore,ClassDefaultGam,ClGam,DataGam,(Seq.Seq (HsName,IdOccKind)),KiGam,LamMp,ModEntRelFilterMp,PolGam,TyGam,TyKiGam,ValGam,(Maybe (Set.Set HsName)),PP_Doc,PP_Doc,PP_Doc,TrPP) -- CaseAlt ----------------------------------------------------- @@ -1399,12 +1408,12 @@ VarMp -> TyKiGam -> TyVarIdS -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_CaseAlt_5) + ( (Seq.FastSeq (CHRScopedInstanceDecl)),T_CaseAlt_5) type T_CaseAlt_5 = Ty -> VarMp -> ValGam -> ( VarMp,T_CaseAlt_6) -type T_CaseAlt_6 = ScopedPredStore -> +type T_CaseAlt_6 = CHRStore -> ClassDefaultGam -> FIOpts -> Ty -> @@ -1412,7 +1421,7 @@ TyVarIdS -> VarMp -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,VarMp,T_CaseAlt_7) + ( ConstraintToInfoMap,RangeMp,VarMp,T_CaseAlt_7) type T_CaseAlt_7 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1422,7 +1431,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,RAlt,RAlt,TrPP,Ty) + ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,PP_Doc,RAlt,RAlt,TrPP,Ty) -- CaseAlts ---------------------------------------------------- @@ -1449,20 +1458,20 @@ VarMp -> TyKiGam -> TyVarIdS -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_CaseAlts_5) + ( (Seq.FastSeq (CHRScopedInstanceDecl)),T_CaseAlts_5) type T_CaseAlts_5 = Ty -> Ty -> VarMp -> ValGam -> ( VarMp,Ty,T_CaseAlts_6) -type T_CaseAlts_6 = ScopedPredStore -> +type T_CaseAlts_6 = CHRStore -> ClassDefaultGam -> FIOpts -> VarMp -> TyVarIdS -> VarMp -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,VarMp,T_CaseAlts_7) + ( ConstraintToInfoMap,RangeMp,VarMp,T_CaseAlts_7) type T_CaseAlts_7 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1472,7 +1481,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,([PP_Doc]),([RAlt]),([RAlt]),TrPP) + ( ErrSq,CSubst,ErrSq,ModEntRelFilterMp,VarMp,Ty,PP_Doc,PP_Doc,([PP_Doc]),([RAlt]),([RAlt]),TrPP) -- DataConstr -------------------------------------------------- @@ -1496,10 +1505,10 @@ VarMp -> ValGam -> VarMp -> - ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,VarMp,ValGam,T_DataConstr_5) + ( ValGam,ValGam,ConstraintToInfoMap,RangeMp,VarMp,ValGam,T_DataConstr_5) type T_DataConstr_5 = EvidKeyToCBindMap -> PredScopeToCBindMap -> - ScopedPredStore -> + CHRStore -> ClassDefaultGam -> ClGam -> VarMp -> @@ -1518,7 +1527,7 @@ TyVarIdS -> ValGam -> TyVarIdS -> - ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,TrPP,CBindL,CBindL) + ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,PP_Doc,TrPP,CBindL,CBindL) -- DataConstrs ------------------------------------------------- @@ -1542,10 +1551,10 @@ VarMp -> ValGam -> VarMp -> - ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,VarMp,ValGam,T_DataConstrs_5) + ( ValGam,ValGam,ConstraintToInfoMap,RangeMp,VarMp,ValGam,T_DataConstrs_5) type T_DataConstrs_5 = EvidKeyToCBindMap -> PredScopeToCBindMap -> - ScopedPredStore -> + CHRStore -> ClassDefaultGam -> ClGam -> VarMp -> @@ -1564,7 +1573,7 @@ TyVarIdS -> ValGam -> TyVarIdS -> - ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,([PP_Doc]),TrPP,CBindL,CBindL) + ( ErrSq,ErrSq,CBindL,CBindL,ModEntRelFilterMp,VarMp,PP_Doc,PP_Doc,([PP_Doc]),TrPP,CBindL,CBindL) -- DataField --------------------------------------------------- @@ -1581,10 +1590,10 @@ ( TyKiGam,TyKiGam,T_DataField_4) type T_DataField_4 = Ty -> VarMp -> - ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,TyL,VarMp,T_DataField_5) + ( ValGam,ValGam,ConstraintToInfoMap,RangeMp,TyL,VarMp,T_DataField_5) type T_DataField_5 = EvidKeyToCBindMap -> PredScopeToCBindMap -> - ScopedPredStore -> + CHRStore -> ClassDefaultGam -> ClGam -> VarMp -> @@ -1604,7 +1613,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc,TrPP) + ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc,PP_Doc,TrPP) -- DataFieldExpr ----------------------------------------------- @@ -1633,8 +1642,8 @@ TyVarIdS -> ( DataGam,T_DataFieldExpr_5) type T_DataFieldExpr_5 = DataGam -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_DataFieldExpr_6) -type T_DataFieldExpr_6 = ScopedPredStore -> + ( (Seq.FastSeq (CHRScopedInstanceDecl)),T_DataFieldExpr_6) +type T_DataFieldExpr_6 = CHRStore -> ClassDefaultGam -> FIOpts -> VarMp -> @@ -1646,7 +1655,7 @@ type T_DataFieldExpr_7 = FIOpts -> Ty -> VarMp -> - ( CHRPredOccCnstrMp,RangeMp,TyVarIdS,Ty,VarMp,T_DataFieldExpr_8) + ( ConstraintToInfoMap,RangeMp,TyVarIdS,Ty,VarMp,T_DataFieldExpr_8) type T_DataFieldExpr_8 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1657,7 +1666,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,CSubst,CBindL,CExpr,ErrSq,(FieldUpdateL (DataTagInfo -> Int -> CExpr)),ModEntRelFilterMp,VarMp,(Maybe DataTagInfo),PP_Doc,([PP_Doc]),TrPP) + ( ErrSq,CSubst,CBindL,CExpr,ErrSq,(FieldUpdateL (DataTagInfo -> Int -> CExpr)),ModEntRelFilterMp,VarMp,(Maybe DataTagInfo),PP_Doc,PP_Doc,([PP_Doc]),TrPP) -- DataFieldPatExpr -------------------------------------------- @@ -1684,20 +1693,20 @@ VarMp -> TyKiGam -> TyVarIdS -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),T_DataFieldPatExpr_5) + ( (Seq.FastSeq (CHRScopedInstanceDecl)),T_DataFieldPatExpr_5) type T_DataFieldPatExpr_5 = FIOpts -> Ty -> VarMp -> ValGam -> ValGam -> ( VarMp,ValGam,T_DataFieldPatExpr_6) -type T_DataFieldPatExpr_6 = ScopedPredStore -> +type T_DataFieldPatExpr_6 = CHRStore -> ClassDefaultGam -> VarMp -> TyVarIdS -> VarMp -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_DataFieldPatExpr_7) + ( ConstraintToInfoMap,RangeMp,ScopeGam,Ty,VarMp,T_DataFieldPatExpr_7) type T_DataFieldPatExpr_7 = CSubst -> HsName -> EvidKeyToCBindMap -> @@ -1709,7 +1718,7 @@ ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> VarMp -> - ( ErrSq,CSubst,DataTagInfo,ErrSq,([HsName]),FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,([PP_Doc]),TrPP,CBindL) + ( ErrSq,CSubst,DataTagInfo,ErrSq,([HsName]),FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,PP_Doc,([PP_Doc]),TrPP,CBindL) -- DataFields -------------------------------------------------- @@ -1726,10 +1735,10 @@ ( TyKiGam,TyKiGam,T_DataFields_4) type T_DataFields_4 = Ty -> VarMp -> - ( ValGam,ValGam,CHRPredOccCnstrMp,RangeMp,TyL,VarMp,T_DataFields_5) + ( ValGam,ValGam,ConstraintToInfoMap,RangeMp,TyL,VarMp,T_DataFields_5) type T_DataFields_5 = EvidKeyToCBindMap -> PredScopeToCBindMap -> - ScopedPredStore -> + CHRStore -> ClassDefaultGam -> ClGam -> VarMp -> @@ -1749,7 +1758,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc,([PP_Doc]),TrPP) + ( ErrSq,ErrSq,ModEntRelFilterMp,VarMp,VarMp,PP_Doc,PP_Doc,([PP_Doc]),TrPP) -- Decl -------------------------------------------------------- @@ -1794,20 +1803,20 @@ 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) + ( (Seq.FastSeq (CHRClassDecl)),(Seq.FastSeq (CHRScopedInstanceDecl)),ClassDefaultGam,T_Decl_12) type T_Decl_12 = VarMp -> ValGam -> VarMp -> ValGam -> VarMp -> ( VarMp,ValGam,T_Decl_13) -type T_Decl_13 = ScopedPredStore -> +type T_Decl_13 = CHRStore -> ClassDefaultGam -> TyVarIdS -> VarMp -> ValGam -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decl_14) + ( ConstraintToInfoMap,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decl_14) type T_Decl_14 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1819,7 +1828,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,TrPP,CBindL,CBindL) + ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,PP_Doc,TrPP,CBindL,CBindL) -- Decls ------------------------------------------------------- @@ -1864,20 +1873,20 @@ 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) + ( (Seq.FastSeq (CHRClassDecl)),(Seq.FastSeq (CHRScopedInstanceDecl)),ClassDefaultGam,T_Decls_12) type T_Decls_12 = VarMp -> ValGam -> VarMp -> ValGam -> VarMp -> ( VarMp,ValGam,T_Decls_13) -type T_Decls_13 = ScopedPredStore -> +type T_Decls_13 = CHRStore -> ClassDefaultGam -> TyVarIdS -> VarMp -> ValGam -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decls_14) + ( ConstraintToInfoMap,RangeMp,TyKiGam,TyVarIdS,ScopeGam,VarMp,T_Decls_14) type T_Decls_14 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1889,7 +1898,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,TrPP,CBindL,CBindL) + ( ErrSq,([CExpr -> CExpr]),CSubst,ErrSq,CBindL,CBindL,(Seq.Seq (HsName,IdOccKind)),LamMp,ModEntRelFilterMp,VarMp,(Set.Set HsName),PP_Doc,PP_Doc,TrPP,CBindL,CBindL) -- Expr -------------------------------------------------------- @@ -1919,8 +1928,8 @@ 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 -> + ( (Seq.FastSeq (CHRClassDecl)),FIIn,(Seq.FastSeq (CHRScopedInstanceDecl)),ClassDefaultGam,T_Expr_6) +type T_Expr_6 = CHRStore -> ClassDefaultGam -> FIOpts -> Ty -> @@ -1929,7 +1938,7 @@ VarMp -> ValGam -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,ValGam,TyVarIdS,Ty,VarMp,T_Expr_7) + ( ConstraintToInfoMap,RangeMp,ValGam,TyVarIdS,Ty,VarMp,T_Expr_7) type T_Expr_7 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -1940,7 +1949,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( 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)]),CBindL,(Set.Set HsName),PP_Doc,TrPP) + ( 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)]),CBindL,(Set.Set HsName),PP_Doc,PP_Doc,TrPP) -- ExprAnn ----------------------------------------------------- @@ -1968,7 +1977,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,Range,TrPP) + ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,PP_Doc,Range,TrPP) -- FuncDeps ---------------------------------------------------- @@ -1991,7 +2000,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,([PP_Doc]),Range,TrPP) + ( ErrSq,ErrSq,([ClsFuncDep]),ModEntRelFilterMp,PP_Doc,PP_Doc,([PP_Doc]),Range,TrPP) -- KiExpr ------------------------------------------------------ @@ -2012,7 +2021,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,([PP_Doc]),HsName,PP_Doc,ErrSq,ModEntRelFilterMp,PP_Doc,TrPP) + ( ErrSq,([PP_Doc]),HsName,PP_Doc,ErrSq,ModEntRelFilterMp,PP_Doc,PP_Doc,TrPP) -- KiExprAnn --------------------------------------------------- @@ -2046,7 +2055,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,(Maybe PP_Doc),TrPP,TyGam,TyKiGam,TyVarWildMp) + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,PP_Doc,(Maybe PP_Doc),TrPP,TyGam,TyKiGam,TyVarWildMp) -- PatExpr ----------------------------------------------------- @@ -2073,7 +2082,7 @@ VarMp -> TyKiGam -> TyVarIdS -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),HsName,T_PatExpr_5) + ( (Seq.FastSeq (CHRScopedInstanceDecl)),HsName,T_PatExpr_5) type T_PatExpr_5 = ValGam -> ( Int,(Maybe HsName),Ty,T_PatExpr_6) type T_PatExpr_6 = FIOpts -> @@ -2083,13 +2092,13 @@ VarMp -> ValGam -> ( VarMp,ValGam,T_PatExpr_7) -type T_PatExpr_7 = ScopedPredStore -> +type T_PatExpr_7 = CHRStore -> ClassDefaultGam -> VarMp -> TyVarIdS -> VarMp -> TyVarIdS -> - ( RPatNm,CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_PatExpr_8) + ( RPatNm,ConstraintToInfoMap,RangeMp,ScopeGam,Ty,VarMp,T_PatExpr_8) type T_PatExpr_8 = CSubst -> HsName -> EvidKeyToCBindMap -> @@ -2101,7 +2110,7 @@ ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> VarMp -> - ( ErrSq,([PP_Doc]),HsName,PP_Doc,CSubst,ErrSq,FieldSplitL,ModEntRelFilterMp,VarMp,Bool,CPatRest,PP_Doc,RPat,TrPP,CBindL) + ( ErrSq,([PP_Doc]),HsName,PP_Doc,CSubst,ErrSq,FieldSplitL,ModEntRelFilterMp,VarMp,Bool,CPatRest,PP_Doc,PP_Doc,RPat,TrPP,CBindL) -- PatExprAnn -------------------------------------------------- @@ -2139,7 +2148,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,Pred,TrPP) + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,PP_Doc,Pred,TrPP) -- PrExprs ----------------------------------------------------- @@ -2164,7 +2173,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,HsNameS,HsNameS,ErrSq,UID,ModEntRelFilterMp,TyKiGam,VarMp,VarMp,PP_Doc,([PP_Doc]),([Pred]),Range,TrPP,TyGam,TyKiGam,TyL,TyVarWildMp) + ( ErrSq,HsNameS,HsNameS,ErrSq,UID,ModEntRelFilterMp,TyKiGam,VarMp,VarMp,PP_Doc,PP_Doc,([PP_Doc]),([Pred]),Range,TrPP,TyGam,TyKiGam,TyL,TyVarWildMp) -- RecExpr ----------------------------------------------------- @@ -2194,8 +2203,8 @@ ( 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 -> + ( (Seq.FastSeq (CHRScopedInstanceDecl)),([HsName]),T_RecExpr_6) +type T_RecExpr_6 = CHRStore -> ClassDefaultGam -> FIOpts -> Ty -> @@ -2204,7 +2213,7 @@ VarMp -> ValGam -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,TyVarIdS,VarMp,T_RecExpr_7) + ( ConstraintToInfoMap,RangeMp,TyVarIdS,VarMp,T_RecExpr_7) type T_RecExpr_7 = CSubst -> EvidKeyToCBindMap -> PredScopeToCBindMap -> @@ -2214,7 +2223,7 @@ RangeMp -> ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> - ( ErrSq,CSubst,ErrSq,HsName,(FieldUpdateL CExpr),ModEntRelFilterMp,VarMp,Bool,PP_Doc,([PP_Doc]),CExpr,TrPP,Ty) + ( ErrSq,CSubst,ErrSq,HsName,(FieldUpdateL CExpr),ModEntRelFilterMp,VarMp,Bool,PP_Doc,PP_Doc,([PP_Doc]),CExpr,TrPP,Ty) -- RecPatExpr -------------------------------------------------- @@ -2242,7 +2251,7 @@ TyKiGam -> ([HsName]) -> TyVarIdS -> - ( (Seq.FastSeq (CHRScopedInstanceDecl Pred RedHowAnnotation PredScope)),Bool,([HsName]),T_RecPatExpr_5) + ( (Seq.FastSeq (CHRScopedInstanceDecl)),Bool,([HsName]),T_RecPatExpr_5) type T_RecPatExpr_5 = FIOpts -> Ty -> Bool -> @@ -2250,13 +2259,13 @@ ValGam -> ValGam -> ( VarMp,ValGam,T_RecPatExpr_6) -type T_RecPatExpr_6 = ScopedPredStore -> +type T_RecPatExpr_6 = CHRStore -> ClassDefaultGam -> VarMp -> TyVarIdS -> VarMp -> TyVarIdS -> - ( CHRPredOccCnstrMp,RangeMp,ScopeGam,Ty,VarMp,T_RecPatExpr_7) + ( ConstraintToInfoMap,RangeMp,ScopeGam,Ty,VarMp,T_RecPatExpr_7) type T_RecPatExpr_7 = CSubst -> HsName -> EvidKeyToCBindMap -> @@ -2268,7 +2277,7 @@ ToSysfEnv -> (TraceOn -> [PP_Doc] -> TrPP) -> VarMp -> - ( ErrSq,CSubst,ErrSq,HsName,FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,([PP_Doc]),TrPP,CBindL) + ( ErrSq,CSubst,ErrSq,HsName,FieldSplitL,ModEntRelFilterMp,VarMp,CPatRest,PP_Doc,PP_Doc,([PP_Doc]),TrPP,CBindL) -- RowTyExpr --------------------------------------------------- @@ -2300,7 +2309,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,HsNameS,HsNameS,ErrSq,HsName,ModEntRelFilterMp,PP_Doc,([PP_Doc]),TrPP) + ( ErrSq,HsNameS,HsNameS,ErrSq,HsName,ModEntRelFilterMp,PP_Doc,PP_Doc,([PP_Doc]),TrPP) -- TyExpr ------------------------------------------------------ @@ -2333,7 +2342,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,([PP_Doc]),HsName,PP_Doc,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,TrPP,TyL) + ( ErrSq,([PP_Doc]),HsName,PP_Doc,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,PP_Doc,TrPP,TyL) -- TyExprAnn --------------------------------------------------- @@ -2369,7 +2378,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,([PP_Doc]),TrPP) + ( ErrSq,HsNameS,HsNameS,ErrSq,ModEntRelFilterMp,PP_Doc,PP_Doc,([PP_Doc]),TrPP) -- TyVar ------------------------------------------------------- @@ -2392,7 +2401,7 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,ModEntRelFilterMp,HsName,PP_Doc,TrPP) + ( ErrSq,ErrSq,ModEntRelFilterMp,HsName,PP_Doc,PP_Doc,TrPP) -- TyVars ------------------------------------------------------ @@ -2415,5 +2424,5 @@ TyVarIdS -> TyVarIdS -> TyVarIdS -> - ( ErrSq,ErrSq,ModEntRelFilterMp,([HsName]),PP_Doc,([PP_Doc]),TrPP) + ( ErrSq,ErrSq,ModEntRelFilterMp,([HsName]),PP_Doc,PP_Doc,([PP_Doc]),TrPP) diff --git a/src/UHC/Light/Compiler/EHC/BuildFunction/Run.hs b/src/UHC/Light/Compiler/EHC/BuildFunction/Run.hs --- a/src/UHC/Light/Compiler/EHC/BuildFunction/Run.hs +++ b/src/UHC/Light/Compiler/EHC/BuildFunction/Run.hs @@ -862,6 +862,9 @@ -- void $ cpOutputSomeModule (^. ecuEH) astHandler'_EH ASTFileContent_Text "" Cfg.suffixDotlessOutputTextualEh modNm liftIO $ putPPFPath (mkOutputFPath opts modNm (ecuFilePath ecu) Cfg.suffixDotlessOutputTextualEh) (EHSem.pp_Syn_AGItf ehSem) 1000 isTopMod <- bcall $ IsTopMod modSearchKey + when (isTopMod && EhOpt_DumpAST `elem` ehcOptEhOpts opts) $ + liftIO $ putPPFPath (mkOutputFPath opts modNm (ecuFilePath ecu) Cfg.suffixDotlessOutputTextualEhAST) (EHSem.ppAST_Syn_AGItf ehSem) 1000 + cpSetLimitErrsWhen 5 about errs breturn $ Just ehSem @@ -1070,7 +1073,7 @@ -- undefined result undefFor modNm = return $ panic $ "BuildFunction.Run.bcall (" ++ show bfun ++ ") undefined result related to " ++ show modNm -{-# LINE 1351 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1356 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- lens access st = crStateInfo ^* crsiBState cstk = st ^* bstateCallStack @@ -1107,7 +1110,7 @@ bmemo (Identity res) return res -{-# LINE 1393 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1398 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Make a Choice what to build, resolve newer/older choice bMkASTPMbChoice :: forall m . (EHCCompileRunner m) => BuildGlobal -> PrevFileSearchKey -> ASTPipe -> TmOfResM m -- EHCompilePhaseT m (Maybe (TmOfRes m)) bMkASTPMbChoice bglob modSearchKey astpipe = do @@ -1255,7 +1258,7 @@ if tm1 `diffClockTimes` mxtm2 > noTimeDiff then a1 t1 else a2 t2 _ -> adflt -{-# LINE 1562 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1567 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Build a AST result bRetAST :: forall m ast1 ast2 . (Typeable ast1, Typeable ast2, EHCCompileRunner m) => PrevFileSearchKey -> ASTPipe -> ast1 -> EHCompilePhaseT m (Maybe (ASTResult m ast2)) bRetAST modSearchKey astpipe ast1 = do @@ -1269,7 +1272,7 @@ ref = BRef_AST modSearchKey (astpType astpipe) _ -> return Nothing -{-# LINE 1577 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1582 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Execute a Choice what to build, having resolved newer/older choice bExecASTPMbChoice :: (Typeable ast, EHCCompileRunner m) => BuildGlobal -> PrevFileSearchKey -> ASTBuildPlan -> EHCompilePhaseT m (Maybe (ASTResult m ast)) bExecASTPMbChoice bglob modSearchKey@(PrevFileSearchKey {_pfsrchKey=FileSearchKey {_fsrchNm=modNm}}) astplan@(ASTBuildPlan {_astbplPipe=astpipe, _astbplChoice=choice}) = do @@ -1373,7 +1376,7 @@ where dflt = return Nothing -{-# LINE 1715 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1720 "src/ehc/EHC/BuildFunction/Run.chs" #-} bLiftASTPipeToASTBuildPlan :: (EHCCompileRunner m) => BuildGlobal @@ -1384,7 +1387,7 @@ maybeM (bcall $ BuildPlanPMb bglob modSearchKey astpipe) dflt $ \astplan -> f modSearchKey astplan -{-# LINE 1731 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1736 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Get AST from file, maybe... -- Wrapper around bcalls. bASTFromFileEither @@ -1431,7 +1434,7 @@ bASTFromFileMb modSearchKey chkTimeStamp asttype skey tkey = fmap (either (const Nothing) (Just . tup123to12)) $ bASTFromFileEither modSearchKey False chkTimeStamp asttype skey tkey -{-# LINE 1790 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1795 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Get possible Hs semantics bGetHsSemPlMb :: (EHCCompileRunner m) @@ -1446,7 +1449,7 @@ where extr (hsSem, _) = hsSem -{-# LINE 1814 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1819 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Dereference an indirection into compilation state, possibly with a result, and a setter bderef'' :: forall res m . (Typeable res, EHCCompileRunner m) => BRef m res -> EHCompilePhaseT m (Maybe res, Maybe (res -> EHCompilePhaseT m ())) bderef'' bref = do @@ -1502,11 +1505,11 @@ bderef bref = do fmap (panicJust $ "BuildFunction.Run.bderef " ++ show bref) $ bderef' bref -{-# LINE 1881 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1886 "src/ehc/EHC/BuildFunction/Run.chs" #-} type ASTFlowPred = ASTPipe -> Maybe (ASTPipe,ASTAlreadyFlowIntoCRSIFromToInfo) type ASTFlowPred' = Bool -> ASTFlowPred -{-# LINE 1886 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1891 "src/ehc/EHC/BuildFunction/Run.chs" #-} -- | Is a particular flow of semantics allowed? bIsAllowedFlowPl'' :: ASTBuildPlan -> ASTFlowPred -> Maybe (ASTBuildPlan, (ASTPipe,ASTAlreadyFlowIntoCRSIFromToInfo)) bIsAllowedFlowPl'' astplan astpred = astplFind astpred astplan @@ -1541,14 +1544,14 @@ return $ Just astplanFnd else return Nothing -{-# LINE 1922 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1927 "src/ehc/EHC/BuildFunction/Run.chs" #-} astpMbFromHSToEH, astpMbFromEHToCore, astpMbFromHS, astpMbFromEH :: ASTFlowPred' astpMbFromHSToEH top p = case p of {ASTPipe_Derived ASTType_EH p' | astpType p' == ASTType_HS -> Just (if' top p p', (Just ASTType_EH, ASTType_HS)); _ -> Nothing} astpMbFromEHToCore top p = case p of {ASTPipe_Derived ASTType_Core p' | astpType p' == ASTType_EH -> Just (if' top p p', (Just ASTType_Core, ASTType_EH)); _ -> Nothing} astpMbFromHS top p = case p of {ASTPipe_Derived _ p' | astpType p' == ASTType_HS -> Just (if' top p p', (Nothing, ASTType_HS)); _ -> Nothing} astpMbFromEH top p = case p of {ASTPipe_Derived _ p' | astpType p' == ASTType_EH -> Just (if' top p p', (Nothing, ASTType_EH)); _ -> Nothing} -{-# LINE 1935 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1940 "src/ehc/EHC/BuildFunction/Run.chs" #-} astpMbSrcCore, astpMbCachedCore, astpMbSrcCachedCore :: ASTFlowPred' astpMbSrcCore top p = case p of ASTPipe_Src ASTFileUse_Src _ ASTType_Core @@ -1562,7 +1565,7 @@ astpMbSrcCachedCore = astpMbSrcCore <|||> astpMbCachedCore -{-# LINE 1950 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1955 "src/ehc/EHC/BuildFunction/Run.chs" #-} astpMbSrcCoreRun, astpMbCachedCoreRun, astpMbSrcCachedCoreRun :: ASTFlowPred' astpMbSrcCoreRun top p = case p of ASTPipe_Src ASTFileUse_Src _ ASTType_CoreRun @@ -1576,15 +1579,15 @@ astpMbSrcCachedCoreRun = astpMbSrcCoreRun <|||> astpMbCachedCoreRun -{-# LINE 1965 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1970 "src/ehc/EHC/BuildFunction/Run.chs" #-} astpMbFromCoreToCoreRun :: ASTFlowPred' astpMbFromCoreToCoreRun top p = case p of {ASTPipe_Derived ASTType_CoreRun p' | astpType p' == ASTType_Core -> Just (if' top p p', (Just ASTType_CoreRun, ASTType_Core)); _ -> Nothing} -{-# LINE 1970 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1975 "src/ehc/EHC/BuildFunction/Run.chs" #-} astpMbCheckCoreRunToCoreRun :: ASTFlowPred' astpMbCheckCoreRunToCoreRun top p = case p of {ASTPipe_Trf ASTType_CoreRun ASTTrf_Check p' | astpType p' == ASTType_CoreRun -> Just (if' top p p', (Just ASTType_CoreRun, ASTType_CoreRun)); _ -> Nothing} -{-# LINE 1979 "src/ehc/EHC/BuildFunction/Run.chs" #-} +{-# LINE 1984 "src/ehc/EHC/BuildFunction/Run.chs" #-} f1 <||> f2 = \a -> f1 a <|> f2 a f1 <|||> f2 = \a b -> f1 a b <|> f2 a b diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs --- a/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Run.hs @@ -124,8 +124,8 @@ cpRunCoreRun5 bglob modSearchKey@(PrevFileSearchKey {_pfsrchKey=FileSearchKey {_fsrchNm=modNm}}) astplan@(ASTBuildPlan {_astbplPipe=astpipe}) = do maybeM (bcall $ ASTPlMb bglob modSearchKey astplan) (return ()) $ \(ASTResult {_astresAST=(mod :: AST_CoreRun)}) -> do -- debug - ecu <- bcall $ EcuOf modNm - cpOutputSomeModule (const mod) astHandler'_CoreRun ASTFileContent_Text "-cpRunCoreRun5" Cfg.suffixDotlessOutputTextualCoreRun (ecuModNm ecu) + -- ecu <- bcall $ EcuOf modNm + -- cpOutputSomeModule (const mod) astHandler'_CoreRun ASTFileContent_Text "-cpRunCoreRun5" Cfg.suffixDotlessOutputTextualCoreRun (ecuModNm ecu) crsi <- bcall $ CRSIOfNamePl bglob modSearchKey astplan let impModNmL = (crsi ^. crsiCoreRunState ^. crcrsiReqdModules) \\ [modNm] cpTrPP TraceOn_BldMod $ @@ -150,6 +150,8 @@ -} res <- liftIO $ runCoreRun2 opts impModL mod $ cmodRun opts mod either (\e -> cpSetLimitErrsWhen 1 "Run Core(Run) errors" [e]) - (\_ -> return ()) + (\r -> when (CoreRunOpt_PrintResult `Set.member` ehcOptCoreRunOpts opts) $ + liftIO $ putStrLn $ show $ pp r + ) res diff --git a/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs b/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs --- a/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs +++ b/src/UHC/Light/Compiler/EHC/CompilePhase/Translations.hs @@ -76,12 +76,15 @@ liftIO $ putPPFPath (mkOutputFPath opts modNm fp Cfg.suffixDotlessOutputTextualEh) (EHSem.pp_Syn_AGItf ehSem) 1000 ; when (ehcOptShowEH opts) (liftIO $ putWidthPPLn 120 (EHSem.pp_Syn_AGItf ehSem)) + ; when (_ecuIsTopMod ecu && EhOpt_DumpAST `elem` ehcOptEhOpts opts) $ + liftIO $ putPPFPath (mkOutputFPath opts modNm fp Cfg.suffixDotlessOutputTextualEhAST) (EHSem.ppAST_Syn_AGItf ehSem) 1000 + ; cpSetLimitErrsWhen 5 about errs } ) } -{-# LINE 192 "src/ehc/EHC/CompilePhase/Translations.chs" #-} +{-# LINE 197 "src/ehc/EHC/CompilePhase/Translations.chs" #-} cpTranslateEH2Core :: EHCCompileRunner m => HsName -> EHCompilePhaseT m () cpTranslateEH2Core modNm = do { cr <- get diff --git a/src/UHC/Light/Compiler/EHC/InitialSetup.hs b/src/UHC/Light/Compiler/EHC/InitialSetup.hs --- a/src/UHC/Light/Compiler/EHC/InitialSetup.hs +++ b/src/UHC/Light/Compiler/EHC/InitialSetup.hs @@ -18,7 +18,7 @@ import qualified UHC.Light.Compiler.HS.ModImpExp as HSSemMod import UHC.Light.Compiler.CodeGen.ImportUsedModules import UHC.Light.Compiler.CodeGen.ModuleImportExportImpl -import UHC.Light.Compiler.Pred.ToCHR (initScopedPredStore) +import UHC.Light.Compiler.Pred.ToCHR (initCHRStore) @@ -63,7 +63,7 @@ , EHSem.kiGam_Inh_AGItf = initKiGam , EHSem.clGam_Inh_AGItf = Pr.initClGam , EHSem.clDfGam_Inh_AGItf = emptyGam - , EHSem.chrStore_Inh_AGItf = initScopedPredStore + , EHSem.chrStore_Inh_AGItf = initCHRStore , EHSem.importUsedModules_Inh_AGItf = emptyImportUsedModules , EHSem.moduleImportExportImpl_Inh_AGItf = emptyModuleImportExportImpl } diff --git a/src/UHC/Light/Compiler/Foreign.hs b/src/UHC/Light/Compiler/Foreign.hs --- a/src/UHC/Light/Compiler/Foreign.hs +++ b/src/UHC/Light/Compiler/Foreign.hs @@ -205,7 +205,7 @@ 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) + deriving ( Eq,Show,Typeable) -- ForeignAGItf ------------------------------------------------ data ForeignAGItf = ForeignAGItf_AGItf {ent_ForeignAGItf_AGItf :: !(ForeignEnt)} -- ForeignEnt -------------------------------------------------- @@ -213,7 +213,7 @@ | ForeignEnt_PlainCall {ent_ForeignEnt_PlainCall :: !(PlainCall)} | ForeignEnt_PrimCall {ent_ForeignEnt_PrimCall :: !(PrimCall)} | ForeignEnt_JavaScriptCall {ent_ForeignEnt_JavaScriptCall :: !(JavaScriptCall)} - deriving ( Data,Eq,Show,Typeable) + deriving ( Eq,Show,Typeable) -- ForeignExpr ------------------------------------------------- data ForeignExpr = ForeignExpr_Call {expr_ForeignExpr_Call :: !(ForeignExpr)} | ForeignExpr_CallArgs {expr_ForeignExpr_CallArgs :: !(ForeignExpr),args_ForeignExpr_CallArgs :: !(ForeignExprs)} @@ -228,7 +228,7 @@ | ForeignExpr_Str {str_ForeignExpr_Str :: !(String)} | ForeignExpr_ObjData {} | ForeignExpr_NewObj {expr_ForeignExpr_NewObj :: !(ForeignExpr)} - deriving ( Data,Eq,Show,Typeable) + deriving ( Eq,Show,Typeable) -- ForeignExprAGItf -------------------------------------------- data ForeignExprAGItf = ForeignExprAGItf_AGItf {expr_ForeignExprAGItf_AGItf :: !(ForeignExpr)} -- ForeignExprs ------------------------------------------------ @@ -237,10 +237,10 @@ 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) + deriving ( Eq,Show,Typeable) -- PlainCall --------------------------------------------------- data PlainCall = PlainCall_Id {nm_PlainCall_Id :: !(String)} - deriving ( Data,Eq,Show,Typeable) + deriving ( Eq,Show,Typeable) -- PrimCall ---------------------------------------------------- data PrimCall = PrimCall_Id {nm_PrimCall_Id :: !(String),mbKnownPrim_PrimCall_Id :: !((Maybe KnownPrim))} - deriving ( Data,Eq,Show,Typeable) + deriving ( Eq,Show,Typeable) diff --git a/src/UHC/Light/Compiler/Foreign/Boxing.hs b/src/UHC/Light/Compiler/Foreign/Boxing.hs --- a/src/UHC/Light/Compiler/Foreign/Boxing.hs +++ b/src/UHC/Light/Compiler/Foreign/Boxing.hs @@ -162,12 +162,10 @@ {-# 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" #-} +{-# LINE 210 "src/ehc/Foreign/Boxing.chs" #-} instance Serialize Boxing where sput (Boxing_UnboxedTy a) = sputWord8 0 >> sput a sput (Boxing_Enum ) = sputWord8 1 diff --git a/src/UHC/Light/Compiler/Gam.hs b/src/UHC/Light/Compiler/Gam.hs --- a/src/UHC/Light/Compiler/Gam.hs +++ b/src/UHC/Light/Compiler/Gam.hs @@ -128,28 +128,30 @@ 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 +{-# LINE 237 "src/ehc/Gam.chs" #-} +instance (Ord tk, Ord (SubstVarKey subst), 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 +type instance ExtrValVarKey (SGam tk vv) = ExtrValVarKey vv + +instance (Ord tk, Ord (ExtrValVarKey vv), VarExtractable vv) => VarExtractable (SGam tk vv) where varFreeSet g = Set.unions $ map varFreeSet $ gamElts g -{-# LINE 251 "src/ehc/Gam.chs" #-} +{-# LINE 255 "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" #-} +{-# LINE 260 "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" #-} +{-# LINE 270 "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" #-} +{-# LINE 279 "src/ehc/Gam.chs" #-} initSoGam :: SoGam initSoGam = assocLToGam diff --git a/src/UHC/Light/Compiler/Gam/ClGam.hs b/src/UHC/Light/Compiler/Gam/ClGam.hs --- a/src/UHC/Light/Compiler/Gam/ClGam.hs +++ b/src/UHC/Light/Compiler/Gam/ClGam.hs @@ -40,9 +40,8 @@ {-# LINE 70 "src/ehc/Gam/ClGam.chs" #-} deriving instance Typeable ClGamInfo -deriving instance Data ClGamInfo -{-# LINE 75 "src/ehc/Gam/ClGam.chs" #-} +{-# LINE 74 "src/ehc/Gam/ClGam.chs" #-} instance PP ClGamInfo where pp clgi = "dictnm=" >#< pp (clgiDfltDictNm clgi) >-< indent 2 ( "rule=" >#< ppTy (clgiRuleTy clgi) @@ -51,13 +50,13 @@ >-< "clgiGenerDerivableL=" >#< ppAssocL (clgiGenerDerivableL clgi) ) -{-# LINE 87 "src/ehc/Gam/ClGam.chs" #-} +{-# LINE 86 "src/ehc/Gam/ClGam.chs" #-} initClGam = assocLToGam [ (hsnPrArrow, emptyCLGI) ] -{-# LINE 102 "src/ehc/Gam/ClGam.chs" #-} +{-# LINE 101 "src/ehc/Gam/ClGam.chs" #-} instance Serialize ClGamInfo where sput (ClGamInfo a b c d e f) = sput a >> sput b >> sput c >> sput d >> sput e >> sput f sget = liftM6 ClGamInfo sget sget sget sget sget sget diff --git a/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs b/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs --- a/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs +++ b/src/UHC/Light/Compiler/Gam/ClassDefaultGam.hs @@ -9,6 +9,7 @@ import UHC.Light.Compiler.Gam import UHC.Light.Compiler.Ty import UHC.Light.Compiler.VarMp +import UHC.Util.Substitutable import UHC.Light.Compiler.Ty.FitsInCommon2 import UHC.Light.Compiler.Ty.FitsIn import Data.Maybe @@ -18,23 +19,24 @@ -{-# LINE 32 "src/ehc/Gam/ClassDefaultGam.chs" #-} +{-# LINE 34 "src/ehc/Gam/ClassDefaultGam.chs" #-} -- If this changes, also change {%{EH}ConfigInternalVersions} data ClassDefaultGamInfo = ClassDefaultGamInfo { cldiDefaultTypes :: [Ty] } - deriving (Data,Typeable) + deriving (Typeable) -{-# LINE 43 "src/ehc/Gam/ClassDefaultGam.chs" #-} +{-# LINE 45 "src/ehc/Gam/ClassDefaultGam.chs" #-} type ClassDefaultGam = Gam HsName ClassDefaultGamInfo -{-# LINE 51 "src/ehc/Gam/ClassDefaultGam.chs" #-} +{-# LINE 53 "src/ehc/Gam/ClassDefaultGam.chs" #-} -- | Lookup a matching default for a predicate clDfGamLookupDefault :: ( VarLookup gm TyVarId VarMpInfo -- , VarLookup gm Ty VarMpInfo , VarLookupCmb VarMp gm + , SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo ) => FIIn' gm -> Pred -> ClassDefaultGam -> Maybe VarMp @@ -47,7 +49,7 @@ where mbConArgs@(~(Just (nm,args))) = appMbConApp t _ -> Nothing -{-# LINE 74 "src/ehc/Gam/ClassDefaultGam.chs" #-} +{-# LINE 77 "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 --- a/src/UHC/Light/Compiler/Gam/DataGam.hs +++ b/src/UHC/Light/Compiler/Gam/DataGam.hs @@ -310,25 +310,19 @@ {-# LINE 412 "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 429 "src/ehc/Gam/DataGam.chs" #-} +{-# LINE 424 "src/ehc/Gam/DataGam.chs" #-} deriving instance Typeable DataGamInfoVariant -deriving instance Data DataGamInfoVariant -{-# LINE 434 "src/ehc/Gam/DataGam.chs" #-} +{-# LINE 428 "src/ehc/Gam/DataGam.chs" #-} instance Serialize DataGamInfoVariant where sput (DataGamInfoVariant_Plain ) = sputWord8 0 sput (DataGamInfoVariant_Newtype a) = sputWord8 1 >> sput a @@ -340,7 +334,7 @@ 1 -> liftM DataGamInfoVariant_Newtype sget 2 -> return DataGamInfoVariant_Rec -{-# LINE 451 "src/ehc/Gam/DataGam.chs" #-} +{-# LINE 445 "src/ehc/Gam/DataGam.chs" #-} instance Serialize DataFldInfo where sput (DataFldInfo a) = sput a sget = liftM DataFldInfo sget diff --git a/src/UHC/Light/Compiler/Gam/FixityGam.hs b/src/UHC/Light/Compiler/Gam/FixityGam.hs --- a/src/UHC/Light/Compiler/Gam/FixityGam.hs +++ b/src/UHC/Light/Compiler/Gam/FixityGam.hs @@ -31,14 +31,12 @@ {-# LINE 49 "src/ehc/Gam/FixityGam.chs" #-} deriving instance Typeable FixityGamInfo -deriving instance Data FixityGamInfo - -{-# LINE 55 "src/ehc/Gam/FixityGam.chs" #-} +{-# LINE 53 "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" #-} +{-# LINE 62 "src/ehc/Gam/FixityGam.chs" #-} initFixityGam :: FixityGam initFixityGam = assocLToGam @@ -47,7 +45,7 @@ , (hsnEqTilde, FixityGamInfo 3 Fixity_Infix ) ] -{-# LINE 90 "src/ehc/Gam/FixityGam.chs" #-} +{-# LINE 88 "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/PolGam.hs b/src/UHC/Light/Compiler/Gam/PolGam.hs --- a/src/UHC/Light/Compiler/Gam/PolGam.hs +++ b/src/UHC/Light/Compiler/Gam/PolGam.hs @@ -43,9 +43,8 @@ {-# LINE 55 "src/ehc/Gam/PolGam.chs" #-} deriving instance Typeable PolGamInfo -deriving instance Data PolGamInfo -{-# LINE 60 "src/ehc/Gam/PolGam.chs" #-} +{-# LINE 59 "src/ehc/Gam/PolGam.chs" #-} polGamLookup :: HsName -> PolGam -> Maybe PolGamInfo polGamLookup = gamLookup @@ -55,7 +54,7 @@ Nothing -> (emptyPGI,[rngLift emptyRange mkErr_NamesNotIntrod "polarity" [n]]) Just i -> (i,[]) -{-# LINE 75 "src/ehc/Gam/PolGam.chs" #-} +{-# LINE 74 "src/ehc/Gam/PolGam.chs" #-} initPolGam :: PolGam initPolGam = assocLToGam @@ -81,19 +80,21 @@ var = mkPolVar u quantvar = quant var -{-# LINE 114 "src/ehc/Gam/PolGam.chs" #-} +{-# LINE 113 "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 +type instance ExtrValVarKey PolGamInfo = TyVarId + +instance VarExtractable PolGamInfo where varFreeSet pgi = varFreeSet (pgiPol pgi) -{-# LINE 123 "src/ehc/Gam/PolGam.chs" #-} +{-# LINE 124 "src/ehc/Gam/PolGam.chs" #-} instance PP PolGamInfo where pp i = ppTy (pgiPol i) -{-# LINE 136 "src/ehc/Gam/PolGam.chs" #-} +{-# LINE 137 "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/TyGam.hs b/src/UHC/Light/Compiler/Gam/TyGam.hs --- a/src/UHC/Light/Compiler/Gam/TyGam.hs +++ b/src/UHC/Light/Compiler/Gam/TyGam.hs @@ -41,37 +41,36 @@ {-# LINE 51 "src/ehc/Gam/TyGam.chs" #-} deriving instance Typeable TyGamInfo -deriving instance Data TyGamInfo -{-# LINE 56 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 55 "src/ehc/Gam/TyGam.chs" #-} mkTGIData :: Ty -> Ty -> TyGamInfo mkTGIData t _ = TyGamInfo t -{-# LINE 61 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 60 "src/ehc/Gam/TyGam.chs" #-} mkTGI :: Ty -> TyGamInfo mkTGI t = mkTGIData t Ty_Any -{-# LINE 66 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 65 "src/ehc/Gam/TyGam.chs" #-} emptyTGI :: TyGamInfo emptyTGI = TyGamInfo Ty_Any -{-# LINE 75 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 74 "src/ehc/Gam/TyGam.chs" #-} type TyGam = Gam HsName TyGamInfo -{-# LINE 93 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 92 "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" #-} +{-# LINE 115 "src/ehc/Gam/TyGam.chs" #-} tyGamLookup :: HsName -> TyGam -> Maybe TyGamInfo tyGamLookup = gamLookup -{-# LINE 142 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 141 "src/ehc/Gam/TyGam.chs" #-} initTyGam :: TyGam initTyGam = assocLToGam @@ -87,19 +86,21 @@ , (hsnAddrUnboxed , mkTGI (appCon hsnAddrUnboxed ) ) ] -{-# LINE 218 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 217 "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 +type instance ExtrValVarKey TyGamInfo = TyVarId + +instance VarExtractable TyGamInfo where varFreeSet tgi = varFreeSet (tgiTy tgi) -{-# LINE 229 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 230 "src/ehc/Gam/TyGam.chs" #-} instance PP TyGamInfo where pp tgi = ppTy (tgiTy tgi) -{-# LINE 242 "src/ehc/Gam/TyGam.chs" #-} +{-# LINE 243 "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 --- a/src/UHC/Light/Compiler/Gam/TyKiGam.hs +++ b/src/UHC/Light/Compiler/Gam/TyKiGam.hs @@ -50,16 +50,15 @@ {-# LINE 60 "src/ehc/Gam/TyKiGam.chs" #-} deriving instance Typeable TyKiGamInfo -deriving instance Data TyKiGamInfo -{-# LINE 65 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 64 "src/ehc/Gam/TyKiGam.chs" #-} tkgiGetSet = (tkgiKi,(\x i -> i {tkgiKi = x})) -{-# LINE 69 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 68 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamLookupByTyVar :: TyVarId -> TyKiGam -> Maybe TyKiGamInfo tyKiGamLookupByTyVar v g = gamLookup (TyKiKey_TyVar v) g -{-# LINE 74 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 73 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamLookupByName :: HsName -> TyKiGam -> Maybe TyKiGamInfo tyKiGamLookupByName n g = case gamLookup (TyKiKey_Name n) g of @@ -68,7 +67,7 @@ -> Just (TyKiGamInfo (replicate (hsnProdArity n) kiStar `appArr` kiStar)) x -> x -{-# LINE 88 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 87 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamLookup :: Ty -> TyKiGam -> Maybe TyKiGamInfo tyKiGamLookup t g = case tyMbVar t of @@ -78,7 +77,7 @@ Just n -> tyKiGamLookupByName n g _ -> Nothing -{-# LINE 99 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 98 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamLookupErr :: Ty -> TyKiGam -> (TyKiGamInfo,ErrL) tyKiGamLookupErr t g = case tyKiGamLookup t g of @@ -88,19 +87,19 @@ tyKiGamLookupKi :: TyKiGam -> Ty -> Ty tyKiGamLookupKi g t = tkgiKi $ fst $ tyKiGamLookupErr t g -{-# LINE 110 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 109 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamLookupByNameErr :: HsName -> TyKiGam -> (TyKiGamInfo,ErrL) tyKiGamLookupByNameErr n g = tyKiGamLookupErr (appCon n) g -{-# LINE 115 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 114 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamVarSingleton :: TyVarId -> TyKiGamInfo -> TyKiGam tyKiGamVarSingleton v k = gamSingleton (TyKiKey_TyVar v) k -{-# LINE 120 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 119 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamNameSingleton :: HsName -> TyKiGamInfo -> TyKiGam tyKiGamNameSingleton n k = gamSingleton (TyKiKey_Name n) k -{-# LINE 125 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 124 "src/ehc/Gam/TyKiGam.chs" #-} tyKiGamSingleton :: Ty -> TyKiGamInfo -> TyKiGam tyKiGamSingleton t k = case tyMbVar t of @@ -109,12 +108,12 @@ Just n -> tyKiGamNameSingleton n k _ -> panic "Gam.tyKiGamSingleton" -{-# LINE 135 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 134 "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 151 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 150 "src/ehc/Gam/TyKiGam.chs" #-} tvarKi :: TyKiGam -> TyKiGam -> VarMp -> VarMp -> TyVarId -> Ty tvarKi tyKiGam1 tyKiGam2 tvKiVarMp _ tv = case tyKiGamLookup tv' tyKiGam1 <|> tyKiGamLookup tv' tyKiGam2 of @@ -122,7 +121,7 @@ _ -> tvKiVarMp `varUpd` tv' where tv' = {- tyVarMp `varUpd` -} mkTyVar tv -{-# LINE 164 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 163 "src/ehc/Gam/TyKiGam.chs" #-} initTyKiGam :: TyKiGam initTyKiGam = gamUnions @@ -142,19 +141,21 @@ ] where star = TyKiGamInfo kiStar -{-# LINE 223 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 222 "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 +type instance ExtrValVarKey TyKiGamInfo = TyVarId + +instance VarExtractable TyKiGamInfo where varFreeSet tkgi = varFreeSet (tkgiKi tkgi) -{-# LINE 232 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 233 "src/ehc/Gam/TyKiGam.chs" #-} instance PP TyKiGamInfo where pp i = ppTy (tkgiKi i) -{-# LINE 245 "src/ehc/Gam/TyKiGam.chs" #-} +{-# LINE 246 "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/ValGam.hs b/src/UHC/Light/Compiler/Gam/ValGam.hs --- a/src/UHC/Light/Compiler/Gam/ValGam.hs +++ b/src/UHC/Light/Compiler/Gam/ValGam.hs @@ -43,24 +43,23 @@ {-# LINE 52 "src/ehc/Gam/ValGam.chs" #-} deriving instance Typeable ValGamInfo -deriving instance Data ValGamInfo -{-# LINE 57 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 56 "src/ehc/Gam/ValGam.chs" #-} vgiGetSet = (vgiTy,(\x i -> i {vgiTy = x})) -{-# LINE 66 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 65 "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" #-} +{-# LINE 73 "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" #-} +{-# LINE 79 "src/ehc/Gam/ValGam.chs" #-} valGamLookup :: HsName -> ValGam -> Maybe ValGamInfo valGamLookup nm g = case gamLookup nm g of @@ -74,23 +73,23 @@ Just vgi -> Just vgi _ -> Nothing -{-# LINE 102 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 101 "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" #-} +{-# LINE 106 "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" #-} +{-# LINE 117 "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" #-} +{-# LINE 125 "src/ehc/Gam/ValGam.chs" #-} valGamTyOfDataFld :: HsName -> ValGam -> (Ty,Ty,ErrL) valGamTyOfDataFld fldNm g | null e = (t,rt,e) @@ -99,19 +98,21 @@ ((rt:_),_) = appUnArr t -{-# LINE 145 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 144 "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 +type instance ExtrValVarKey ValGamInfo = TyVarId + +instance VarExtractable ValGamInfo where varFreeSet vgi = varFreeSet (vgiTy vgi) -{-# LINE 156 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 157 "src/ehc/Gam/ValGam.chs" #-} instance PP ValGamInfo where pp vgi = ppTy (vgiTy vgi) -{-# LINE 169 "src/ehc/Gam/ValGam.chs" #-} +{-# LINE 170 "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/HI.hs b/src/UHC/Light/Compiler/HI.hs --- a/src/UHC/Light/Compiler/HI.hs +++ b/src/UHC/Light/Compiler/HI.hs @@ -94,11 +94,11 @@ , hiiDataGam :: !DataGam -- datatype info env , hiiClGam :: !Pr.ClGam -- class env , hiiClDfGam :: !ClassDefaultGam -- class defaults env - , hiiCHRStore :: !ScopedPredStore -- rule database + , hiiCHRStore :: !CHRStore -- rule database , hiiLamMp :: !LamMp -- codegen info for identifiers , hiiImpHIMp :: !ImpHIMp -- cache of HIInfo's of imported modules, filtered for visibility } - deriving (Typeable, Data) + deriving (Typeable) {-# LINE 145 "src/ehc/HI.chs" #-} emptyHIInfo :: HIInfo @@ -247,7 +247,7 @@ data HIOrigin = HIOrigin_FromFile -- from .hi file | HIOrigin_FromImportedBy HsNameS -- reconstructed from modules which imported this hi - deriving (Eq,Show,Typeable,Data) + deriving (Eq,Show,Typeable) {-# LINE 374 "src/ehc/HI.chs" #-} data HIValidity @@ -255,7 +255,7 @@ | HIValidity_WrongMagic -- wrong magic number | HIValidity_Inconsistent -- inconsistent with compiler | HIValidity_Absent -- not available - deriving (Eq,Enum,Show,Typeable,Data) + deriving (Eq,Enum,Show,Typeable) {-# LINE 387 "src/ehc/HI.chs" #-} gamFlatten :: Ord k => Gam k v -> Gam k v diff --git a/src/UHC/Light/Compiler/LamInfo.hs b/src/UHC/Light/Compiler/LamInfo.hs --- a/src/UHC/Light/Compiler/LamInfo.hs +++ b/src/UHC/Light/Compiler/LamInfo.hs @@ -16,10 +16,9 @@ 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 UHC.Light.Compiler.Ty.Pretty import qualified Data.Map as Map import qualified Data.Set as Set import Control.Monad @@ -27,37 +26,34 @@ -{-# LINE 66 "src/ehc/LamInfo.chs" #-} +{-# 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 + , Typeable ) -{-# LINE 78 "src/ehc/LamInfo.chs" #-} +{-# 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 + , Typeable ) -{-# LINE 89 "src/ehc/LamInfo.chs" #-} +{-# LINE 91 "src/ehc/LamInfo.chs" #-} instance PP FusionRole where pp r = pp $ drop l $ show r where l = length "FusionRole_" -{-# LINE 95 "src/ehc/LamInfo.chs" #-} +{-# LINE 97 "src/ehc/LamInfo.chs" #-} -- | per aspect info data LamInfoBindAsp - = LamInfoBindAsp_RelevTy -- relevance typing - { libindaspRelevTy :: !RelevTy - } - | LamInfoBindAsp_Ty -- plain good old type + = LamInfoBindAsp_Ty -- plain good old type { libindaspTy :: !Ty } | LamInfoBindAsp_Core -- actual Core, should go paired with Ty (?? maybe pair them directly) @@ -68,19 +64,18 @@ { libindaspFusionRole :: !FusionRole } deriving ( Show - , Data, Typeable + , Typeable ) type LamInfoBindAspMp = Map.Map ACoreBindAspectKeyS LamInfoBindAsp -{-# LINE 127 "src/ehc/LamInfo.chs" #-} +{-# LINE 131 "src/ehc/LamInfo.chs" #-} instance PP LamInfoBindAsp where - pp (LamInfoBindAsp_RelevTy t) = "RTy" >#< pp t - pp (LamInfoBindAsp_Ty t) = "Ty" >#< pp t + pp (LamInfoBindAsp_Ty t) = "Ty" >#< ppTy 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 137 "src/ehc/LamInfo.chs" #-} +{-# LINE 143 "src/ehc/LamInfo.chs" #-} -- | per lambda implementation info data LamInfo = LamInfo @@ -89,7 +84,7 @@ , laminfoBindAspMp :: !LamInfoBindAspMp -- info organized per/keyed on aspect } deriving ( Show - , Data, Typeable + , Typeable ) emptyLamInfo' :: LamInfo @@ -102,22 +97,22 @@ = LamInfo 0 StackTraceInfo_None Map.empty -{-# LINE 171 "src/ehc/LamInfo.chs" #-} +{-# LINE 177 "src/ehc/LamInfo.chs" #-} instance PP LamInfo where pp (LamInfo {laminfoBindAspMp=m}) = ppAssocL $ assocLMapKey ppACBaspKeyS $ Map.toList m -{-# LINE 176 "src/ehc/LamInfo.chs" #-} +{-# LINE 182 "src/ehc/LamInfo.chs" #-} laminfo1stArgIsStackTrace :: LamInfo -> Bool laminfo1stArgIsStackTrace (LamInfo {laminfoStackTrace=StackTraceInfo_IsStackTraceEquiv _}) = True laminfo1stArgIsStackTrace _ = False -{-# LINE 188 "src/ehc/LamInfo.chs" #-} +{-# LINE 194 "src/ehc/LamInfo.chs" #-} type LamMp = Map.Map HsName LamInfo emptyLamMp :: LamMp emptyLamMp = Map.empty -{-# LINE 195 "src/ehc/LamInfo.chs" #-} +{-# LINE 201 "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}) @@ -125,7 +120,7 @@ lamMpUnionsBindAspMp :: [LamMp] -> LamMp lamMpUnionsBindAspMp = foldr lamMpUnionBindAspMp Map.empty -{-# LINE 204 "src/ehc/LamInfo.chs" #-} +{-# LINE 210 "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 @@ -135,7 +130,7 @@ (\n i -> maybe i (mergeL2RInfo i) $ Map.lookup n prevMp ) newMp -{-# LINE 226 "src/ehc/LamInfo.chs" #-} +{-# LINE 232 "src/ehc/LamInfo.chs" #-} lamMpLookupAsp :: HsName -> ACoreBindAspectKeyS -> LamMp -> Maybe LamInfoBindAsp lamMpLookupAsp n a m = fmap snd $ mapLookup2' laminfoBindAspMp n a m @@ -157,14 +152,14 @@ -> Just a _ -> Nothing -{-# LINE 249 "src/ehc/LamInfo.chs" #-} +{-# LINE 255 "src/ehc/LamInfo.chs" #-} lamMpFilterLam :: LamMp -> LamMp lamMpFilterLam = Map.filter ((>0) . laminfoArity) lamMpFilterCaf :: LamMp -> LamMp lamMpFilterCaf = Map.filter ((==0) . laminfoArity) -{-# LINE 257 "src/ehc/LamInfo.chs" #-} +{-# LINE 263 "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 @@ -180,25 +175,23 @@ upd z Nothing = set (Just (merge z emptyExtra )) empty emptyExtra = panicJust "lamMpMergeFrom" $ get $ empty -{-# LINE 314 "src/ehc/LamInfo.chs" #-} +{-# LINE 320 "src/ehc/LamInfo.chs" #-} initLamMp :: LamMp initLamMp = emptyLamMp -{-# LINE 343 "src/ehc/LamInfo.chs" #-} +{-# LINE 349 "src/ehc/LamInfo.chs" #-} instance Serialize FusionRole where sput = sputEnum8 sget = sgetEnum8 -{-# LINE 349 "src/ehc/LamInfo.chs" #-} +{-# LINE 355 "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 diff --git a/src/UHC/Light/Compiler/Module/ImportExport.hs b/src/UHC/Light/Compiler/Module/ImportExport.hs --- a/src/UHC/Light/Compiler/Module/ImportExport.hs +++ b/src/UHC/Light/Compiler/Module/ImportExport.hs @@ -76,9 +76,8 @@ {-# LINE 95 "src/ehc/Module/ImportExport.chs" #-} deriving instance Typeable ModEnt -deriving instance Data ModEnt -{-# LINE 100 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 99 "src/ehc/Module/ImportExport.chs" #-} -- intended for parsing ppModEnt :: ModEnt -> PP_Doc ppModEnt e @@ -91,14 +90,14 @@ ppModEntRel = ppCurlysAssocL pp ppModEnt . Rel.toList -{-# LINE 116 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 115 "src/ehc/Module/ImportExport.chs" #-} instance PP ModEnt where pp = ppModEnt instance PP ModEntRel where pp = ppModEntRel -{-# LINE 128 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 127 "src/ehc/Module/ImportExport.chs" #-} -- | names used per category of identifier type ModEntRelFilterMp = Map.Map IdOccKind HsNameS @@ -122,12 +121,12 @@ mentrelToFilterMp :: [HsName] -> ModEntRel -> ModEntRelFilterMp mentrelToFilterMp = mentrelToFilterMp' True -{-# LINE 153 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 152 "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" #-} +{-# LINE 158 "src/ehc/Module/ImportExport.chs" #-} -- | construct a singleton, only not of the current module mentrelFilterMpSingleton :: [HsName] -> IdOccKind -> HsName -> ModEntRelFilterMp mentrelFilterMpSingleton exclModNmL k n @@ -137,7 +136,7 @@ where _ -> Map.empty -{-# LINE 174 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 173 "src/ehc/Module/ImportExport.chs" #-} data ModExp = ModExpEnt !ModEntSpec | ModExpMod !HsName @@ -167,7 +166,7 @@ emptyModImp = ModImp False hsnUnknown hsnUnknown True [] emptyRange -{-# LINE 205 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 204 "src/ehc/Module/ImportExport.chs" #-} modImpBuiltin :: ModImp modImpBuiltin = emptyModImp @@ -175,7 +174,7 @@ , mimpAs = hsnModBuiltin } -{-# LINE 214 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 213 "src/ehc/Module/ImportExport.chs" #-} modImpPrelude :: ModImp modImpPrelude = emptyModImp @@ -183,7 +182,7 @@ , mimpAs = hsnModPrelude } -{-# LINE 223 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 222 "src/ehc/Module/ImportExport.chs" #-} instance PP ModExp where pp (ModExpEnt s) = pp s pp (ModExpMod m) = "module" >#< m @@ -198,7 +197,7 @@ instance PP ModImp where pp i = mimpSource i >|< ppParensCommas (mimpImpL i) -{-# LINE 243 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 242 "src/ehc/Module/ImportExport.chs" #-} data Mod = Mod { modName :: !HsName @@ -214,7 +213,7 @@ emptyMod' n = Mod n Nothing Nothing [] Rel.empty Rel.empty [] emptyMod = emptyMod' hsnUnknown -{-# LINE 260 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 259 "src/ehc/Module/ImportExport.chs" #-} modBuiltin = emptyMod { modName = hsnModBuiltin @@ -224,7 +223,7 @@ = 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" #-} +{-# LINE 270 "src/ehc/Module/ImportExport.chs" #-} instance PP Mod where pp m = modName m >|< "/" >|< modNameInSrc m >-< indent 2 ( "IMP" >#< ppParensCommas (modImpL m) @@ -233,7 +232,7 @@ >-< "DEF" >#< pp (modDefs m) ) -{-# LINE 285 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 284 "src/ehc/Module/ImportExport.chs" #-} modEntSpec :: Bool -> ModEntRel -> ModEntSpec -> ModEntRel modEntSpec isHiding rel (ModEntSpec x _ subspec) | isHiding && isNothing subspec @@ -247,7 +246,7 @@ where allSubs = mentOwns `unionMapSet` Rel.rng spec subs = Rel.restrictRng (`Set.member` allSubs) rel -{-# LINE 304 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 303 "src/ehc/Module/ImportExport.chs" #-} modExports :: Mod -> ModEntRel -> ModEntRel modExports mod inscp = case modExpL mod of @@ -255,7 +254,7 @@ Just es -> hsnQualified `Rel.mapDom` Rel.unions exps where exps = modExpListEntry inscp `map` es -{-# LINE 313 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 312 "src/ehc/Module/ImportExport.chs" #-} modExpListEntry :: ModEntRel -> ModExp -> ModEntRel modExpListEntry inscp (ModExpEnt it) = modEntSpec False inscp it @@ -263,7 +262,7 @@ = (hsnSetQual m `Rel.mapDom` unqs) `Rel.intersection` qs where (qs,unqs) = Rel.partitionDom hsnIsQual inscp -{-# LINE 326 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 325 "src/ehc/Module/ImportExport.chs" #-} modInscope :: Mod -> (HsName -> ModEntRel) -> ModEntRel modInscope m expsOf = Rel.unions [imports,locals] @@ -279,7 +278,7 @@ = -- (\v -> tr "modInscope.impOf: " (modName m >#< n >#< v) v) $ modImp e n -{-# LINE 343 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 342 "src/ehc/Module/ImportExport.chs" #-} modImp :: (HsName -> ModEntRel) -> ModImp -> ModEntRel modImp expsOf imp | mimpQualified imp = qs @@ -293,7 +292,7 @@ | isHiding = exps `Rel.difference` listed | otherwise = listed -{-# LINE 362 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 361 "src/ehc/Module/ImportExport.chs" #-} modInsOuts :: (HsName -> ModEntRel) -> [Mod] -> [(ModEntRel,ModEntRel)] modInsOuts otherExps mods = inscps `zip` exps @@ -305,13 +304,13 @@ toFun es m = maybe (otherExps m) (es !!) (lookup m modIxs) modIxs = map modName mods `zip` [0..] -{-# LINE 375 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 374 "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" #-} +{-# LINE 385 "src/ehc/Module/ImportExport.chs" #-} checkMod :: (HsName -> Maybe ModEntRel) -> ModEntRel -> Mod -> [Err] checkMod expsOf inscp mod = checkAmbigExps modExports @@ -323,7 +322,7 @@ 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" #-} +{-# LINE 398 "src/ehc/Module/ImportExport.chs" #-} checkAmbigExps :: ModEntRel -> [Err] checkAmbigExps exps = concatMap isAmbig (Set.toList (Rel.dom exps)) @@ -335,7 +334,7 @@ mkn o = (ioccNm $ mentIdOcc o, Just [(mentRange o,Nothing)]) ambig n _ = [] -{-# LINE 416 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 415 "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 @@ -355,7 +354,7 @@ $ Rel.restrictRng (`Set.member` mentOwns ent) rel _ -> [] -{-# LINE 437 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 436 "src/ehc/Module/ImportExport.chs" #-} checkExpSpec :: ModEntRel -> Mod -> [Err] checkExpSpec inscp mod = case modExpL mod of @@ -369,7 +368,7 @@ 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" #-} +{-# LINE 451 "src/ehc/Module/ImportExport.chs" #-} checkImp :: ModEntRel -> ModImp -> [Err] checkImp exps imp = concatMap chk (mimpImpL imp) @@ -378,7 +377,7 @@ 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" #-} +{-# LINE 465 "src/ehc/Module/ImportExport.chs" #-} data ModMpInfo = ModMpInfo { mmiInscps :: !ModEntRel @@ -413,13 +412,13 @@ resetModMpInfo :: HsName -> ModMpInfo -> ModMpInfo resetModMpInfo modNm i = i {mmiNmOffMp = expsNmOffMp modNm $ mmiExps i `Rel.union` mmiHiddenExps i} -{-# LINE 510 "src/ehc/Module/ImportExport.chs" #-} +{-# 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 517 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 516 "src/ehc/Module/ImportExport.chs" #-} modMpAddHiddenExps :: HsName -> [(HsName,IdOccKind)] -> ModMp -> ModMp modMpAddHiddenExps modNm newExpNms mm = Map.update (\i@(ModMpInfo {mmiHiddenExps=he}) @@ -430,7 +429,7 @@ } ) modNm mm -{-# LINE 531 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 530 "src/ehc/Module/ImportExport.chs" #-} expsNmOffMp :: HsName -> ModEntRel -> HsName2FldMp expsNmOffMp modNm exps = Map.fromList @@ -446,7 +445,7 @@ , panicJust ("Module.expsNmOffMp: " ++ show nm) mbqual == modNm ] -{-# LINE 548 "src/ehc/Module/ImportExport.chs" #-} +{-# LINE 547 "src/ehc/Module/ImportExport.chs" #-} modMpCombine' :: (HsName -> ModMpInfo) -> [Mod] -> ModMp -> (ModMp,[Err]) modMpCombine' dfltMod ms mp = (newMp,concat errs) @@ -461,7 +460,7 @@ modMpCombine :: [Mod] -> ModMp -> (ModMp,[Err]) modMpCombine = modMpCombine' (const emptyModMpInfo) -{-# LINE 577 "src/ehc/Module/ImportExport.chs" #-} +{-# 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/Opts.hs b/src/UHC/Light/Compiler/Opts.hs --- a/src/UHC/Light/Compiler/Opts.hs +++ b/src/UHC/Light/Compiler/Opts.hs @@ -130,7 +130,14 @@ coreOptMp :: Map.Map String CoreOpt coreOptMp = str2stMpWithOmit [CoreOpt_NONE] -{-# LINE 197 "src/ehc/Opts.chs" #-} +{-# LINE 164 "src/ehc/Opts.chs" #-} +instance Show CoreRunOpt where + show = strToLower . showUnprefixed 1 + +coreRunOptMp :: Map.Map String CoreRunOpt +coreRunOptMp = str2stMp + +{-# LINE 205 "src/ehc/Opts.chs" #-} instance Show PgmExec where show PgmExec_CPP = "P" show PgmExec_C = "c" @@ -139,30 +146,30 @@ pgmExecMp :: Map.Map String PgmExec pgmExecMp = str2stMp -{-# LINE 213 "src/ehc/Opts.chs" #-} +{-# LINE 221 "src/ehc/Opts.chs" #-} -- do something with whole program ehcOptWholeProgOptimizationScope :: EHCOpts -> Bool ehcOptWholeProgOptimizationScope opts = ehcOptOptimizationScope opts > OptimizationScope_PerModule -{-# LINE 220 "src/ehc/Opts.chs" #-} +{-# LINE 228 "src/ehc/Opts.chs" #-} -- compatibility option ehcOptEarlyModMerge :: EHCOpts -> Bool ehcOptEarlyModMerge opts = ehcOptOptimizationScope opts >= OptimizationScope_WholeCore -{-# LINE 227 "src/ehc/Opts.chs" #-} +{-# LINE 235 "src/ehc/Opts.chs" #-} -- do whole program analysis, with HPT ehcOptWholeProgHPTAnalysis :: EHCOpts -> Bool ehcOptWholeProgHPTAnalysis opts = False -{-# LINE 293 "src/ehc/Opts.chs" #-} +{-# LINE 301 "src/ehc/Opts.chs" #-} -- | optimizes a particular option ehcOptOptimizes :: Optimize -> EHCOpts -> Bool ehcOptOptimizes o opts = o `Set.member` ehcOptOptimizations opts -{-# LINE 303 "src/ehc/Opts.chs" #-} +{-# LINE 311 "src/ehc/Opts.chs" #-} -- | The default EHC options. defaultEHCOpts = emptyEHCOpts @@ -171,7 +178,7 @@ ] } -{-# LINE 319 "src/ehc/Opts.chs" #-} +{-# LINE 327 "src/ehc/Opts.chs" #-} -- | Commandline opts for ehc/uhc (EHC) ehcCmdLineOpts :: GetOptCmdLineOpts ehcCmdLineOpts = sortOptions $ @@ -229,7 +236,7 @@ , Option "" ["pgmP"] (ReqArg (oPgmExec PgmExec_CPP) "alternate program for cmd") "pgm: alternate executable used by compiler, currently only P (preprocessing)" ] -{-# LINE 479 "src/ehc/Opts.chs" #-} +{-# LINE 487 "src/ehc/Opts.chs" #-} where oPretty ms o = case ms of Just "-" -> o { ehcOptShowEH = False } Just "no" -> o { ehcOptShowEH = False } @@ -330,6 +337,7 @@ | otherwise = Nothing where l = r ehcOptOptimizationLevel maxlev ml s = r ehcOptOptimizationScope maxscp ms + r :: Enum x => (EHCOpts -> x) -> Int -> Maybe Char -> Maybe Int r dflt mx m | x >= 0 && x < mx = Just x | otherwise = Nothing @@ -377,12 +385,12 @@ nub $ ehcOptCmdLineOpts o ++ fst (parseCmdLineOpts cmd s) } oPgmExec cmd s o = o { ehcOptPgmExecMp = Map.insert cmd s $ ehcOptPgmExecMp o } -{-# LINE 765 "src/ehc/Opts.chs" #-} +{-# LINE 774 "src/ehc/Opts.chs" #-} -- | Sort options according to long descr field sortOptions :: GetOptCmdLineOpts -> GetOptCmdLineOpts sortOptions = sortOn (\(Option _ d _ _) -> d) -{-# LINE 775 "src/ehc/Opts.chs" #-} +{-# LINE 784 "src/ehc/Opts.chs" #-} -- | Commandline opts for ehcr/uhcr (EHCRun) ehcrunCmdLineOpts :: GetOptCmdLineOpts ehcrunCmdLineOpts = sortOptions $ @@ -394,7 +402,7 @@ where upd | b = (CoreOpt_RunTrace :) | otherwise = (\\ [CoreOpt_RunTrace]) -{-# LINE 796 "src/ehc/Opts.chs" #-} +{-# LINE 805 "src/ehc/Opts.chs" #-} -- | The description for GetOpt type GetOptCmdLineOpts = [OptDescr (EHCOpts -> EHCOpts)] @@ -414,9 +422,10 @@ ) , Option "" ["ehopt"] (ReqArg oOptEh "opt[,...]") ("opts (specific) for EH: " ++ showStr2stMp ehOptMp) , Option "" ["coreopt"] (ReqArg oOptCore "opt[,...]") ("opts (specific) for Core: " ++ showStr2stMp coreOptMp) + , Option "" ["corerunopt"] (ReqArg oOptCoreRun "opt[,...]") ("opts (specific) for CoreRun: " ++ showStr2stMp coreRunOptMp) ] -{-# LINE 835 "src/ehc/Opts.chs" #-} +{-# LINE 847 "src/ehc/Opts.chs" #-} -- | Help oHelp o = o { ehcOptImmQuit = Just ImmediateQuitOption_Help } @@ -433,21 +442,24 @@ Nothing -> o { ehcOptVerbosity = succ (ehcOptVerbosity o)} _ -> o -{-# LINE 853 "src/ehc/Opts.chs" #-} +{-# LINE 865 "src/ehc/Opts.chs" #-} oOptEh s o = o { ehcOptEhOpts = optOpts ehOptMp s ++ ehcOptEhOpts o} -{-# LINE 857 "src/ehc/Opts.chs" #-} +{-# LINE 869 "src/ehc/Opts.chs" #-} oOptCore s o = o { ehcOptCoreOpts = optOpts coreOptMp s ++ ehcOptCoreOpts o} -{-# LINE 861 "src/ehc/Opts.chs" #-} +{-# LINE 873 "src/ehc/Opts.chs" #-} +oOptCoreRun s o = o { ehcOptCoreRunOpts = Set.fromList (optOpts coreRunOptMp s) `Set.union` ehcOptCoreRunOpts o} + +{-# LINE 877 "src/ehc/Opts.chs" #-} oNumVersion o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionDotted } oVersionAsNumber o = o { ehcOptImmQuit = Just ImmediateQuitOption_VersionAsNumber } -{-# LINE 866 "src/ehc/Opts.chs" #-} +{-# LINE 882 "src/ehc/Opts.chs" #-} oAltDriver o = o { ehcOptAltDriver = not $ ehcOptAltDriver o } oTraceOn s o = o { ehcOptTraceOn = Set.fromList (optOpts allTraceOnMp s) `Set.union` ehcOptTraceOn o } -{-# LINE 875 "src/ehc/Opts.chs" #-} +{-# LINE 891 "src/ehc/Opts.chs" #-} -- | Int option intArg tr = ReqArg (optInt tr) "" @@ -456,7 +468,7 @@ optInt tr s o = tr o $ read s -{-# LINE 885 "src/ehc/Opts.chs" #-} +{-# LINE 901 "src/ehc/Opts.chs" #-} -- | What kind of optional args are allowed data OptArgAllow = OptArgAllow_Bool @@ -466,13 +478,13 @@ optArgAllAllow :: [OptArgAllow] optArgAllAllow = [minBound .. maxBound] -{-# LINE 896 "src/ehc/Opts.chs" #-} +{-# LINE 912 "src/ehc/Opts.chs" #-} -- | An optional arg, universal type for all occurring variants data OptArg = OptArg_Bool Bool | OptArg_Int Int -{-# LINE 903 "src/ehc/Opts.chs" #-} +{-# LINE 919 "src/ehc/Opts.chs" #-} optArgTake :: [OptArgAllow] -> String -> Maybe (OptArg,String) optArgTake allow s = case s of @@ -493,7 +505,7 @@ where yesInt = OptArgAllow_Int `elem` allow noInt = not yesInt -{-# LINE 925 "src/ehc/Opts.chs" #-} +{-# LINE 941 "src/ehc/Opts.chs" #-} optBooleanTake :: String -> Maybe (Bool,String) optBooleanTake s = case optArgTake [OptArgAllow_Bool] s of @@ -509,27 +521,27 @@ boolArgStr = "Bool" boolArg tr = OptArg (optBoolean tr) boolArgStr -{-# LINE 946 "src/ehc/Opts.chs" #-} +{-# LINE 962 "src/ehc/Opts.chs" #-} oPriv o b = o { ehcOptPriv = b } -{-# LINE 950 "src/ehc/Opts.chs" #-} +{-# LINE 966 "src/ehc/Opts.chs" #-} oUnderDev s o = o { ehcOptUnderDev = {- Set.fromList (optOpts allUnderDevMp s) `Set.union` ehcOptUnderDev o -- -} foldr (\ud o -> if Set.member ud o then Set.delete ud o else Set.insert ud o) (ehcOptUnderDev o) (optOpts allUnderDevMp s) } -{-# LINE 956 "src/ehc/Opts.chs" #-} +{-# LINE 972 "src/ehc/Opts.chs" #-} optDumpCoreStages o b = o { ehcOptDumpCoreStages = b } -{-# LINE 964 "src/ehc/Opts.chs" #-} +{-# LINE 980 "src/ehc/Opts.chs" #-} oSetGenTrampoline o b = o { ehcOptGenTrampoline_ = b } -{-# LINE 984 "src/ehc/Opts.chs" #-} +{-# LINE 1000 "src/ehc/Opts.chs" #-} oStopAtCoreError o b = o { ehcDebugStopAtCoreError = b } -{-# LINE 988 "src/ehc/Opts.chs" #-} +{-# LINE 1004 "src/ehc/Opts.chs" #-} oStopAtHIError o b = o { ehcDebugStopAtHIError = b } -{-# LINE 996 "src/ehc/Opts.chs" #-} +{-# LINE 1012 "src/ehc/Opts.chs" #-} -- | Apply the cmdline opts description to a EHCOpts, returning Nothing when there were no options cmdlineOptsApply :: [OptDescr (EHCOpts -> EHCOpts)] -> [EHCOpts -> EHCOpts] -> [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) cmdlineOptsApply cmdlopts postopts args opts @@ -545,7 +557,7 @@ ehcrunCmdLineOptsApply :: [String] -> EHCOpts -> (Maybe EHCOpts, [String], [String]) ehcrunCmdLineOptsApply = cmdlineOptsApply ehcrunCmdLineOpts [] -{-# LINE 1017 "src/ehc/Opts.chs" #-} +{-# LINE 1033 "src/ehc/Opts.chs" #-} optsDiscrRecompileRepr :: EHCOpts -> String optsDiscrRecompileRepr opts = concat @@ -559,12 +571,12 @@ ] where o m v = if v then m else "" -{-# LINE 1038 "src/ehc/Opts.chs" #-} +{-# LINE 1054 "src/ehc/Opts.chs" #-} data FIOBind = FIOBindYes | FIOBindNoBut TyVarIdS deriving (Show) -{-# LINE 1044 "src/ehc/Opts.chs" #-} +{-# LINE 1060 "src/ehc/Opts.chs" #-} data FIOpts = FIOpts { fioLeaveRInst :: !Bool , fioBindRFirst :: !Bool , fioBindLFirst :: !Bool , fioBindLBeforeR :: !Bool , fioMode :: !FIMode , fioUniq :: !UID @@ -577,7 +589,7 @@ , fiMbMkErrClash :: Maybe (Ty -> Ty -> Err) -- alternate error construction for type clash } -{-# LINE 1078 "src/ehc/Opts.chs" #-} +{-# LINE 1094 "src/ehc/Opts.chs" #-} fioBindNoSet :: FIOBind -> TyVarIdS fioBindNoSet (FIOBindNoBut s) = s fioBindNoSet _ = Set.empty @@ -586,7 +598,7 @@ fioBindIsYes FIOBindYes = True fioBindIsYes _ = False -{-# LINE 1088 "src/ehc/Opts.chs" #-} +{-# LINE 1104 "src/ehc/Opts.chs" #-} strongFIOpts :: FIOpts strongFIOpts = FIOpts { fioLeaveRInst = False , fioBindRFirst = True , fioBindLFirst = True , fioBindLBeforeR = True @@ -600,11 +612,11 @@ , fiMbMkErrClash = Nothing } -{-# LINE 1118 "src/ehc/Opts.chs" #-} +{-# LINE 1134 "src/ehc/Opts.chs" #-} instance Show FIOpts where show o = "FIOpts" -{-# LINE 1123 "src/ehc/Opts.chs" #-} +{-# LINE 1139 "src/ehc/Opts.chs" #-} instance PP FIOpts where pp o = "FIOpts{" >#< "leaveRInst=" >|< pp (fioLeaveRInst o) @@ -615,33 +627,33 @@ >#< "allowRPredElim=" >|< pp (fioAllowRPredElim o) >#< "}" -{-# LINE 1139 "src/ehc/Opts.chs" #-} +{-# LINE 1155 "src/ehc/Opts.chs" #-} instLFIOpts :: FIOpts instLFIOpts = strongFIOpts {fioBindRFirst = False} -{-# LINE 1144 "src/ehc/Opts.chs" #-} +{-# LINE 1160 "src/ehc/Opts.chs" #-} instLRFIOpts :: FIOpts instLRFIOpts = strongFIOpts {fioBindRFirst = False, fioBindLFirst = False} -{-# LINE 1149 "src/ehc/Opts.chs" #-} +{-# LINE 1165 "src/ehc/Opts.chs" #-} unifyFIOpts :: FIOpts unifyFIOpts = strongFIOpts {fioMode = FitUnify} instFIOpts :: FIOpts instFIOpts = instLFIOpts {fioLeaveRInst = True, fioBindLFirst = False} -{-# LINE 1168 "src/ehc/Opts.chs" #-} +{-# LINE 1184 "src/ehc/Opts.chs" #-} weakFIOpts :: FIOpts weakFIOpts = fioMkWeak strongFIOpts -{-# LINE 1173 "src/ehc/Opts.chs" #-} +{-# LINE 1189 "src/ehc/Opts.chs" #-} predFIOpts :: FIOpts predFIOpts = strongFIOpts {fioPredAsTy = True, fioLeaveRInst = True} implFIOpts :: FIOpts implFIOpts = strongFIOpts {fioAllowRPredElim = False} -{-# LINE 1181 "src/ehc/Opts.chs" #-} +{-# LINE 1197 "src/ehc/Opts.chs" #-} fioSwapOpts :: FIOpts -> FIOpts fioSwapOpts fio = fio @@ -655,24 +667,24 @@ fioSwapPolarity :: Polarity -> FIOpts -> FIOpts fioSwapPolarity pol fio = fio {fioMode = fimSwapPol pol (fioMode fio)} -{-# LINE 1198 "src/ehc/Opts.chs" #-} +{-# LINE 1214 "src/ehc/Opts.chs" #-} fioMkStrong :: FIOpts -> FIOpts fioMkStrong fi = fi {fioLeaveRInst = False, fioBindRFirst = True, fioBindLFirst = True} -{-# LINE 1203 "src/ehc/Opts.chs" #-} +{-# LINE 1219 "src/ehc/Opts.chs" #-} fioMkWeak :: FIOpts -> FIOpts fioMkWeak fi = fi {fioLeaveRInst = True, fioBindRFirst = False} -{-# LINE 1208 "src/ehc/Opts.chs" #-} +{-# LINE 1224 "src/ehc/Opts.chs" #-} -- | Adapt options for extracting final ty fioMkFinal :: FIOpts -> FIOpts fioMkFinal fi = fi {fioBindLFirst = False, fioBindRFirst = False, fioExpandEqTyVar = True} -{-# LINE 1214 "src/ehc/Opts.chs" #-} +{-# LINE 1230 "src/ehc/Opts.chs" #-} fioMkUnify :: FIOpts -> FIOpts fioMkUnify fi = fi {fioMode = FitUnify} -{-# LINE 1223 "src/ehc/Opts.chs" #-} +{-# LINE 1239 "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 --- a/src/UHC/Light/Compiler/Opts/Base.hs +++ b/src/UHC/Light/Compiler/Opts/Base.hs @@ -10,6 +10,7 @@ , ehcOptIsUnderDev , InOrOutputFor (..) , CoreOpt (..) +, CoreRunOpt (..) , ehcOptEhPP , ehcOptTarget, ehcOptTargetFlavor , ehcOptCoreSysF, ehcOptCoreSysFCheck, ehcOptCoreSysFGen, ehcOptCoreSysFCheckOnlyVal @@ -32,6 +33,7 @@ import UHC.Light.Compiler.Base.UnderDev import UHC.Util.Pretty import qualified Data.Set as Set +import GHC.Generics (Generic) import Data.List import Data.Char import UHC.Light.Compiler.Base.HsName.Builtin @@ -50,7 +52,7 @@ -{-# LINE 69 "src/ehc/Opts/Base.chs" #-} +{-# LINE 72 "src/ehc/Opts/Base.chs" #-} data ImmediateQuitOption = ImmediateQuitOption_Help -- print help | ImmediateQuitOption_Version -- print version info @@ -65,13 +67,13 @@ -- -| ImmediateQuitOption_Meta_ExportEnv (Maybe String) -- export (write) environmental info of installation -- -| ImmediateQuitOption_Meta_DirEnv -- print dir of environmental info of installation -{-# LINE 93 "src/ehc/Opts/Base.chs" #-} +{-# LINE 96 "src/ehc/Opts/Base.chs" #-} data InOrOutputFor = OutputFor_Module | OutputFor_Pkg | InputFrom_Loc FileLoc -{-# LINE 106 "src/ehc/Opts/Base.chs" #-} +{-# LINE 109 "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 @@ -84,7 +86,7 @@ emptyPkgOption :: PkgOption emptyPkgOption = PkgOption emptyPkgName [] [] -{-# LINE 124 "src/ehc/Opts/Base.chs" #-} +{-# LINE 127 "src/ehc/Opts/Base.chs" #-} -- | EH specific options data EhOpt = EhOpt_NONE -- no-op option @@ -92,7 +94,7 @@ | EhOpt_DumpAST -- dump textual EH output, as annotated AST deriving (Eq, Ord, Enum, Bounded) -{-# LINE 133 "src/ehc/Opts/Base.chs" #-} +{-# LINE 136 "src/ehc/Opts/Base.chs" #-} -- | Core specific options data CoreOpt = CoreOpt_NONE -- no-op option @@ -111,7 +113,15 @@ | CoreOpt_RunPPVerbose -- when dump CoreRun print more verbose info in comment deriving (Eq,Enum,Bounded) -{-# LINE 196 "src/ehc/Opts/Base.chs" #-} +{-# LINE 166 "src/ehc/Opts/Base.chs" #-} +-- | Core specific options +data CoreRunOpt + = CoreRunOpt_PrintResult -- Print run result + deriving (Eq,Ord,Enum,Bounded,Generic) + +instance DataAndConName CoreRunOpt + +{-# LINE 208 "src/ehc/Opts/Base.chs" #-} -- | Pgm (internal program used) options, in particular alternate internal shell commands data PgmExec = PgmExec_CPP -- alternate CPP @@ -119,7 +129,7 @@ | PgmExec_Linker -- alternate linker deriving (Eq,Ord,Enum,Bounded) -{-# LINE 205 "src/ehc/Opts/Base.chs" #-} +{-# LINE 217 "src/ehc/Opts/Base.chs" #-} -- | Wrapper around options, adding semantics for adapting cmd specific behavior data ExecOpt = ExecOpt_Plain String -- ^ plain option @@ -128,7 +138,7 @@ execOptsPlain :: [ExecOpt] -> [String] execOptsPlain o = [ s | ExecOpt_Plain s <- o ] -{-# LINE 221 "src/ehc/Opts/Base.chs" #-} +{-# LINE 233 "src/ehc/Opts/Base.chs" #-} -- | The options to use. data EHCOpts = EHCOpts @@ -159,6 +169,7 @@ :: OptimizeOptionMp -- optimization specific configuration , ehcOptDumpCoreStages :: Bool -- dump intermediate Core transformation stages , ehcOptCoreOpts :: [CoreOpt] -- Core options + , ehcOptCoreRunOpts :: !(Set.Set CoreRunOpt) -- CoreRun options , ehcOptGenTrampoline_ :: Bool -- gen trampoline with (tail) calls , ehcOptGenTrace :: Bool , ehcOptEmitHS :: Bool @@ -217,7 +228,7 @@ } deriving Typeable -{-# LINE 400 "src/ehc/Opts/Base.chs" #-} +{-# LINE 415 "src/ehc/Opts/Base.chs" #-} emptyEHCOpts = EHCOpts { ehcOptTrace = \_ x -> x @@ -246,6 +257,7 @@ , ehcOptOptimizations = optimizeRequiresClosure $ Map.findWithDefault Set.empty OptimizationLevel_Normal optimizationLevelMp , ehcOptOptimizeOptionMp = Map.empty , ehcOptCoreOpts = [] + , ehcOptCoreRunOpts = Set.empty , ehcOptGenTrampoline_ = False , ehcOptGenTrace = False , ehcOptVerbosity = VerboseMinimal @@ -297,7 +309,7 @@ , ehcOptExecOptsMp = Map.empty } -{-# LINE 584 "src/ehc/Opts/Base.chs" #-} +{-# LINE 602 "src/ehc/Opts/Base.chs" #-} -- | PP EH AST, with annotations ehcOptEhAstPP :: EHCOpts -> Bool ehcOptEhAstPP opts = @@ -307,19 +319,19 @@ ehcOptEhAstPPExtensive :: EHCOpts -> Bool ehcOptEhAstPPExtensive opts = (ehcOptEhAstPP opts && ehcOptDebug opts) || EhOpt_DumpAST `elem` ehcOptEhOpts opts -{-# LINE 599 "src/ehc/Opts/Base.chs" #-} +{-# LINE 617 "src/ehc/Opts/Base.chs" #-} -- | Do some plain PP on EH ehcOptEhPP :: EHCOpts -> Bool ehcOptEhPP opts = ehcOptShowEH opts || ehcOptEmitEH opts || EhOpt_Dump `elem` ehcOptEhOpts opts -{-# LINE 605 "src/ehc/Opts/Base.chs" #-} +{-# LINE 623 "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 613 "src/ehc/Opts/Base.chs" #-} +{-# LINE 631 "src/ehc/Opts/Base.chs" #-} -- | Generate system F (20120421 AD: very much under construction) ehcOptCoreSysF :: EHCOpts -> Bool ehcOptCoreSysF _ = False @@ -336,7 +348,7 @@ ehcOptCoreSysFCheckOnlyVal :: EHCOpts -> Bool ehcOptCoreSysFCheckOnlyVal opts = ehcOptCoreSysFCheck opts -{-# LINE 647 "src/ehc/Opts/Base.chs" #-} +{-# LINE 665 "src/ehc/Opts/Base.chs" #-} -- generate bytecode ehcOptEmitExecBytecode :: EHCOpts -> Bool ehcOptEmitExecBytecode _ = False @@ -344,12 +356,12 @@ ehcOptEmitBytecode :: EHCOpts -> Bool ehcOptEmitBytecode _ = False -{-# LINE 704 "src/ehc/Opts/Base.chs" #-} +{-# LINE 722 "src/ehc/Opts/Base.chs" #-} -- | Check Cmm ehcOptCmmCheck :: EHCOpts -> Bool ehcOptCmmCheck _ = False -{-# LINE 714 "src/ehc/Opts/Base.chs" #-} +{-# LINE 732 "src/ehc/Opts/Base.chs" #-} -- | Via Core -> Grin -> CMM -> JS ? ehcOptIsViaGrinCmmJavaScript :: EHCOpts -> Bool ehcOptIsViaGrinCmmJavaScript opts @@ -361,36 +373,36 @@ = targetIsViaCoreJavaScript t where t = ehcOptTarget opts -{-# LINE 735 "src/ehc/Opts/Base.chs" #-} +{-# LINE 753 "src/ehc/Opts/Base.chs" #-} ehcOptIsViaCmm :: EHCOpts -> Bool ehcOptIsViaCmm opts = ehcOptIsViaGrinCmmJavaScript opts {-# INLINE ehcOptIsViaCmm #-} -{-# LINE 741 "src/ehc/Opts/Base.chs" #-} +{-# LINE 759 "src/ehc/Opts/Base.chs" #-} ehcOptIsViaGrin :: EHCOpts -> Bool ehcOptIsViaGrin opts = ehcOptIsViaGrinCmmJavaScript opts || targetIsGrinBytecode t || targetDoesHPTAnalysis t where t = ehcOptTarget opts -{-# LINE 751 "src/ehc/Opts/Base.chs" #-} +{-# LINE 769 "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 763 "src/ehc/Opts/Base.chs" #-} +{-# LINE 781 "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 775 "src/ehc/Opts/Base.chs" #-} +{-# LINE 793 "src/ehc/Opts/Base.chs" #-} -- | Do linking into executable? ehcOptDoExecLinking :: EHCOpts -> Bool ehcOptDoExecLinking opts = ehcOptLinkingStyle opts == LinkingStyle_Exec -{-# LINE 785 "src/ehc/Opts/Base.chs" #-} +{-# LINE 803 "src/ehc/Opts/Base.chs" #-} -- | Is something under development turned on? ehcOptIsUnderDev :: UnderDev -> EHCOpts -> Bool ehcOptIsUnderDev ud opts = ud `Set.member` ehcOptUnderDev opts diff --git a/src/UHC/Light/Compiler/Opts/CommandLine.hs b/src/UHC/Light/Compiler/Opts/CommandLine.hs --- a/src/UHC/Light/Compiler/Opts/CommandLine.hs +++ b/src/UHC/Light/Compiler/Opts/CommandLine.hs @@ -28,20 +28,20 @@ -- modifiers | CmdFlag_ModfMin CmdFlag -- double '-' - deriving (Eq,Typeable,Data) + deriving (Eq,Typeable) data Cmd = Cmd_CPP_Preprocessing | Cmd_CPP | Cmd_C - deriving (Eq,Ord,Enum,Bounded,Typeable,Data) + deriving (Eq,Ord,Enum,Bounded,Typeable) data CmdLineOpt = CmdLineOpt { cloptForCmd :: Cmd , cloptFlag :: CmdFlag } - deriving (Eq,Typeable,Data) + deriving (Eq,Typeable) type CmdLineOpts = [CmdLineOpt] diff --git a/src/UHC/Light/Compiler/Pred/CHR.hs b/src/UHC/Light/Compiler/Pred/CHR.hs deleted file mode 100644 --- a/src/UHC/Light/Compiler/Pred/CHR.hs +++ /dev/null @@ -1,252 +0,0 @@ -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 deleted file mode 100644 --- a/src/UHC/Light/Compiler/Pred/CommonCHR.hs +++ /dev/null @@ -1,166 +0,0 @@ -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 --- a/src/UHC/Light/Compiler/Pred/Evidence.hs +++ b/src/UHC/Light/Compiler/Pred/Evidence.hs @@ -1,12 +1,14 @@ module UHC.Light.Compiler.Pred.Evidence -( Evidence (..) +( Evidence, Evidence' (..) , evidUnresolved , evidUpdateUnresolved , InfoToEvidenceMap, evidMpInsert, evidMpUnion, evidMpSubst ) where -import UHC.Light.Compiler.CHR -import UHC.Light.Compiler.Pred.CHR +import UHC.Util.CHR import UHC.Light.Compiler.Substitutable +import UHC.Light.Compiler.Ty +import UHC.Light.Compiler.VarMp +import UHC.Light.Compiler.CHR.Constraint import UHC.Light.Compiler.Base.Common import Data.List import qualified Data.Set as Set @@ -15,24 +17,26 @@ 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] } +{-# LINE 39 "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])] } + | 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 +type Evidence = Evidence' CHRPredOcc RedHowAnnotation + +{-# LINE 50 "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 +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 +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) @@ -42,30 +46,34 @@ 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 +{-# LINE 70 "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 +{-# LINE 79 "src/ehc/Pred/Evidence.chs" #-} +type instance ExtrValVarKey (Evidence' p info) = ExtrValVarKey p + +instance (VarExtractable p) => VarExtractable (Evidence' p info) 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 +instance VarUpdatable p s => VarUpdatable (Evidence' p info) s where + -- type SubstVarKey s = SubstVarKey s + -- type SubstVarVal s = SubstVarVal s 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" #-} +{-# LINE 101 "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 :: Eq p => Evidence' p info -> [UnresolvedTrace' p info] evidUnresolved (Evid_Unresolved p us) = -- concatMap evidUnresolved us us evidUnresolved (Evid_Proof p i ps) @@ -78,17 +86,17 @@ where us = {- nub $ concatMap -} map (\(i,ps) -> (i,concatMap evidUnresolved ps)) pss evidUnresolved _ = [] -{-# LINE 108 "src/ehc/Pred/Evidence.chs" #-} +{-# LINE 117 "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 :: 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 +{-# LINE 127 "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 @@ -99,15 +107,17 @@ 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) +{-# LINE 144 "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 +type InfoToEvidenceMap = InfoToEvidenceMap' CHRPredOcc RedHowAnnotation + +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 :: (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 :: (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 --- a/src/UHC/Light/Compiler/Pred/EvidenceToCore.hs +++ b/src/UHC/Light/Compiler/Pred/EvidenceToCore.hs @@ -1,13 +1,13 @@ module UHC.Light.Compiler.Pred.EvidenceToCore ( EvidKeyToCBindMap, PredScopeToCBindMap, EvidKeyToCExprMap -, OverlapEvid (..) +, OverlapEvid, OverlapEvid' (..) , evidKeyToBindMapUnion, predScopeToBindMapUnion , evidMpToCore , EvidCBindL, evidKeyCoreMpToBinds2 , evidKeyBindMpToCSubst ) where import UHC.Light.Compiler.Pred.Evidence -import UHC.Light.Compiler.Pred.CommonCHR +import UHC.Light.Compiler.CHR.Constraint import Data.List import qualified Data.Set as Set import qualified Data.Map as Map @@ -37,23 +37,25 @@ type PredScopeToCBindMap = PredScopeToBindMap' CBind {-# LINE 66 "src/ehc/Pred/EvidenceToCore.chs" #-} -data OverlapEvid p info +data OverlapEvid' p info = OverlapEvid { overlapevidPredOcc :: !p , overlapevidInfos :: ![info] } -{-# LINE 74 "src/ehc/Pred/EvidenceToCore.chs" #-} +type OverlapEvid = OverlapEvid' CHRPredOcc RedHowAnnotation + +{-# LINE 76 "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" #-} +{-# LINE 88 "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 :: FIIn' gm -> InfoToEvidenceMap -> (EvidKeyToCExprMap,[OverlapEvid]) evidMpToCore2 env evidMp = ( -- Map.map (\r -> (tcrCExpr r,tcrTy r,tcrUsed r,tcrScope r)) $ tcsMp @@ -70,8 +72,8 @@ -- | 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) + -> Evidence -- the evidence + -> State (ToCoreState CExpr Ty) (ToCoreRes CExpr Ty) mk1 mbevk ev = case ev of Evid_Proof p info evs @@ -111,12 +113,12 @@ 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 + -> Evidence -- 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) + -> State (ToCoreState CExpr Ty) (ToCoreRes CExpr Ty) ins insk k evnm ev c ty sc uses = do { st <- get ; case Map.lookup ev $ tcsEvMp st of @@ -190,7 +192,7 @@ -- | ehc options opts = feEHCOpts $ fiEnv env -{-# LINE 242 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 244 "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 {- @@ -336,16 +338,18 @@ splitOverlaps es = let (es',as) = unzip $ map splitOverlap es in (es',concat as) -} -{-# LINE 404 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 406 "src/ehc/Pred/EvidenceToCore.chs" #-} -- | State maintained during evid -> core -data ToCoreState p info e t +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) + , 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 } +type ToCoreState e t = ToCoreState' CHRPredOcc RedHowAnnotation e t + -- | The core expression, plus additional info data ToCoreRes e t = ToCoreRes @@ -361,7 +365,7 @@ instance (PP e, PP t) => PP (ToCoreRes e t) where pp r = "TCR" >#< tcrCExpr r >#< "::" >#< tcrTy r -{-# LINE 430 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 434 "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) @@ -375,9 +379,9 @@ instance PP SubEvid where pp (SubEvid_Assume i s) = "SubEvd" >#< i >#< s -{-# LINE 447 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 451 "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 :: FIIn' gm -> InfoToEvidenceMap -> (EvidKeyToCExprMap,[OverlapEvid]) evidMpToCore = evidMpToCore2 {- evidMpToCore env evidMp @@ -468,7 +472,7 @@ dbg m = id -- Debug.tr m empty -} -{-# LINE 555 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 559 "src/ehc/Pred/EvidenceToCore.chs" #-} evidKeyCoreMpToBinds :: FIIn' gm -> EvidKeyToCExprMap -> (EvidKeyToCBindMap,PredScopeToCBindMap) evidKeyCoreMpToBinds env m = dbg "evidKeyCoreMpToBinds.res" @@ -496,7 +500,7 @@ dbg m = id -- Debug.tr m (pp m) opts = feEHCOpts $ fiEnv env -{-# LINE 598 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 602 "src/ehc/Pred/EvidenceToCore.chs" #-} type EvidCBindL = [CBind] evidKeyCoreMpToBinds2 :: FIIn' gm -> EvidKeyToCExprMap -> (EvidCBindL,EvidKeyToCBindMap,PredScopeToCBindMap) @@ -522,7 +526,7 @@ deepestScope sc u = maximumBy pscpCmpByLen $ sc : (map subevdScope $ Set.toList u) opts = feEHCOpts $ fiEnv env -{-# LINE 626 "src/ehc/Pred/EvidenceToCore.chs" #-} +{-# LINE 630 "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 --- a/src/UHC/Light/Compiler/Pred/Heuristics.hs +++ b/src/UHC/Light/Compiler/Pred/Heuristics.hs @@ -1,6 +1,6 @@ module UHC.Light.Compiler.Pred.Heuristics ( Heuristic, SHeuristic -, HeurAlts (..), HeurRed (..) +, HeurAlts, HeurAlts' (..), HeurRed, HeurRed' (..) , toHeuristic , heurTry , localChoice @@ -10,67 +10,78 @@ where import UHC.Light.Compiler.Ty import UHC.Light.Compiler.Ty.FitsInCommon2 -import UHC.Light.Compiler.CHR +import UHC.Util.CHR import UHC.Light.Compiler.VarMp -import UHC.Light.Compiler.Pred.CHR import UHC.Light.Compiler.Pred.Evidence +import UHC.Light.Compiler.CHR.Key import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Guard +import UHC.Light.Compiler.CHR.Solve +import UHC.Light.Compiler.Base.Common 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)] +{-# LINE 23 "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 +type Heuristic = Heuristic' CHRPredOcc RedHowAnnotation -{-# LINE 45 "src/ehc/Pred/Heuristics.chs" #-} -data HeurAlts p info +type SHeuristic' p info = HeurAlts' p info -> Evidence' p info + +type SHeuristic = SHeuristic' CHRPredOcc RedHowAnnotation + +{-# LINE 39 "src/ehc/Pred/Heuristics.chs" #-} +data HeurAlts' p info = HeurAlts { redaltsPredicate :: p - , redaltsAlts :: [HeurRed p info] + , redaltsAlts :: [HeurRed' p info] } -data HeurRed p info +type HeurAlts = HeurAlts' CHRPredOcc RedHowAnnotation + +data HeurRed' p info = HeurRed { redInfo :: info - , redContext :: [HeurAlts p info] + , redContext :: [HeurAlts' p info] } | HeurRed_Rec { redRecPred :: p } -{-# LINE 62 "src/ehc/Pred/Heuristics.chs" #-} -instance Show (HeurAlts p info) where +type HeurRed = HeurRed' CHRPredOcc RedHowAnnotation + +{-# LINE 60 "src/ehc/Pred/Heuristics.chs" #-} +instance Show (HeurAlts' p info) where show _ = "HeurAlts" -instance Show (HeurRed p info) where +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 +{-# LINE 68 "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 +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 +{-# LINE 81 "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 +{-# LINE 92 "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 +{-# LINE 103 "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]) @@ -81,14 +92,14 @@ 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 +{-# LINE 116 "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" #-} +{-# LINE 124 "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 @@ -101,8 +112,8 @@ 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 +{-# LINE 142 "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 []] @@ -112,34 +123,34 @@ 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 :: 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 +{-# LINE 167 "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 +{-# LINE 186 "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' p info -> Bool hasAlts (HeurAlts _ []) = False hasAlts _ = True -{-# LINE 207 "src/ehc/Pred/Heuristics.chs" #-} +{-# LINE 205 "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 @@ -148,12 +159,12 @@ Nothing -> P_LT Just _ -> P_EQ -{-# LINE 284 "src/ehc/Pred/Heuristics.chs" #-} +{-# LINE 282 "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 +{-# LINE 305 "src/ehc/Pred/Heuristics.chs" #-} +anncmpEHCScoped :: CHRMatchable (FIIn' gm) Pred VarMp => Bool -> FIIn' gm -> HeurRed -> HeurRed -> PartialOrdering anncmpEHCScoped preferInst env ann1 ann2 = case (ann1,ann2) of (HeurRed (RedHow_Assumption _ _) _ , _ ) -> P_GT @@ -182,8 +193,8 @@ (_ , 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 +{-# LINE 351 "src/ehc/Pred/Heuristics.chs" #-} +heurScopedEHC :: CHRMatchable (FIIn' gm) Pred VarMp => FIIn' gm -> Heuristic heurScopedEHC env = toHeuristic $ ifthenelseSHeuristic isEqHeuristic @@ -205,7 +216,7 @@ = contextBinChoice (anncmpEHCScoped env) -} -ifthenelseSHeuristic :: (p -> Bool) -> SHeuristic p info -> SHeuristic p info -> SHeuristic p info +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 --- a/src/UHC/Light/Compiler/Pred/RedGraph.hs +++ b/src/UHC/Light/Compiler/Pred/RedGraph.hs @@ -1,7 +1,7 @@ module UHC.Light.Compiler.Pred.RedGraph ( module UHC.Util.AGraph , RedNode (..) -, RedGraph, emptyRedGraph +, RedGraph', RedGraph, emptyRedGraph , mkRedGraphFromReductions, addToRedGraphFromReductions , addToRedGraphFromAssumes, mkRedGraphFromAssumes , ppRedGraph @@ -42,26 +42,28 @@ true = mkRedNode [] {-# LINE 52 "src/ehc/Pred/RedGraph.chs" #-} -type RedGraph p info = AGraph (RedNode p) info +type RedGraph' p info = AGraph (RedNode p) info -emptyRedGraph :: Ord p => RedGraph p i +type RedGraph = RedGraph' CHRPredOcc RedHowAnnotation + +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 +{-# LINE 61 "src/ehc/Pred/RedGraph.chs" #-} +addToRedGraphFromReductions :: [Constraint] -> RedGraph -> RedGraph addToRedGraphFromReductions cs g = foldr addReduction g cs -mkRedGraphFromReductions :: Ord p => [Constraint p info] -> RedGraph p info +mkRedGraphFromReductions :: [Constraint] -> RedGraph mkRedGraphFromReductions cs = addToRedGraphFromReductions cs emptyRedGraph -{-# LINE 67 "src/ehc/Pred/RedGraph.chs" #-} -addToRedGraphFromAssumes :: Ord p => ConstraintToInfoMap p info -> RedGraph p info -> RedGraph p info +{-# LINE 69 "src/ehc/Pred/RedGraph.chs" #-} +addToRedGraphFromAssumes :: ConstraintToInfoMap -> RedGraph -> RedGraph addToRedGraphFromAssumes cm g = Map.foldrWithKey addAssumption g cm -mkRedGraphFromAssumes :: Ord p => ConstraintToInfoMap p info -> RedGraph p info +mkRedGraphFromAssumes :: ConstraintToInfoMap -> RedGraph mkRedGraphFromAssumes cm = addToRedGraphFromAssumes cm emptyRedGraph -{-# LINE 75 "src/ehc/Pred/RedGraph.chs" #-} +{-# LINE 77 "src/ehc/Pred/RedGraph.chs" #-} instance PP p => Show (RedNode p) where show = showPP . pp @@ -70,18 +72,18 @@ 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 +{-# LINE 87 "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 +{-# LINE 97 "src/ehc/Pred/RedGraph.chs" #-} +addAssumption :: Constraint -> [RedHowAnnotation] -> RedGraph -> RedGraph 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 +{-# LINE 103 "src/ehc/Pred/RedGraph.chs" #-} +addReduction :: Constraint -> RedGraph -> RedGraph addReduction (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=[q]}) = insertEdge (Red_Pred p, Red_Pred q , i) addReduction (Reduction {cnstrPred=p, cnstrInfo=i, cnstrFromPreds=ps}) @@ -90,8 +92,8 @@ 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 +{-# LINE 121 "src/ehc/Pred/RedGraph.chs" #-} +redPruneReductionsUntil :: [CHRPredOcc] -> (CHRPredOcc -> Bool) -> RedGraph -> RedGraph redPruneReductionsUntil leaves stop gr = dels (map Red_Pred leaves) gr where dels leaves g = foldr del g leaves @@ -102,8 +104,8 @@ | 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 +{-# LINE 138 "src/ehc/Pred/RedGraph.chs" #-} +redAlternatives :: RedGraph -> CHRPredOcc -> HeurAlts redAlternatives gr = recOr Set.empty where recOr visited p = HeurAlts p (map (recAnd visited') (successors gr (Red_Pred p))) diff --git a/src/UHC/Light/Compiler/Pred/ToCHR.hs b/src/UHC/Light/Compiler/Pred/ToCHR.hs --- a/src/UHC/Light/Compiler/Pred/ToCHR.hs +++ b/src/UHC/Light/Compiler/Pred/ToCHR.hs @@ -1,11 +1,8 @@ module UHC.Light.Compiler.Pred.ToCHR -( ScopedPredStore, ScopedPredCHR, ScopedPredStoreL -, CHRRedGraph -, CHRClassDecl, CHRScopedInstanceDecl -, CHRPredOccEvidMp -, initScopedPredStore +( CHRClassDecl, CHRScopedInstanceDecl +, initCHRStore , mkScopedCHR2 -, SimplifyResult (..), emptySimplifyResult +, SimplifyResult, SimplifyResult'' (..), emptySimplifyResult , simplifyResultResetForAdditionalWork , partitionUnresolved2AssumableAndOthers , patchUnresolvedWithAssumption @@ -23,10 +20,11 @@ import Data.Maybe import qualified Data.Set as Set import qualified Data.Map as Map -import UHC.Light.Compiler.CHR +import UHC.Util.CHR import UHC.Light.Compiler.CHR.Constraint +import UHC.Light.Compiler.CHR.Guard import UHC.Light.Compiler.CHR.Solve -import UHC.Light.Compiler.Pred.CHR +import UHC.Light.Compiler.CHR.Key import UHC.Light.Compiler.Pred.Heuristics import UHC.Light.Compiler.Pred.Evidence import UHC.Light.Compiler.Pred.RedGraph @@ -38,28 +36,16 @@ {-# 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 +type CHRClassDecl' a info = ([a], a, [info]) +type CHRClassDecl = CHRClassDecl' Pred RedHowAnnotation +type CHRScopedInstanceDecl' a info sc = ([a], a, info, sc) +type CHRScopedInstanceDecl = CHRScopedInstanceDecl' Pred RedHowAnnotation PredScope -{-# LINE 48 "src/ehc/Pred/ToCHR.chs" #-} -type CHRRedGraph = RedGraph CHRPredOcc RedHowAnnotation +{-# LINE 47 "src/ehc/Pred/ToCHR.chs" #-} +type MkRes1 = (CHRStore, ([CHRPredOcc],CHRPredOcc) ) +type MkResN = (CHRStore,[([CHRPredOcc],CHRPredOcc)]) {-# 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] @@ -78,10 +64,10 @@ ) 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" #-} +{-# LINE 101 "src/ehc/Pred/ToCHR.chs" #-} -- | The basic initial set of CHRs -initScopedPredStore :: ScopedPredStore -initScopedPredStore +initCHRStore :: CHRStore +initCHRStore = chrStoreFromElems $ [ scopeProve, {- scopeAssum1, -} scopeAssum2 ] ++ [ labelProve1, labelProve2 ] @@ -89,48 +75,48 @@ where p1s1 = mkCHRPredOcc pr1 sc1 p1s2 = mkCHRPredOcc pr1 sc2 p1s3 = mkCHRPredOcc pr1 sc3 - scopeProve = [Prove p1s1, Prove p1s2] + scopeProve = [mkProve p1s1, mkProve p1s2] ==> [mkReduction p1s2 (RedHow_ByScope (ByScopeRedHow_Other $ AlwaysEq "prv")) [p1s3]] |> [IsStrictParentScope sc3 sc1 sc2] {- - scopeAssum1 = [Prove p1s1, Assume p1s2] + scopeAssum1 = [mkProve p1s1, mkAssume p1s2] ==> [mkReduction p1s1 (RedHow_Assumption sc2) []] |> [EqualScope sc1 sc2] -} - scopeAssum2 = [Prove p1s1, Assume p1s2] + scopeAssum2 = [mkProve p1s1, mkAssume 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]] + labelProve1 = [mkProve l1s1] + ==> [mkProve l2s1, mkReduction l1s1 (RedHow_ByLabel lab1 off1 sc1) [l2s1]] |> [NonEmptyRowLacksLabel ty2 off1 ty1 lab1] - labelProve2 = [Prove l3s1] + labelProve2 = [mkProve 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] + instForall = [mkAssume f1s1] + ==> [mkAssume 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]] + predArrow = [mkAssume a1s1, mkProve a2s1] + ==> [mkProve 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] - <==> [] + predSeq1 = [mkProve s1s1] + <==> [mkProve s2s1, mkProve s3s1] + predSeq2 = [mkProve $ mkCHRPredOcc (Pred_Preds PredSeq_Nil) sc1] + <==> ([] :: [Constraint]) -- inclSc = ehcCfgCHRInclScope $ feEHCOpts $ fiEnv env -{-# LINE 217 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 190 "src/ehc/Pred/ToCHR.chs" #-} -- | Construct CHRs from class and instance decls mkScopedCHR2 - :: FIIn -> [CHRClassDecl Pred RedHowAnnotation] -> [CHRScopedInstanceDecl Pred RedHowAnnotation PredScope] - -> ScopedPredStore -> (ScopedPredStore,ScopedPredStore) + :: FIIn -> [CHRClassDecl] -> [CHRScopedInstanceDecl] + -> CHRStore -> (CHRStore,CHRStore) mkScopedCHR2 env clsDecls insts prevStore = (chrStoreUnions [store2,instSimplStore], chrStoreUnions [assumeStore,instSimplStore]) where ucls = mkNewLevUIDL (length clsDecls) $ fiUniq env @@ -143,14 +129,16 @@ 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" #-} +{-# LINE 208 "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 :: FIIn -> CHRStore -> CHRClassDecl -> CHRStore 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 + (superClassesWork, superClassesDone, _ :: SolveTrace FIIn Constraint Guard VarMp) + = chrSolve' env rules (map (\p -> toSolverConstraint $ mkAssume $ mkCHRPredOcc p sc1) context) + superClasses = superClassesWork ++ superClassesDone + graph = mkRedGraphFromReductions $ filterMb fromSolverConstraint superClasses head1 = mkCHRPredOcc head sc1 head2 = mkCHRPredOcc head sc2 head3 = mkCHRPredOcc head sc3 @@ -164,82 +152,87 @@ 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]] + superRule = [mkProve head1, mkProve p] ==> reds' + scopeRule1 = [mkProve head1, mkProve super2] + ==> [mkProve 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]] + scopeRule2 = [mkProve head2, mkProve super1] + ==> [mkProve 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 :: [CHRClassDecl] -> [CHRScopedInstanceDecl] -> (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 :: CHRClassDecl -> Maybe MkRes1 mkAssumeChrs ([] , _ , _ ) = Nothing mkAssumeChrs (context, head, infos) = let prThis = mkCHRPredOcc head sc1 - super prSuper info = [Assume prSuper, mkReduction prSuper info [prThis]] + super prSuper info = [mkAssume prSuper, mkReduction prSuper info [prThis]] prSuper = map (\c -> mkCHRPredOcc c sc1) context - in Just ( chrStoreSingletonElem $ [Assume prThis] ==> concat (zipWith super prSuper infos) + in Just ( chrStoreSingletonElem $ [mkAssume prThis] ==> concat (zipWith super prSuper infos) , (prSuper,prThis) ) -mkInstanceChrs :: [CHRScopedInstanceDecl Pred RedHowAnnotation PredScope] -> MkResN +mkInstanceChrs :: [CHRScopedInstanceDecl] -> MkResN mkInstanceChrs insts = (chrStoreUnions instStores,instChrs) where (instStores,instChrs) = unzip $ map mkInstanceChr insts -mkInstanceChr :: CHRScopedInstanceDecl Pred RedHowAnnotation PredScope -> MkRes1 +mkInstanceChr :: CHRScopedInstanceDecl -> MkRes1 mkInstanceChr (context, hd, i, s) = ( chrStoreSingletonElem - $ [Prove constraint] - ==> mkReduction constraint i body : map Prove body + $ [mkProve constraint] + ==> mkReduction constraint i body : map mkProve 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 +{-# LINE 282 "src/ehc/Pred/ToCHR.chs" #-} +data SimplifyResult'' p i g s = SimplifyResult - { simpresSolveState :: SolveState p i g s - , simpresRedGraph :: RedGraph p i + { simpresSolveState :: SolveState FIIn (Constraint' 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)] + , 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 +type SimplifyResult' g s = SimplifyResult'' CHRPredOcc RedHowAnnotation g s + +type SimplifyResult = SimplifyResult' Guard VarMp + +emptySimplifyResult :: SimplifyResult emptySimplifyResult = SimplifyResult emptySolveState emptyRedGraph [] [] [] [] -{-# LINE 327 "src/ehc/Pred/ToCHR.chs" #-} -simplifyResultResetForAdditionalWork :: Ord p => SimplifyResult p i g s -> SimplifyResult p i g s +{-# LINE 306 "src/ehc/Pred/ToCHR.chs" #-} +simplifyResultResetForAdditionalWork :: SimplifyResult -> SimplifyResult simplifyResultResetForAdditionalWork r = r {simpresRedGraph = emptyRedGraph} -{-# LINE 337 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 315 "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 - ) + :: Heuristic + -> ConstraintToInfoMap + -> RedGraph + -> ( -- ConstraintToInfoMap -- remaining constraints + ConstraintToInfoTraceMp -- remaining constraints + , InfoToEvidenceMap -- mapping to evidence + , [Err] -- errors + ) mkEvidence heur cnstrMp redGraph = ( {- (cnstrMp `Map.intersection` remCnstrMp) `Map.union` -} cnstrTraceMpFromList remCnstrMp @@ -259,8 +252,8 @@ mk (c, infos) = ([ (c,(i,[])) | i <- infos],Map.empty,[],[]) -{-# LINE 400 "src/ehc/Pred/ToCHR.chs" #-} -partitionUnresolved2AssumableAndOthers :: CHRPredOccCnstrTraceMp -> ([CHRIntermediateUntilAssume],CHRPredOccCnstrTraceMp) +{-# LINE 375 "src/ehc/Pred/ToCHR.chs" #-} +partitionUnresolved2AssumableAndOthers :: ConstraintToInfoTraceMp -> ([CHRIntermediateUntilAssume],ConstraintToInfoTraceMp) partitionUnresolved2AssumableAndOthers unresCnstrMp = (unres,cannotResCnstrMp) where (unresCnstrMp',cannotResCnstrMp) @@ -270,11 +263,11 @@ canAssume _ _ = True unres = [ (p,x) | (Prove p,x) <- shareUnresolvedAssumptionsByScope (unresCnstrMp') ] -{-# LINE 412 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 387 "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 :: ConstraintToInfoTraceMp -> [(Constraint,(PredScope,ConstraintToInfoTraceMp))] shareUnresolvedAssumptionsByScope unres = [ ( c , ( -- the common prefix off all scopes, i.e. the most global scope @@ -289,9 +282,9 @@ groupSortOn (cpoPr . cnstrPred . fst) $ Map.toList unres ] -{-# LINE 436 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 411 "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 :: FIIn -> [CHRIntermediateUntilAssume] -> RedGraph -> InfoToEvidenceMap -> (ConstraintToInfoTraceMp,InfoToEvidenceMap) patchUnresolvedWithAssumption env unres redGraph evidMp = ( assumeCnstrs , evidMpSubst (\p -> Map.lookup p assumeSubstMp) evidMp @@ -306,19 +299,16 @@ assumeSubstMp = Map.fromList [ (p,Evid_Proof p i []) | (Assume p,((i,_):_)) <- Map.toList assumeCnstrs ] -{-# LINE 458 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 433 "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 - ) + :: FIIn + -> CHRStore + -> ConstraintToInfoMap + -> ConstraintToInfoMap + -> SimplifyResult + -> ( ConstraintToInfoMap + , SimplifyResult + ) chrSimplifySolveToRedGraph env chrStore cnstrInfoMpPrev cnstrInfoMp prevRes = ( cnstrInfoMpAll , emptySimplifyResult @@ -328,21 +318,21 @@ } ) where (_,u1,u2) = mkNewLevUID2 $ fiUniq env - solveState = chrSolve'' (env {fiUniq = u1}) chrStore (Map.keys $ cnstrInfoMp `Map.difference` cnstrInfoMpPrev) (simpresSolveState prevRes) + solveState = chrSolve'' (env {fiUniq = u1}) chrStore (map toSolverConstraint $ Map.keys $ cnstrInfoMp `Map.difference` cnstrInfoMpPrev) (simpresSolveState prevRes) cnstrInfoMpAll = cnstrMpUnion cnstrInfoMp cnstrInfoMpPrev redGraph - = addToRedGraphFromReductions (chrSolveStateDoneConstraints solveState) + = addToRedGraphFromReductions (filterMb fromSolverConstraint $ chrSolveStateDoneConstraints solveState) $ addToRedGraphFromAssumes cnstrInfoMpAll $ simpresRedGraph prevRes -{-# LINE 492 "src/ehc/Pred/ToCHR.chs" #-} +{-# LINE 464 "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 - ) + :: Heuristic + -> ConstraintToInfoMap + -> SimplifyResult + -> ( ( ConstraintToInfoTraceMp, InfoToEvidenceMap, [Err] ) + , SimplifyResult + ) chrSimplifyRedGraphToEvidence heur cnstrInfoMpAll simpRes = ( (chrSolveRemCnstrMp,chrSolveEvidMp,chrSolveErrs) , simpRes diff --git a/src/UHC/Light/Compiler/SourceCodeSig.hs b/src/UHC/Light/Compiler/SourceCodeSig.hs --- a/src/UHC/Light/Compiler/SourceCodeSig.hs +++ b/src/UHC/Light/Compiler/SourceCodeSig.hs @@ -1,3 +1,3 @@ module UHC.Light.Compiler.SourceCodeSig where -sig = "e96c473dd93f5fa14b8293738022e1a5" -timestamp = "20151013 +0200 204022" +sig = "9f39e6a4d4199ffa68b1f4aeff600ee1" +timestamp = "20151027 +0100 143712" diff --git a/src/UHC/Light/Compiler/Substitutable.hs b/src/UHC/Light/Compiler/Substitutable.hs --- a/src/UHC/Light/Compiler/Substitutable.hs +++ b/src/UHC/Light/Compiler/Substitutable.hs @@ -1,6 +1,5 @@ module UHC.Light.Compiler.Substitutable -( VarUpdatable (..) -, VarExtractable (..) +( module UHC.Util.Substitutable , ppS , substLift , varmpMapTyVarKey @@ -12,6 +11,7 @@ import Data.List import UHC.Light.Compiler.Base.Common import UHC.Light.Compiler.VarMp +import UHC.Util.Substitutable import UHC.Light.Compiler.Ty import UHC.Light.Compiler.Ty.Trf.Subst import UHC.Light.Compiler.Ty.Ftv @@ -28,34 +28,13 @@ -{-# 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" #-} +{-# LINE 49 "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" #-} +{-# LINE 60 "src/ehc/Substitutable.chs" #-} varmpinfoFtvMp :: VarMpInfo -> TvCatMp varmpinfoFtvMp i = case i of @@ -63,96 +42,152 @@ VMIImpls i -> implsFtvMp i _ -> emptyTvCatMp -- incomplete -{-# LINE 99 "src/ehc/Substitutable.chs" #-} -instance VarLookup m TyVarId VarMpInfo => VarUpdatable Ty m where +{-# LINE 73 "src/ehc/Substitutable.chs" #-} +type instance SubstVarKey VarMp = VarId +type instance SubstVarVal VarMp = VarMpInfo + +type instance SubstVarKey (VarMp' k v) = k +type instance SubstVarVal (VarMp' k v) = v + +{-# LINE 89 "src/ehc/Substitutable.chs" #-} +instance (VarLookup m (SubstVarKey m) (SubstVarVal m), SubstVarKey m ~ TyVarId, SubstVarVal m ~ VarMpInfo) => VarUpdatable Ty m where + -- type SubstVarKey m = SubstVarKey m + -- type SubstVarVal m = SubstVarVal m varUpd = tyAppVarLookup varUpdCyc = tyAppVarLookup2 -instance VarExtractable Ty TyVarId where +type instance ExtrValVarKey Ty = TyVarId + +instance VarExtractable Ty where varFreeSet = tyFtv -{-# LINE 114 "src/ehc/Substitutable.chs" #-} +{-# LINE 110 "src/ehc/Substitutable.chs" #-} -- instance VarUpdatable Label VarMp where -instance VarLookup m ImplsVarId VarMpInfo => VarUpdatable Label m where +instance (VarLookup m (SubstVarKey m) (SubstVarVal m), SubstVarKey m ~ ImplsVarId, SubstVarVal m ~ VarMpInfo) => VarUpdatable Label m where + -- type SubstVarKey m = ImplsVarId + -- type SubstVarVal m = VarMpInfo s `varUpd` lb = maybe lb id $ varmpLabelLookupLabelCyc lb s -instance VarExtractable Label TyVarId where +type instance ExtrValVarKey Label = TyVarId + +instance VarExtractable Label where varFree (Label_Var v) = [v] varFree _ = [] -- instance VarUpdatable LabelOffset VarMp where -instance VarLookup m UID VarMpInfo => VarUpdatable LabelOffset m where +instance (VarLookup m (SubstVarKey m) (SubstVarVal m), SubstVarKey m ~ UID, SubstVarVal m ~ VarMpInfo) => VarUpdatable LabelOffset m where + -- type SubstVarKey m = UID + -- type SubstVarVal m = VarMpInfo s `varUpd` o@(LabelOffset_Var v) = maybe o id $ varmpOffsetLookup v s s `varUpd` o = o -instance VarExtractable LabelOffset TyVarId where +type instance ExtrValVarKey LabelOffset = TyVarId + +instance VarExtractable LabelOffset where varFree (LabelOffset_Var v) = [v] varFree _ = [] -{-# LINE 133 "src/ehc/Substitutable.chs" #-} -instance (VarUpdatable vv subst) => VarUpdatable [vv] subst where +{-# LINE 137 "src/ehc/Substitutable.chs" #-} +-- instance (VarUpdatable vv subst) => VarUpdatable [vv] subst where +instance (Ord (SubstVarKey subst), VarUpdatable vv subst) => VarUpdatable [vv] subst where + -- type SubstVarKey subst = SubstVarKey subst + -- type SubstVarVal subst = SubstVarVal subst 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 +instance (VarExtractable vv) => VarExtractable [vv] 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 +{-# LINE 181 "src/ehc/Substitutable.chs" #-} +-- instance VarLookupCmb m (VarMp' k v) => VarUpdatable (VarMp' k v) m where +instance VarLookupCmb (VarMp' k v) (VarMp' k v) => VarUpdatable (VarMp' k v) (VarMp' k v) where + -- type SubstVarKey (VarMp' k v) = k + -- type SubstVarVal (VarMp' k v) = v varUpd = (|+>) -instance VarExtractable VarMp TyVarId where +type instance ExtrValVarKey VarMp = TyVarId + +instance VarExtractable VarMp where varFreeSet (VarMp _ sl) = Set.unions $ map (varFreeSet . Map.elems) sl -{-# LINE 176 "src/ehc/Substitutable.chs" #-} +{-# LINE 194 "src/ehc/Substitutable.chs" #-} +-- instance VarUpdatable vv subst => VarUpdatable (HsName,vv) subst where instance VarUpdatable vv subst => VarUpdatable (HsName,vv) subst where + -- type SubstVarKey subst = SubstVarKey subst + -- type SubstVarVal subst = SubstVarVal subst s `varUpd` (k,v) = (k,s `varUpd` v) -instance VarExtractable vv k => VarExtractable (HsName,vv) k where +instance (VarExtractable vv, ExtrValVarKey vv ~ ExtrValVarKey (HsName,vv)) => VarExtractable (HsName,vv) where varFreeSet (_,v) = varFreeSet v -{-# LINE 184 "src/ehc/Substitutable.chs" #-} +{-# LINE 205 "src/ehc/Substitutable.chs" #-} instance VarUpdatable Pred VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` p = (\(Ty_Pred p) -> p) (s `varUpd` (Ty_Pred p)) -instance VarExtractable Pred TyVarId where +type instance ExtrValVarKey Pred = TyVarId + +instance VarExtractable Pred where varFreeSet p = varFreeSet (Ty_Pred p) -- instance VarUpdatable PredScope VarMp where -instance VarLookup m ImplsVarId VarMpInfo => VarUpdatable PredScope m where +instance (VarLookup m (SubstVarKey m) (SubstVarVal m), SubstVarKey m ~ ImplsVarId, SubstVarVal m ~ VarMpInfo) => VarUpdatable PredScope m where + -- type SubstVarKey m = ImplsVarId + -- type SubstVarVal m = VarMpInfo s `varUpd` sc = maybe sc id $ varmpScopeLookupScopeCyc sc s -instance VarExtractable PredScope TyVarId where +type instance ExtrValVarKey PredScope = TyVarId + +instance VarExtractable PredScope where varFree (PredScope_Var v) = [v] varFree _ = [] instance VarUpdatable CHRPredOccCxt VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` (CHRPredOccCxt_Scope1 sc) = CHRPredOccCxt_Scope1 (s `varUpd` sc) -instance VarExtractable CHRPredOccCxt TyVarId where +type instance ExtrValVarKey CHRPredOccCxt = TyVarId + +instance VarExtractable CHRPredOccCxt where varFree (CHRPredOccCxt_Scope1 sc) = varFree sc instance VarUpdatable PredOcc VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` (PredOcc pr id sc r) = PredOcc (s `varUpd` pr) id (s `varUpd` sc) r -instance VarExtractable PredOcc TyVarId where +type instance ExtrValVarKey PredOcc = TyVarId + +instance VarExtractable PredOcc where varFreeSet (PredOcc pr id sc _) = varFreeSet pr `Set.union` varFreeSet sc instance VarUpdatable CHRPredOcc VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` (CHRPredOcc pr sc r) = CHRPredOcc (s `varUpd` pr) (s `varUpd` sc) r -instance VarExtractable CHRPredOcc TyVarId where +type instance ExtrValVarKey CHRPredOcc = TyVarId + +instance VarExtractable CHRPredOcc where varFreeSet (CHRPredOcc pr sc _) = varFreeSet pr `Set.union` varFreeSet sc instance VarUpdatable Impls VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` i = (\(Ty_Impls i) -> i) (s `varUpd` (Ty_Impls i)) -instance VarExtractable Impls TyVarId where +type instance ExtrValVarKey Impls = TyVarId + +instance VarExtractable Impls where varFreeSet i = varFreeSet (Ty_Impls i) -{-# LINE 240 "src/ehc/Substitutable.chs" #-} +{-# LINE 285 "src/ehc/Substitutable.chs" #-} instance VarUpdatable VarMpInfo VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo s `varUpd` vmi = case vmi of VMITy t -> VMITy (s `varUpd` t) VMIImpls i -> VMIImpls (s `varUpd` i) @@ -162,8 +197,10 @@ -- VMIExts x -> VMIExts (s `varUpd` x) vmi -> vmi -{-# LINE 258 "src/ehc/Substitutable.chs" #-} -instance VarExtractable VarMpInfo VarId where +{-# LINE 305 "src/ehc/Substitutable.chs" #-} +type instance ExtrValVarKey VarMpInfo = VarId + +instance VarExtractable VarMpInfo where varFreeSet vmi = case vmi of VMITy t -> varFreeSet t VMIImpls i -> varFreeSet i @@ -174,18 +211,22 @@ vmi -> Set.empty -{-# LINE 292 "src/ehc/Substitutable.chs" #-} +{-# LINE 341 "src/ehc/Substitutable.chs" #-} instance VarUpdatable PredSeq VarMp where + -- type SubstVarKey VarMp = VarId + -- type SubstVarVal VarMp = VarMpInfo 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 +type instance ExtrValVarKey PredSeq = TyVarId + +instance VarExtractable PredSeq 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" #-} +{-# LINE 361 "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 @@ -210,21 +251,21 @@ = smTo `varUpd` t where (_,smTo,_,_) = fixTyVarsVarMp uniq t -{-# LINE 338 "src/ehc/Substitutable.chs" #-} +{-# LINE 391 "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" #-} +{-# LINE 400 "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" #-} +{-# LINE 420 "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" #-} +{-# LINE 437 "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 --- a/src/UHC/Light/Compiler/Ty.hs +++ b/src/UHC/Light/Compiler/Ty.hs @@ -134,6 +134,7 @@ import qualified Data.Set as Set import qualified Data.Map as Map import Data.List +import qualified UHC.Util.RLList as RLL import UHC.Util.Pretty import UHC.Util.Utils import Control.Monad @@ -220,6 +221,8 @@ + + type TyL = [Ty] @@ -361,7 +364,7 @@ | LabelOffset_Var !UID deriving ( Eq, Ord - , Typeable, Data + , Typeable ) @@ -373,17 +376,16 @@ data PredScope - = PredScope_Lev !(RLList Int) + = PredScope_Lev !(RLL.RLList Int) | PredScope_Var !TyVarId deriving (Eq,Ord) initPredScope :: PredScope -initPredScope = PredScope_Lev rllEmpty +initPredScope = PredScope_Lev RLL.empty deriving instance Typeable PredScope -deriving instance Data PredScope @@ -400,10 +402,10 @@ pscpEnter :: Int -> PredScope -> (Int,PredScope) -pscpEnter x (PredScope_Lev s) = (x+1,PredScope_Lev (s `rllConcat` rllSingleton x)) +pscpEnter x (PredScope_Lev s) = (x+1,PredScope_Lev (s `RLL.concat` RLL.singleton x)) pscpLeave :: PredScope -> PredScope -pscpLeave (PredScope_Lev s) = PredScope_Lev $ fst $ fromJust $ rllInitLast s +pscpLeave (PredScope_Lev s) = PredScope_Lev $ fst $ fromJust $ RLL.initLast s @@ -434,26 +436,26 @@ pscpIsVisibleIn :: PredScope -> PredScope -> Bool -pscpIsVisibleIn (PredScope_Lev sOuter) (PredScope_Lev sInner) = sOuter `rllIsPrefixOf` sInner +pscpIsVisibleIn (PredScope_Lev sOuter) (PredScope_Lev sInner) = sOuter `RLL.isPrefixOf` 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 + where commonPrefix xxs yys | isJust ht1 && isJust ht2 && x == y = RLL.singleton x `RLL.concat` commonPrefix xs ys + | otherwise = RLL.empty + where ht1 = RLL.headTail xxs + ht2 = RLL.headTail yys (x,xs) = fromJust ht1 (y,ys) = fromJust ht2 - -- commonPrefix _ _ = rllEmpty + -- commonPrefix _ _ = RLL.empty pscpCommon _ _ = Nothing pscpParents :: PredScope -> [PredScope] -pscpParents (PredScope_Lev s) | not (rllNull s) = map PredScope_Lev $ rllInits $ rllInit s +pscpParents (PredScope_Lev s) | not (RLL.null s) = map PredScope_Lev $ RLL.inits $ RLL.init s pscpParents _ = [] @@ -463,7 +465,7 @@ pscpCmp _ _ = Nothing pscpCmpByLen :: PredScope -> PredScope -> Ordering -pscpCmpByLen (PredScope_Lev s) (PredScope_Lev t) = (rllLength s) `compare` (rllLength t) +pscpCmpByLen (PredScope_Lev s) (PredScope_Lev t) = (RLL.length s) `compare` (RLL.length t) @@ -480,7 +482,6 @@ deriving instance Typeable ImplsProveOcc -deriving instance Data ImplsProveOcc @@ -517,7 +518,6 @@ deriving instance Typeable CHRPredOccCxt -deriving instance Data CHRPredOccCxt @@ -555,7 +555,6 @@ -- #else -- deriving instance Typeable1 CHRPredOcc' -- #endif -deriving instance Data CHRPredOcc @@ -1478,7 +1477,6 @@ deriving instance Typeable TyKiKey -deriving instance Data TyKiKey @@ -1778,14 +1776,14 @@ 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) + deriving ( 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) + deriving ( Eq,Ord,Show,Typeable) -- LabelAGItf -------------------------------------------------- data LabelAGItf = LabelAGItf_AGItf {lab_LabelAGItf_AGItf :: !(Label)} - deriving ( Data,Eq,Ord,Show,Typeable) + deriving ( Eq,Ord,Show,Typeable) -- Pred -------------------------------------------------------- data Pred = Pred_Class {ty_Pred_Class :: !(Ty)} | Pred_Pred {ty_Pred_Pred :: !(Ty)} @@ -1794,12 +1792,12 @@ | 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) + deriving ( 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) + deriving ( Eq,Ord,Show,Typeable) -- Ty ---------------------------------------------------------- data Ty = Ty_Con {nm_Ty_Con :: !(HsName)} | Ty_App {func_Ty_App :: !(Ty),arg_Ty_App :: !(Ty)} @@ -1812,22 +1810,22 @@ | 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) + deriving ( Eq,Ord,Show,Typeable) -- TyAGItf ----------------------------------------------------- data TyAGItf = TyAGItf_AGItf {ty_TyAGItf_AGItf :: !(Ty)} - deriving ( Data,Eq,Ord,Show,Typeable) + deriving ( Eq,Ord,Show,Typeable) -- TyAnn ------------------------------------------------------- data TyAnn = TyAnn_Empty {} | TyAnn_Strictness {s_TyAnn_Strictness :: !(Strictness)} | TyAnn_Mono {} - deriving ( Data,Eq,Ord,Show,Typeable) + deriving ( 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) + deriving ( Eq,Ord,Show,Typeable) -- TyVarCateg -------------------------------------------------- data TyVarCateg = TyVarCateg_Plain {} | TyVarCateg_Fixed {} | TyVarCateg_Meta {} - deriving ( Data,Enum,Eq,Ord,Show,Typeable) + deriving ( Enum,Eq,Ord,Show,Typeable) diff --git a/src/UHC/Light/Compiler/Ty/FitsIn.hs b/src/UHC/Light/Compiler/Ty/FitsIn.hs --- a/src/UHC/Light/Compiler/Ty/FitsIn.hs +++ b/src/UHC/Light/Compiler/Ty/FitsIn.hs @@ -41,7 +41,7 @@ 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.CHR.Constraint import UHC.Light.Compiler.Core.Utils import UHC.Light.Compiler.Ty.Trf.BetaReduce @@ -123,6 +123,7 @@ => -} ( VarLookup gm TyVarId VarMpInfo , VarLookupCmb VarMp gm + , SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo ) => FIOpts -> FIEnv -> UID -> gm -> Ty -> Ty -> FIOut @@ -137,7 +138,7 @@ ) :: FIIn' gm ) -{-# LINE 320 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 321 "src/ehc/Ty/FitsIn.chs" #-} fitsInFI :: forall gm . {- ( VarUpdatable Ty gm @@ -147,6 +148,7 @@ => -} ( VarLookup gm TyVarId VarMpInfo , VarLookupCmb VarMp gm + , SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo ) => FIIn' gm -> Ty -> Ty -> FIOut @@ -183,16 +185,16 @@ -- binding occurBind fi isLBind v t= bind fi isLBind v t -{-# LINE 417 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 419 "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" #-} +{-# LINE 424 "src/ehc/Ty/FitsIn.chs" #-} lookupImplsVarCyc fi v = fiLookupVar' varmpImplsLookupCyc varmpImplsLookupCyc v (fiVarMpLoc fi) (fiVarMp fi) -{-# LINE 425 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 427 "src/ehc/Ty/FitsIn.chs" #-} lookupLabelCyc fi v = fiLookupVar' varmpLabelLookupLabelCyc varmpLabelLookupLabelCyc v (fiVarMpLoc fi) (fiVarMp fi) -{-# LINE 429 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 431 "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 @@ -202,13 +204,13 @@ fiInhibitBind v fi _ -> fi -{-# LINE 448 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 450 "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" #-} +{-# LINE 457 "src/ehc/Ty/FitsIn.chs" #-} -- removal of quantifier unquant fi t hide howToInst = ( fi { fiUniq = u @@ -221,7 +223,7 @@ back = if hide then \fo -> foSetVarMp (varmpDel rtvs (foVarMp fo)) $ foUpdTy t fo else id -{-# LINE 501 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 503 "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) @@ -232,34 +234,34 @@ } where o = fiFIOpts fi -{-# LINE 517 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 519 "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" #-} +{-# LINE 524 "src/ehc/Ty/FitsIn.chs" #-} foUpdTy t fo = fo {foTy = t} -{-# LINE 526 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 528 "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" #-} +{-# LINE 534 "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" #-} +{-# LINE 537 "src/ehc/Ty/FitsIn.chs" #-} foCmbCSubst ffo afo = afo {foCSubst = cSubstApp (foCSubst afo) (foCSubst ffo)} -{-# LINE 542 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 544 "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" #-} +{-# LINE 562 "src/ehc/Ty/FitsIn.chs" #-} foCmbPrfRes ffo = foCmbPrL ffo . foCmbCSubst ffo -{-# LINE 570 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 572 "src/ehc/Ty/FitsIn.chs" #-} fiAddPr n i prTy fi = let e = fiEnv fi (_,assumePredScope) = pscpEnter 0 $ fePredScope (fiEnv fi) @@ -280,7 +282,7 @@ $ foUpdLRCoe lrcoe fo -{-# LINE 611 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 613 "src/ehc/Ty/FitsIn.chs" #-} deepInstMatchTy fi t = case t of _ | not (null as @@ -292,7 +294,7 @@ where (u,u1) = mkNewLevUID (fiUniq fi) fi' = fi {fiUniq = u} -{-# LINE 626 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 628 "src/ehc/Ty/FitsIn.chs" #-} fPairWise fi tL1 tL2 = foldr (\(t1,t2) (foL,fii) -> let fo = fVar' fTySyn fii id t1 t2 @@ -300,7 +302,7 @@ ([],fi) (zip tL1 tL2) -{-# LINE 641 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 643 "src/ehc/Ty/FitsIn.chs" #-} fRow fi tr1 tr2 isRec isSum = foR where (r1,exts1) = tyRowExtsUnAnn $ tyRowExtsWithLkup (fiLookupTyVarCyc fi) tr1 @@ -361,7 +363,7 @@ $ foUpdRecFldsCoe eKeys foL tr1 $ foUpdTy (foTy fo `recRow` eL) fo -{-# LINE 710 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 712 "src/ehc/Ty/FitsIn.chs" #-} fR fi r1@(Ty_Var _ f1) r2@(Ty_Con n2) [] [] [] | tvCatIsFixed f1 && n2 == hsnRowEmpty && isRec = res fi r2 @@ -373,11 +375,11 @@ { foLRCoe = emptyLRCoe } -{-# LINE 736 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 738 "src/ehc/Ty/FitsIn.chs" #-} fR fi _ _ _ _ _ = errClash fi tr1 tr2 -{-# LINE 745 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 747 "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 @@ -481,7 +483,7 @@ } where coe = Coe_Map (\e -> acoreLet1Plain rn e (fuMkCExpr globOpts u4 fuUpdL r)) -{-# LINE 984 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 986 "src/ehc/Ty/FitsIn.chs" #-} foUpdRecFldsCoe eKeys foL tr1 foR = let (u',u1) = mkNewLevUID (foUniq foR) us = mkNewLevUIDL (length foL) u1 @@ -497,10 +499,10 @@ , foCSubst = foldr cSubstApp (foCSubst foR) sL } -{-# LINE 1022 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1024 "src/ehc/Ty/FitsIn.chs" #-} f fi t1 t2 = fBase fi id t1 t2 -{-# LINE 1030 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1032 "src/ehc/Ty/FitsIn.chs" #-} fTySyn fi updTy t1 t2 = case filter (not . foHasErrs) tries of (fo:_) -> fo @@ -528,15 +530,15 @@ e1 e2 = [f] | otherwise = [] -{-# LINE 1063 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1065 "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" #-} +{-# LINE 1070 "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" #-} +{-# LINE 1075 "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)) @@ -564,7 +566,7 @@ fVar f fi t1 t2 = fVar' f fi id t1 t2 -{-# LINE 1147 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1149 "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 @@ -597,7 +599,7 @@ _ -> Just $ occurBind fi False v2 t1 varBind3 _ _ _ _ = Nothing -{-# LINE 1189 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1191 "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 @@ -610,7 +612,7 @@ _ -> f fi updTy t1 t2 fAnn f fi updTy t1 t2 = f fi updTy t1 t2 -{-# LINE 1211 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1213 "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 @@ -625,7 +627,7 @@ fVarPred1 f fi tpr1 = f fi tpr1 -{-# LINE 1227 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1229 "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} @@ -639,7 +641,7 @@ | isJust mbVarBind = fromJust mbVarBind where mbVarBind = varBind1 fi updTy t1 t2 -{-# LINE 1242 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1244 "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} } @@ -653,7 +655,7 @@ fBase fi updTy t1 t2@(Ty_Ann a2 at2) = fVar' fBase fi updTy t1 at2 -{-# LINE 1257 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1259 "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 @@ -672,13 +674,13 @@ = Just (fVar' fTySyn fi updTy t1 tr2) fP fi _ = Nothing -{-# LINE 1277 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1279 "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" #-} +{-# LINE 1286 "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 @@ -689,25 +691,25 @@ 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" #-} +{-# LINE 1298 "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" #-} +{-# LINE 1306 "src/ehc/Ty/FitsIn.chs" #-} fP _ _ = Nothing -{-# LINE 1309 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1311 "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" #-} +{-# LINE 1323 "src/ehc/Ty/FitsIn.chs" #-} fBase fi updTy t1 t2@(Ty_TBind _ _ _ _) | fioIsSubsume (fiFIOpts fi) && fioLeaveRInst (fiFIOpts fi) = back2 (fo { foRInstToL = instto2 ++ foRInstToL fo @@ -721,14 +723,14 @@ where (fi2,uqt2,back2,instto2) = unquant fi t2 False instContra fo = fVar' fTySyn fi2 id t1 uqt2 -{-# LINE 1344 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1346 "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" #-} +{-# LINE 1358 "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) @@ -799,7 +801,7 @@ fP fi _ _ = Nothing -{-# LINE 1456 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1458 "src/ehc/Ty/FitsIn.chs" #-} -- t1 `fit` tpr2 => tr2 fBase fi updTy t1 t2@(Ty_App (Ty_App (Ty_Con c2) tpr2) tr2) @@ -845,7 +847,7 @@ = fSub fi id (mkPrIdCHR u1) pr2 tr2 fP fi _ = Nothing -{-# LINE 1541 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1543 "src/ehc/Ty/FitsIn.chs" #-} -- tpr1 => tr1 `fit` t2 fBase fi updTy t1@(Ty_App (Ty_App (Ty_Con c1) tpr1) tr1) t2 @@ -893,7 +895,7 @@ , cnstrMp ) = fSub fi updTy (mkPrIdCHR u1) prfPredScope pr1 tr1 fP fi _ = Nothing -{-# LINE 1633 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1635 "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) @@ -904,12 +906,12 @@ isSum = hsnIsSum n1 fo = fRow fi tr1 tr2 isRec isSum -{-# LINE 1658 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1660 "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" #-} +{-# LINE 1666 "src/ehc/Ty/FitsIn.chs" #-} -- tf1 ta1 `fit` tf2 ta2 fBase fi updTy t1@(Ty_App tf1 ta1) t2@(Ty_App tf2 ta2) @@ -946,11 +948,11 @@ (foVarMp afo `varUpd` foTy ffo) (foVarMp afo `varUpd` foTy afo)] hasSubCoerce = not $ lrcoeIsId $ foLRCoe afo -{-# LINE 1733 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1735 "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" #-} +{-# LINE 1755 "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 @@ -961,18 +963,18 @@ | s1 == hsnInvariant && sf2 == hsnPolNegation = fVar' fBase fi id t1 ta2 -{-# LINE 1765 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1767 "src/ehc/Ty/FitsIn.chs" #-} fBase fi updTy t1 t2 = errClash fi t1 t2 -{-# LINE 1769 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1771 "src/ehc/Ty/FitsIn.chs" #-} foRes = fVar' fTySyn fi id ty1 ty2 -{-# LINE 1773 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1775 "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" #-} +{-# LINE 1785 "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}) @@ -983,16 +985,17 @@ = (map foTy foL,fo) where (foL,fo) = fitsInL' opts env uniq varmp tyl1 tyl2 -{-# LINE 1799 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1801 "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" #-} +{-# LINE 1812 "src/ehc/Ty/FitsIn.chs" #-} fitPredIntoPred :: ( VarLookupCmb VarMp gm , VarLookup gm TyVarId VarMpInfo + , SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo ) => FIIn' gm -> Pred -> Pred -> Maybe (Pred,VarMp) @@ -1060,7 +1063,7 @@ (fiEnv fi) (fiUniq fi) (fiVarMp fi) (Ty_Pred pr1) (Ty_Pred pr2) -{-# LINE 1914 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1917 "src/ehc/Ty/FitsIn.chs" #-} fitPredToEvid'' :: (ClGamInfo -> Ty) -> UID -> VarMp -> Ty -> Either ClGamInfo ClGam -> FIOut fitPredToEvid'' getTy u varmp prTy gg = case prTy of @@ -1082,7 +1085,7 @@ (_,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" #-} +{-# LINE 1940 "src/ehc/Ty/FitsIn.chs" #-} fitPredToEvid' :: UID -> VarMp -> Ty -> Either ClGamInfo ClGam -> FIOut fitPredToEvid' = fitPredToEvid'' clgiPrToEvidRecTy {- @@ -1107,11 +1110,11 @@ in manyFO (aLr' ++ [emptyFO {foTy = map foTy aL' `appArr` foTy r'}]) -} -{-# LINE 1963 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1966 "src/ehc/Ty/FitsIn.chs" #-} fitPredToEvid :: UID -> VarMp -> Ty -> ClGam -> FIOut fitPredToEvid u varmp prTy g = fitPredToEvid' u varmp prTy (Right g) -{-# LINE 1972 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1975 "src/ehc/Ty/FitsIn.chs" #-} mkFitsInWrap' :: FIEnv -> FitsIn' mkFitsInWrap' env = \opt u varmp t1 t2 @@ -1124,7 +1127,7 @@ -> let fo = fitsIn opt env u varmp t1 t2 in (foTy fo, foVarMp fo, foErrL fo) -{-# LINE 1990 "src/ehc/Ty/FitsIn.chs" #-} +{-# LINE 1993 "src/ehc/Ty/FitsIn.chs" #-} -- fitsInForToTyCore :: C.KiFitsIn fitsInForToTyCore uniq t1 t2 = foLInstToL fo diff --git a/src/UHC/Light/Compiler/Ty/FitsInCommon.hs b/src/UHC/Light/Compiler/Ty/FitsInCommon.hs --- a/src/UHC/Light/Compiler/Ty/FitsInCommon.hs +++ b/src/UHC/Light/Compiler/Ty/FitsInCommon.hs @@ -23,7 +23,7 @@ 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.CHR.Constraint import UHC.Light.Compiler.Core import UHC.Light.Compiler.Core.Coercion import UHC.Light.Compiler.Core.Subst @@ -61,7 +61,7 @@ , 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 + , foGathCnstrMp :: !ConstraintToInfoMap -- arisen predicates , foRowCoeL :: !(AssocL HsName Coe) -- internal, coercions for row fields } diff --git a/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs b/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs --- a/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs +++ b/src/UHC/Light/Compiler/Ty/FitsInCommon2.hs @@ -22,22 +22,23 @@ import qualified Data.Set as Set import UHC.Util.Pretty import UHC.Light.Compiler.AbstractCore +import UHC.Util.Utils -{-# LINE 36 "src/ehc/Ty/FitsInCommon2.chs" #-} -ppTyWithFI :: (VarLookupCmb VarMp gm, VarUpdatable Ty gm) => FIIn' gm -> Ty -> PP_Doc +{-# LINE 39 "src/ehc/Ty/FitsInCommon2.chs" #-} +ppTyWithFI :: (VarLookupCmb VarMp gm, VarUpdatable Ty gm, SubstVarKey gm ~ VarId) => 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 :: (VarLookupCmb VarMp gm, VarUpdatable Ty gm, SubstVarKey gm ~ VarId) => FIIn' gm -> FIOut -> Ty -> PP_Doc ppTyWithFIFO fi fo t = ppTyS (foVarMp fo |+> fiVarMp fi) t -{-# LINE 56 "src/ehc/Ty/FitsInCommon2.chs" #-} +{-# LINE 59 "src/ehc/Ty/FitsInCommon2.chs" #-} data FIIn' globvm = FIIn { fiFIOpts :: !FIOpts -- options to fitsIn , fiUniq :: !UID -- unique thread - , fiVarMp :: !globvm -- global (type) var bindings + , 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 @@ -47,10 +48,11 @@ , fiCoeCtx :: CoeCtx -- the coercion context , fiEnv :: !FIEnv -- environment (Gam's,...) } + deriving (Typeable) type FIIn = FIIn' VarMp -{-# LINE 77 "src/ehc/Ty/FitsInCommon2.chs" #-} +{-# LINE 83 "src/ehc/Ty/FitsInCommon2.chs" #-} emptyFI' :: gm -> FIIn' gm emptyFI' m = FIIn @@ -70,7 +72,7 @@ -- emptyFI :: forall gm . FIIn' gm emptyFI = emptyFI' emptyVarMp -{-# LINE 100 "src/ehc/Ty/FitsInCommon2.chs" #-} +{-# LINE 106 "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 @@ -82,12 +84,12 @@ 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" #-} +{-# LINE 123 "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" #-} +{-# LINE 137 "src/ehc/Ty/FitsInCommon2.chs" #-} data TyBetaRedEnv gm = TyBetaRedEnv { tbredFI :: FIIn' gm @@ -96,14 +98,14 @@ emptyTyBetaRedEnv' fe = TyBetaRedEnv ((emptyFI {fiEnv = fe}) :: FIIn) emptyTyBetaRedEnv = TyBetaRedEnv emptyFI -{-# LINE 145 "src/ehc/Ty/FitsInCommon2.chs" #-} +{-# LINE 151 "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" #-} +{-# LINE 165 "src/ehc/Ty/FitsInCommon2.chs" #-} fiInitInstRank :: FIIn' gm -> FIIn' gm fiInitInstRank fi = maybe (fi {fiMbInstRank = Just (fiRank fi)}) (const fi) (fiMbInstRank fi) @@ -113,7 +115,7 @@ 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" #-} +{-# LINE 180 "src/ehc/Ty/FitsInCommon2.chs" #-} fiPlusVarMp :: VarMp -> FIIn' gm -> FIIn' gm fiPlusVarMp c fi = fi {fiVarMpLoc = c |+> fiVarMpLoc fi} @@ -123,7 +125,7 @@ fiBindTyVar :: TyVarId -> Ty -> FIIn' gm -> FIIn' gm fiBindTyVar v t = fiPlusVarMp (v `varmpTyUnit` t) -{-# LINE 185 "src/ehc/Ty/FitsInCommon2.chs" #-} +{-# LINE 191 "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/Pretty.hs b/src/UHC/Light/Compiler/Ty/Pretty.hs --- a/src/UHC/Light/Compiler/Ty/Pretty.hs +++ b/src/UHC/Light/Compiler/Ty/Pretty.hs @@ -18,6 +18,7 @@ import qualified Data.Map as Map import Data.Char import UHC.Light.Compiler.Base.CfgPP +import qualified UHC.Util.RLList as RLL @@ -69,6 +70,8 @@ + + ppTyWithCfg' :: CfgPP' x => x -> Ty -> PP_Doc ppTyWithCfg' x ty = pp_Syn_TyAGItf $ synTyWithCfg (cfgPPTy x) ty @@ -157,7 +160,7 @@ ] instance PP PredScope where - pp (PredScope_Lev l) = ppListSep "<" ">" "," $ rllToList l + pp (PredScope_Lev l) = ppListSep "<" ">" "," $ RLL.toList l pp (PredScope_Var v) = "|< v >|< ">" instance PP ImplsProveOcc where diff --git a/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs b/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs --- a/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs +++ b/src/UHC/Light/Compiler/Ty/TreeTrieKey.hs @@ -11,8 +11,9 @@ 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.Util.TreeTrie import UHC.Light.Compiler.CHR.Key +import UHC.Util.CHR.Key @@ -56,6 +57,8 @@ + + tyTreeTrieKey :: TTKeyableOpts -> Ty -> TreeTrieKey Key tyTreeTrieKey opts ty = let t = wrap_TyAGItf @@ -65,23 +68,35 @@ +type instance TTKey Ty = Key + instance TTKeyable Ty where toTTKey' o = tyTreeTrieKey o +type instance TTKey Pred = Key + instance TTKeyable Pred where toTTKey' o pr = tyTreeTrieKey o $ mkTyPr pr +type instance TTKey PredScope = Key + 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 +type instance TTKey CHRPredOccCxt = Key + instance TTKeyable CHRPredOccCxt where toTTKey' o (CHRPredOccCxt_Scope1 sc) = toTTKey' o sc -- for now +type instance TTKey PredOcc = Key + instance TTKeyable PredOcc where toTTKey' o po = toTTKey' o (poPr po) +type instance TTKey CHRPredOcc = Key + 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)]) @@ -89,6 +104,8 @@ +type instance TTKey PredOccId = Key + instance TTKeyable PredOccId where toTTKey' o (PredOccId i) = ttkSingleton $ TT1K_One $ Key_UID i @@ -103,10 +120,14 @@ +type instance TTKey LabelOffset = Key + 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 + +type instance TTKey Label = Key instance TTKeyable Label where toTTKey' = labelTreeTrieKey diff --git a/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs b/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs --- a/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs +++ b/src/UHC/Light/Compiler/Ty/Trf/BetaReduce.hs @@ -98,7 +98,7 @@ {-# LINE 127 "src/ehc/Ty/Trf/BetaReduce.chs" #-} -- | one expansion step of type level beta reduction tyBetaRed1 - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Either Ty TyBetaRedLookAheadExpansion -> Maybe TyBetaRedOut tyBetaRed1 renv lkup tyOrFunAndArgs @@ -147,7 +147,7 @@ {-# LINE 180 "src/ehc/Ty/Trf/BetaReduce.chs" #-} tyBetaRed' - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Either Ty TyBetaRedLookAheadExpansion -> [TyBetaRedOut] tyBetaRed' renv lkup tyOrFunArgs @@ -156,13 +156,13 @@ _ -> [] tyBetaRed - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty -> [TyBetaRedOut] tyBetaRed renv lkup ty = tyBetaRed' renv lkup (Left ty) tyBetaRedAndInit - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> TyBetaRedLkup gm -> Ty -> [TyBetaRedOut] tyBetaRedAndInit renv lkup ty @@ -171,7 +171,7 @@ {-# LINE 210 "src/ehc/Ty/Trf/BetaReduce.chs" #-} tyBetaRedFullMb - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> TyBetaRedLkup gm -> (Ty -> Maybe TyBetaRedOut) -> Ty -> Maybe TyBetaRedOut tyBetaRedFullMb renv lkup redSub ty diff --git a/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs b/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs --- a/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs +++ b/src/UHC/Light/Compiler/Ty/Trf/Canonic.hs @@ -134,7 +134,7 @@ tyCanonic - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> Ty -> Ty tyCanonic fi @@ -145,7 +145,7 @@ tyCanonicFFI' - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => Bool -- expand newtypes -> TyBetaRedEnv gm -> Ty @@ -167,7 +167,7 @@ tyCanonicFFI - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> Ty -> Ty @@ -176,7 +176,7 @@ predCanonic - :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm) + :: (VarLookup gm TyVarId VarMpInfo, VarLookupCmb VarMp gm, SubstVarKey gm ~ VarId, SubstVarVal gm ~ VarMpInfo) => TyBetaRedEnv gm -> Pred -> (Pred,VarMp) predCanonic renv diff --git a/src/UHC/Light/Compiler/Ty/Utils1.hs b/src/UHC/Light/Compiler/Ty/Utils1.hs --- a/src/UHC/Light/Compiler/Ty/Utils1.hs +++ b/src/UHC/Light/Compiler/Ty/Utils1.hs @@ -15,7 +15,7 @@ {-# LINE 19 "src/ehc/Ty/Utils1.chs" #-} -ppTyS :: VarUpdatable Ty m => m -> Ty -> PP_Doc +ppTyS :: (VarUpdatable Ty m, SubstVarKey m ~ VarId) => m -> Ty -> PP_Doc ppTyS = ppS ppTy {-# LINE 24 "src/ehc/Ty/Utils1.chs" #-} diff --git a/src/UHC/Light/Compiler/VarMp.hs b/src/UHC/Light/Compiler/VarMp.hs --- a/src/UHC/Light/Compiler/VarMp.hs +++ b/src/UHC/Light/Compiler/VarMp.hs @@ -84,7 +84,7 @@ | VMIPredSeq !PredSeq deriving ( Eq, Ord, Show - , Typeable, Data + , Typeable ) {-# LINE 244 "src/ehc/VarMp.chs" #-} diff --git a/uhc-light.cabal b/uhc-light.cabal --- a/uhc-light.cabal +++ b/uhc-light.cabal @@ -1,5 +1,5 @@ Name: uhc-light -Version: 1.1.9.1 +Version: 1.1.9.2 License: BSD3 Copyright: Utrecht University, Department of Information and Computing Sciences, Software Technology group Build-Type: Simple @@ -12,25 +12,25 @@ Synopsis: Part of UHC packaged as cabal/hackage installable library Description: A 'light' variant of UHC including only an API and executables for compiling to Core representation (uhcl) and running CoreRun (uhcr). This version is just to test the infrastructure. Later versions will provide a fleshing out of the API and completion of the now rudimentary platform independent (Haskell) interpreted running 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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.9.1/103/cr/plain/Control/Monad.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Control/Monad.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Bits.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Char.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Either.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/IORef.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/List.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Maybe.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Data/Typeable.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Debug/Trace.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/Ptr.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Foreign/StablePtr.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/CTypes.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/dirUtils.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBase.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/HsBaseConfig.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/IntLikeInstance.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/MachDeps.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/TupleInstance.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/include/Typeable.h,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/installed-pkg-config,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Error.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Fix.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO/Unsafe.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/System/IO.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Array.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Base.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bits.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Bounded.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/BoxArray.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Char.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Enum.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Eq.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Float.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/GC.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics/Tuple.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Generics.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Handle.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IO.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/IOBase.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ix.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/LazyST.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MutVar.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/MVar.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/OldException.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ord.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Prims.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Ptr.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Read.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Real.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Run.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Show.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/ST.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StablePtr.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/StackTrace.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/STRef.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Types.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/Weak.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/UHC/WeakPtr.hi,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.bcrr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.cr,103/lib/pkg/uhcbase-1.1.9.1/103/cr/plain/Unsafe/Coerce.hi +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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.bcrr,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.9.2/103/cr/plain/Control/Monad.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Control/Monad.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Bits.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Char.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Either.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/IORef.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/List.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Maybe.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Data/Typeable.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Debug/Trace.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/Ptr.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Foreign/StablePtr.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/CTypes.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/dirUtils.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/HsBase.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/HsBaseConfig.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/IntLikeInstance.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/MachDeps.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/TupleInstance.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/include/Typeable.h,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/installed-pkg-config,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Error.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Fix.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO/Unsafe.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/System/IO.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Array.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Base.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bits.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Bounded.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/BoxArray.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Char.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Enum.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Eq.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Float.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/GC.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics/Tuple.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Generics.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Handle.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IO.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/IOBase.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ix.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/LazyST.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MutVar.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/MVar.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/OldException.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ord.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Prims.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Ptr.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Read.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Real.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Run.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Show.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/ST.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StablePtr.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/StackTrace.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/STRef.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Types.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/Weak.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/UHC/WeakPtr.hi,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.bcrr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.cr,103/lib/pkg/uhcbase-1.1.9.2/103/cr/plain/Unsafe/Coerce.hi extra-source-files: changelog.md Library Hs-Source-Dirs: src - Build-Depends: fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.2&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale - Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables + Build-Depends: fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.3&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale + Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables,TypeFamilies Exposed-Modules: UHC.Light.Compiler.API,UHC.Light.Compiler.Base.API,UHC.Light.Compiler.Core.API,UHC.Light.Compiler.CoreRun.API,UHC.Light.Compiler.CoreRun.API.Internal,UHC.Light.Compiler.EH.Main,UHC.Light.Compiler.EHC.Main,UHC.Light.Compiler.EHC.Main.Compile,UHC.Light.Compiler.EHC.Main.Utils - 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.Trace,UHC.Light.Compiler.Base.TreeTrie,UHC.Light.Compiler.Base.UID,UHC.Light.Compiler.Base.UnderDev,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.CEnv,UHC.Light.Compiler.CodeGen.CVar,UHC.Light.Compiler.CodeGen.Const,UHC.Light.Compiler.CodeGen.ImportUsedModules,UHC.Light.Compiler.CodeGen.ModuleImportExportImpl,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.Check,UHC.Light.Compiler.CoreRun.ModImpExp,UHC.Light.Compiler.CoreRun.Parser,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.ASTHandler,UHC.Light.Compiler.EHC.ASTHandler.Instances,UHC.Light.Compiler.EHC.ASTPipeline,UHC.Light.Compiler.EHC.ASTTypes,UHC.Light.Compiler.EHC.BuildFunction,UHC.Light.Compiler.EHC.BuildFunction.Run,UHC.Light.Compiler.EHC.Common,UHC.Light.Compiler.EHC.CompileGroup,UHC.Light.Compiler.EHC.CompilePhase.Cleanup,UHC.Light.Compiler.EHC.CompilePhase.Common,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.CompileRun.Base,UHC.Light.Compiler.EHC.CompileUnit,UHC.Light.Compiler.EHC.Environment,UHC.Light.Compiler.EHC.FileSuffMp,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 + Other-Modules: Paths_uhc_light,UHC.Light.Compiler.AbstractCore,UHC.Light.Compiler.AbstractCore.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.Range,UHC.Light.Compiler.Base.Strictness,UHC.Light.Compiler.Base.Target,UHC.Light.Compiler.Base.TermLike,UHC.Light.Compiler.Base.Trace,UHC.Light.Compiler.Base.UID,UHC.Light.Compiler.Base.UnderDev,UHC.Light.Compiler.CHR.Constraint,UHC.Light.Compiler.CHR.Guard,UHC.Light.Compiler.CHR.Instances,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.CEnv,UHC.Light.Compiler.CodeGen.CVar,UHC.Light.Compiler.CodeGen.Const,UHC.Light.Compiler.CodeGen.ImportUsedModules,UHC.Light.Compiler.CodeGen.ModuleImportExportImpl,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.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.RenUniq,UHC.Light.Compiler.Core.UsedModNms,UHC.Light.Compiler.Core.Utils,UHC.Light.Compiler.CoreRun,UHC.Light.Compiler.CoreRun.Check,UHC.Light.Compiler.CoreRun.ModImpExp,UHC.Light.Compiler.CoreRun.Parser,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.ASTHandler,UHC.Light.Compiler.EHC.ASTHandler.Instances,UHC.Light.Compiler.EHC.ASTPipeline,UHC.Light.Compiler.EHC.ASTTypes,UHC.Light.Compiler.EHC.BuildFunction,UHC.Light.Compiler.EHC.BuildFunction.Run,UHC.Light.Compiler.EHC.Common,UHC.Light.Compiler.EHC.CompileGroup,UHC.Light.Compiler.EHC.CompilePhase.Cleanup,UHC.Light.Compiler.EHC.CompilePhase.Common,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.CompileRun.Base,UHC.Light.Compiler.EHC.CompileUnit,UHC.Light.Compiler.EHC.Environment,UHC.Light.Compiler.EHC.FileSuffMp,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.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 Ghc-Options: -fno-warn-tabs Executable uhcl Hs-Source-Dirs: src-main - Build-Depends: uhc-light==1.1.9.1, fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.2&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale - Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables + Build-Depends: uhc-light==1.1.9.2, fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.3&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale + Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables,TypeFamilies Main-Is: EHC.hs Executable uhcr Hs-Source-Dirs: src-main - Build-Depends: uhc-light==1.1.9.1, fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.2&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale - Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables + Build-Depends: uhc-light==1.1.9.2, fgl,uulib>=0.9.19,hashable>=1.1&&<1.3,uhc-util>=0.1.6.3&&<0.1.7,base>=4.7&&<5,vector,syb,network,binary,mtl,transformers,directory,containers,array,process,filepath,primitive,binary,syb,bytestring,uulib>=0.9.12,old-locale + Extensions: RankNTypes,MultiParamTypeClasses,FunctionalDependencies,UndecidableInstances,DeriveDataTypeable,LiberalTypeSynonyms,StandaloneDeriving,DeriveGeneric,FlexibleContexts,FlexibleInstances,TypeSynonymInstances,ScopedTypeVariables,TypeFamilies Main-Is: EHCRun.hs