Skip to content

Commit

Permalink
replaced PrettyAST by PrettyTrace, which pretty prints AST included t…
Browse files Browse the repository at this point in the history 
…he tracing info switched on by --debug-traceon
  • Loading branch information
@atzedijkstra
atzedijkstra committed Oct 21, 2015
1 parent 42ea9ce commit c8978d4
Show file tree
Hide file tree
Showing 12 changed files with 403 additions and 92 deletions.
9 changes: 3 additions & 6 deletions EHC/src/ehc/Base/Trace.chs
View file
Expand Up @@ -79,6 +79,9 @@ trppIsEmpty = Sq.null

trppEmpty :: TrPP
trppEmpty = Sq.empty

instance PP TrPP where
pp = vlist . Fld.toList
%%]

%%[1 export(trPPOnIO, trPP, trOnPP, trOn)
Expand All @@ -96,12 +99,6 @@ trPPOnIO ppl = liftIO $ mapM_ putPPLn $ Fld.toList ppl
-- | 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
Expand Down
8 changes: 7 additions & 1 deletion EHC/src/ehc/CHR/Constraint.chs
View file
Expand Up @@ -57,7 +57,13 @@ data Constraint p info
type instance TTKey (Constraint p info) = TTKey p
%%]

%%[(9 hmtyinfer || hmtyast) export(mkReduction)
%%[(9 hmtyinfer || hmtyast) export(mkProve, mkAssume, mkReduction)
mkProve :: p -> Constraint p info
mkProve = Prove

mkAssume :: p -> Constraint p info
mkAssume = Assume

mkReduction :: p -> info -> [p] -> Constraint p info
mkReduction p i ps
= Reduction p i ps
Expand Down
29 changes: 25 additions & 4 deletions EHC/src/ehc/CHR/Solve.chs
View file
Expand Up @@ -8,11 +8,32 @@ Assumptions (to be documented further)
- The key [Trie.TrieKey Key] used to lookup a constraint in a CHR should be distinguishing enough to be used for the prevention
of the application of a propagation rule for a 2nd time.

%%[(9 hmtyinfer || hmtyast) module {%{EH}CHR.Solve} import(UHC.Util.CHR.Solve.TreeTrie.Mono) export(module UHC.Util.CHR.Solve.TreeTrie.Mono)
-- no additions, for now, moved to uhc-util
%%[(9 hmtyinfer) module {%{EH}CHR.Solve} import(UHC.Util.CHR.Solve.TreeTrie.Mono hiding(IsCHRSolvable(..), SolveState), qualified UHC.Util.CHR.Solve.TreeTrie.Mono as Mono) export(module UHC.Util.CHR.Solve.TreeTrie.Mono, IsCHRSolvable(..), SolveState)
instance Mono.IsCHRSolvable FIIn CHRPredConstraint Guard VarMp

-- | (Class alias) API for solving requirements, hiding Mono/Poly differences
class ( Mono.IsCHRSolvable env c g s
) => IsCHRSolvable env c g s

instance IsCHRSolvable FIIn CHRPredConstraint Guard VarMp

type SolveState e c g s = Mono.SolveState c g s
%%]

%%[(9999 hmtyinfer) module {%{EH}CHR.Solve} import(UHC.Util.CHR.Solve.TreeTrie.Poly hiding(IsCHRSolvable(..), SolveState), qualified UHC.Util.CHR.Solve.TreeTrie.Poly as Poly) export(module UHC.Util.CHR.Solve.TreeTrie.Poly, IsCHRSolvable(..), SolveState)
instance Poly.IsCHRSolvable FIIn VarMp

-- | (Class alias) API for solving requirements, hiding Mono/Poly differences
class ( Poly.IsCHRSolvable env s
) => IsCHRSolvable env c g s

instance IsCHRSolvable FIIn CHRPredConstraint Guard VarMp

type instance TTKey (CHRConstraint FIIn VarMp) = Key

type SolveState e c g s = Poly.SolveState e s
%%]

%%[(9999 hmtyinfer || hmtyast) module {%{EH}CHR.Solve} import(UHC.Util.CHR.Solve.TreeTrie.Poly) export(module UHC.Util.CHR.Solve.TreeTrie.Poly)
-- no additions, for now, moved to uhc-util
%%[(9 hmtyinfer) import({%{EH}Pred.CommonCHR}, {%{EH}Pred.CHR}, {%{EH}CHR.Key}, {%{EH}VarMp}, {%{EH}Ty.FitsInCommon2})
%%]

7 changes: 5 additions & 2 deletions EHC/src/ehc/EH/MainAG.cag
View file
Expand Up @@ -180,10 +180,13 @@ WRAPPER AGItf
%%[(8 noHmTyRuler hmtyinfer) -1.EHRulerRules
%%]

%%[1.PrettyAST ag import({EH/PrettyAST})
%%[1111.PrettyAST ag import({EH/PrettyAST})
%%]

%%[100 -1.PrettyAST
%%[100100 -1111.PrettyAST
%%]

%%[1 ag import({EH/PrettyTrace})
%%]

%%[(99 tyderivtree).PrettyLaTeX ag import({EH/PrettyLatexDerivTree})
Expand Down
292 changes: 292 additions & 0 deletions EHC/src/ehc/EH/PrettyTrace.cag
View file
@@ -0,0 +1,292 @@
%%[0 lhs2tex
%include lhs2TeX.fmt
%include afp.fmt
%%]

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%% Pretty printing of internal AST structure
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

This pretty printed AST representation displays the tree structure,
together with tracing info, meant for debugging. The basic
definitions only show the structure with placeholder local
info_<variant> attributes; additional per aspect definitions redefine
the placeholders.

%%[1 hs
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
%%]

%%[1
ATTR AllNT AGItf [ | | ppAST USE {>-<} {empty} : PP_Doc ]

SEM AGItf
| AGItf lhs . ppAST = ppNestTrPP @lhs.opts ["AGItf","AGItf"] [] [@expr.ppAST] @trppHere

SEM Decl
| Val lhs . ppAST = ppNestTrPP @lhs.opts ["Decl","Val"] [] [@patExpr.ppAST,@expr.ppAST] @trppHere
| TySig lhs . ppAST = ppNestTrPP @lhs.opts ["Decl","TySig"] [ppTrNm @nm] [@tyExpr.ppAST] @trppHere

SEM Expr
| IConst lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","IConst"] [@pp] [] @trppHere
| CConst lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","CConst"] [@pp] [] @trppHere
| Var lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Var"] [ppTrNm @nm] [] @trppHere
| Con lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Con"] [ppTrNm @nm] [] @trppHere
| Let lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Let"] [] [@decls.ppAST] @trppHere
>-< @body.ppAST
| App lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","App"] [] [@func.ppAST,@arg.ppAST] @trppHere
| Parens lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Parens"] [] [@expr.ppAST] @trppHere
| AppTop lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","AppTop"] [] [@expr.ppAST] @trppHere
| Lam lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Lam"] [] [@arg.ppAST,@body.ppAST] @trppHere
| TypeAs lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","TypeAs"] [pp @isScoped] [@expr.ppAST,@tyExpr.ppAST] @trppHere

SEM PatExpr
| IConst lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","IConst"] [@pp] [] @trppHere
| CConst lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","CConst"] [@pp] [] @trppHere
| Var lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","Var"] [ppTrNm @nm] [] @trppHere
| VarAs lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","VarAs"] [ppTrNm @nm] [@patExpr.ppAST] @trppHere
| Con lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","Con"] [ppTrNm @nm] [] @trppHere
| App lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","App"] [] [@func.ppAST,@arg.ppAST] @trppHere
| Parens lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","Parens"] [] [@patExpr.ppAST] @trppHere
| AppTop lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","AppTop"] [] [@patExpr.ppAST] @trppHere

SEM TyExpr
| Con lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Con"] [ppTrNm @nm] [] @trppHere
| App lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","App"] [] [@func.ppAST,@arg.ppAST] @trppHere
| Parens lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Parens"] [] [@tyExpr.ppAST] @trppHere
| AppTop lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","AppTop"] [] [@tyExpr.ppAST] @trppHere

SEM Decls
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["Decls","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["Decls","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere
%%]

%%[2
SEM TyExpr
| Wild lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Wild"] [] [] @trppHere
| Mono lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Mono"] [] [] @trppHere

%%]


%%[3
SEM TyExpr
| Var lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Var"] [ppTrNm @nm] [] @trppHere
| VarWild lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","VarWild"] [ppTrNm @nm] [] @trppHere
%%]

%%[4
SEM Expr
| AppImpred lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","AppImpred"] [] [@func.ppAST,@arg.ppAST] @trppHere

SEM PatExpr
| TypeAs lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","TypeAs"] [] [@patExpr.ppAST,@tyExpr.ppAST] @trppHere

SEM TyExpr
| Quant lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Quant"] [text (showTyQu @qu),ppTrNm @tyVar] [@tyExpr.ppAST] @trppHere
%%]

%%[5
SEM Decl
| Data lhs . ppAST = ppNestTrPP @lhs.opts ["Decl","Data"] [ppTrNm @tyNm] [@tyVars.ppAST,@constrs.ppAST] @trppHere

SEM Expr
| SConst lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","SConst"] [@pp] [] @trppHere
| Case lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","Case"] [] [@expr.ppAST,@alts.ppAST] @trppHere

SEM PatExpr
| SConst lhs . ppAST = ppNestTrPP @lhs.opts ["PatExpr","SConst"] [@pp] [] @trppHere

SEM CaseAlt
| Pat lhs . ppAST = ppNestTrPP @lhs.opts ["CaseAlt","Pat"] [] [@patExpr.ppAST,@expr.ppAST] @trppHere

SEM CaseAlts
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["CaseAlts","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["CaseAlts","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

SEM TyExprs
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["TyExprs","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["TyExprs","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

SEM TyVar
| Var lhs . ppAST = ppNestTrPP @lhs.opts ["TyVar","Var"] [ppTrNm @nm] [] @trppHere

SEM TyVars
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["TyVars","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["TyVars","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

SEM DataConstr
| Constr loc . ppAST = ppNestTrPP @lhs.opts ["DataConstr","Constr"] [ppTrNm @conNm]
[ @fields.ppAST
%%[[31
, @mbGadtTyExpr.ppAST
%%]]
%%[[41
, @eqs.ppAST
%%]]
] @trppHere

SEM DataConstrs
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrs","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrs","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere
%%]

%%[7
SEM Expr
| DataFields loc . ppAST = ppNestTrPP @lhs.opts ["Expr","DataFields"] [] [@dataFieldExpr.ppAST] @trppHere
| Rec loc . ppAST = ppNestTrPP @lhs.opts ["Expr","Rec"] [] [@recExpr.ppAST] @trppHere
| Sel loc . ppAST = ppNestTrPP @lhs.opts ["Expr","Sel"] [ppTrNm @lbl] [@expr.ppAST] @trppHere

SEM PatExpr
| DataFields loc . ppAST = ppNestTrPP @lhs.opts ["PatExpr","DataFields"] [] [@dataFieldPatExpr.ppAST] @trppHere
| Rec loc . ppAST = ppNestTrPP @lhs.opts ["PatExpr","Rec"] [] [@recPatExpr.ppAST] @trppHere

SEM TyExpr
| Row loc . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Row"] [] [@rowTyExpr.ppAST] @trppHere

SEM RecExpr
| Empty loc . ppAST = ppNestTrPP @lhs.opts ["RecExpr","Empty"] [] [] @trppHere
| Ext loc . ppAST = ppNestTrPP @lhs.opts ["RecExpr","Ext"] [ppTrNm @nm] [@recExpr.ppAST,@expr.ppAST] @trppHere
| Upd loc . ppAST = ppNestTrPP @lhs.opts ["RecExpr","Upd"] [ppTrNm @nm] [@recExpr.ppAST,@expr.ppAST] @trppHere
| Expr loc . ppAST = ppNestTrPP @lhs.opts ["RecExpr","Expr"] [] [@expr.ppAST] @trppHere

SEM RecPatExpr
| Empty loc . ppAST = ppNestTrPP @lhs.opts ["RecPatExpr","Empty"] [] [] @trppHere
| Ext loc . ppAST = ppNestTrPP @lhs.opts ["RecPatExpr","Ext"] [ppTrNm @nm] [@recPatExpr.ppAST,@patExpr.ppAST] @trppHere
| Expr loc . ppAST = ppNestTrPP @lhs.opts ["RecPatExpr","Expr"] [] [@patExpr.ppAST] @trppHere

SEM RowTyExpr
| Empty loc . ppAST = ppNestTrPP @lhs.opts ["RowTyExpr","Empty"] [] [] @trppHere
| Ext loc . ppAST = ppNestTrPP @lhs.opts ["RowTyExpr","Ext"] [ppTrNm @nm] [@rowTyExpr.ppAST,@tyExpr.ppAST] @trppHere

SEM DataField
| Field loc . ppAST = ppNestTrPP @lhs.opts ["DataField","Field"] [pp (maybe [] (map ppTrNm) @mbLabels)] [@tyExpr.ppAST] @trppHere

SEM DataFields
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["DataFields","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["DataFields","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

SEM DataFieldExpr
| Con loc . ppAST = ppNestTrPP @lhs.opts ["DataFieldExpr","Con"] [ppTrNm @nm] [] @trppHere
| Upd loc . ppAST = ppNestTrPP @lhs.opts ["DataFieldExpr","Upd"] [ppTrNm @nm] [@dataFieldExpr.ppAST,@expr.ppAST] @trppHere
| Expr loc . ppAST = ppNestTrPP @lhs.opts ["DataFieldExpr","Expr"] [] [@expr.ppAST] @trppHere

SEM DataFieldPatExpr
| Con loc . ppAST = ppNestTrPP @lhs.opts ["DataFieldPatExpr","Con"] [ppTrNm @nm] [] @trppHere
| Ext loc . ppAST = ppNestTrPP @lhs.opts ["DataFieldPatExpr","Ext"] [ppTrNm @nm] [@dataFieldPatExpr.ppAST,@patExpr.ppAST] @trppHere
%%]

%%[8
SEM Decl
| FFI loc . ppAST = ppNestTrPP @lhs.opts ["Decl","FFI"] [pp (show @impEnt),ppTrNm @nm] [@tyExpr.ppAST] @trppHere
%%]

%%[9
SEM RowTyExpr
| Var loc . ppAST = ppNestTrPP @lhs.opts ["RowTyExpr","Var"] [ppTrNm @nm] [] @trppHere

SEM TyExpr
| Pred loc . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Pred"] [] [@prExpr.ppAST] @trppHere

SEM PrExpr
| Class loc . ppAST = ppNestTrPP @lhs.opts ["PrExpr","Class"] [ppTrNm @nm] [@tyExprs.ppAST] @trppHere
| Arrow loc . ppAST = ppNestTrPP @lhs.opts ["PrExpr","Arrow"] [] [@arg.ppAST,@res.ppAST] @trppHere

SEM Decl
| Class loc . ppAST = ppNestTrPP @lhs.opts ["Decl","Class"] [] [ @tyPrExpr.ppAST
%%[[15
, @funcDeps.ppAST
%%]]
, @decls.ppAST] @trppHere
| Instance loc . ppAST = ppNestTrPP @lhs.opts ["Decl","Instance"] (maybe [] (\(n,_) -> [ppTrNm n]) @mbNmElim) [@tyPrExpr.ppAST,@decls.ppAST] @trppHere
| InstanceIntro
loc . ppAST = ppNestTrPP @lhs.opts ["Decl","InstanceIntro"] [] [@expr.ppAST,@prExpr.ppAST] @trppHere
| Default loc . ppAST = ppNestTrPP @lhs.opts ["Decl","Default"] [ppTrNm @nm] [@tyExprs.ppAST] @trppHere
%%]

%%[10
SEM Expr
| DynVar lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","DynVar"] [ppTrNm @nm] [] @trppHere

SEM PrExpr
| Lacks loc . ppAST = ppNestTrPP @lhs.opts ["PrExpr","Lacks"] [ppTrNm @nm] [@rowTyExpr.ppAST] @trppHere
| DynVar loc . ppAST = ppNestTrPP @lhs.opts ["PrExpr","DynVar"] [ppTrNm @nm] [@tyExpr.ppAST] @trppHere
%%]

%%[(11 hmtyinfer)
SEM TyExpr
| Lam lhs . ppAST = ppNestTrPP @lhs.opts ["TyExpr","Lam"] [ppTrNm @tyVar] [@tyExpr.ppAST] @trppHere
%%]

%%[12
SEM Expr
| AppImpl lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","AppImpl"] [] [@func.ppAST,@arg.ppAST,@argPr.ppAST] @trppHere
| LamImpl lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","LamImpl"] [] [@arg.ppAST,@argPr.ppAST,@body.ppAST] @trppHere
%%]

%%[15
SEM FuncDep
| Dep loc . ppAST = ppNestTrPP @lhs.opts ["FuncDep","Dep"] [] [@fromTvs.ppAST,@toTvs.ppAST] @trppHere

SEM FuncDeps
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["FuncDeps","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["FuncDeps","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

%%]

%%[31
SEM MbTyExpr
| Just loc . ppAST = ppNestTrPP @lhs.opts ["MbTyExpr","Just"] [] [@just.ppAST] @trppHere
| Nothing loc . ppAST = ppNestTrPP @lhs.opts ["MbTyExpr","Nothing"] [] [] @trppHere
%%]

%%[1010
SEM Decl
| DynVal lhs . ppAST = ppNestTrPP @lhs.opts ["Decl","DynVal"] [ppTrNm @nm] [@expr.ppAST] @trppHere
| DynTySig lhs . ppAST = ppNestTrPP @lhs.opts ["Decl","DynTySig"] [ppTrNm @nm] [@tyExpr.ppAST] @trppHere
%%]

%%[41
SEM DataConstrEq
| Eq lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEq","Eq"] [] [@tyVar.ppAST,@tyExpr.ppAST] @trppHere

SEM DataConstrEqs
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEqs","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEqs","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere
%%]

%%[31
SEM PrExpr
| Eq loc . ppAST = ppNestTrPP @lhs.opts ["PrExpr","Eq"] [] [@tyExpr1.ppAST,@tyExpr2.ppAST] @trppHere
%%]

%%[40
SEM DataConstrEq
| Eq lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEq","Eq"] [] [@tyVar.ppAST,@tyExpr.ppAST] @trppHere

SEM DataConstrEqs
| Nil lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEqs","Nil"] [] [] @trppHere
| Cons lhs . ppAST = ppNestTrPP @lhs.opts ["DataConstrEqs","Cons"] [] [@hd.ppAST,@tl.ppAST] @trppHere

SEM DataConstr
| Constr loc . ppAST := ppNestTrPP @lhs.opts ["DataConstr","Constr"] [ppTrNm @conNm] [@fields.ppAST,@eqs.ppAST] @trppHere
%%]

%%[90
SEM Decl
| FFE loc . ppAST = ppNestTrPP @lhs.opts ["Decl","FFE"] [ppTrNm @nm,pp @expEnt] [@expr.ppAST,@tyExpr.ppAST] @trppHere
%%]

%%[97
SEM Expr
| IIConst lhs . ppAST = ppNestTrPP @lhs.opts ["Expr","IIConst"] [@pp] [] @trppHere
%%]
7 changes: 1 addition & 6 deletions EHC/src/ehc/EH/ResolvePredCHR.cag
View file
Expand Up @@ -258,12 +258,7 @@ simplify' simplifyHow chrStore clDfGam heur partitionUnresolved2AmbigAndOthers t

; 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
Expand Down

0 comments on commit c8978d4

Please sign in to comment.