- -- fixpoint computation
- -- of a number of rewrites of equalities
-eq_rewrite ::
- [(String,[Inst] -> TcM ([Inst],Bool))] -> -- rewrite functions and descriptions
- [Inst] -> -- initial equations
- TcM [Inst] -- final equations (at fixed point)
-eq_rewrite rewrites insts
- = go rewrites insts
- where
- go _ [] -- return quickly when there's nothing to be done
- = return []
- go [] insts
- = return insts
- go ((desc,r):rs) insts
- = do { (insts',changed) <- r insts
- ; traceTc (text desc <+> ppr insts')
- ; if changed
- then loop insts'
- else go rs insts'
- }
- loop = eq_rewrite rewrites
-
- -- fixpoint computation
- -- of a number of rewrites of equalities
-given_eq_rewrite ::
-
- (String,[Inst] -> TcM ([Inst],TcM ())) ->
- (TcM ()) ->
- [(String,[Inst] -> TcM ([Inst],Bool))] -> -- rewrite functions and descriptions
- [Inst] -> -- initial equations
- TcM ([Inst],TcM ()) -- final equations (at fixed point)
-given_eq_rewrite p@(desc,start) acc rewrites insts
- = do { (insts',acc') <- start insts
- ; go (acc >> acc') rewrites insts'
- }
- where
- go acc _ [] -- return quickly when there's nothing to be done
- = return ([],acc)
- go acc [] insts
- = return (insts,acc)
- go acc ((desc,r):rs) insts
- = do { (insts',changed) <- r insts
- ; traceTc (text desc <+> ppr insts')
- ; if changed
- then loop acc insts'
- else go acc rs insts'
- }
- loop acc = given_eq_rewrite p acc rewrites
-
-simple_rewrite ::
- ([Inst] -> TcM [Inst]) ->
- ([Inst] -> TcM ([Inst],Bool))
-simple_rewrite r insts
- = do { insts' <- r insts
- ; return (insts',False)
- }
+(2) Precondition rules that rewrite a set of insts and return a monadic action
+ that reverts the effect of preconditioning.
+
+(3) Idempotent normalisation rules that never require re-running the rule set.
+
+(4) Checking rule that does not alter the set of insts.
+
+\begin{code}
+type RewriteRule = [Inst] -> TcM ([Inst], Bool) -- rewrite, maybe re-run
+type PrecondRule = [Inst] -> TcM ([Inst], TcM ()) -- rewrite, revertable
+type IdemRewriteRule = [Inst] -> TcM [Inst] -- rewrite, don't re-run
+type CheckRule = [Inst] -> TcM () -- check
+
+type NamedRule = (String, RewriteRule) -- rule with description
+type NamedPreRule = (String, PrecondRule) -- precond with desc
+\end{code}
+
+Templates lifting idempotent and checking rules to full rules (which can be put
+into a rule set).
+
+\begin{code}
+dontRerun :: IdemRewriteRule -> RewriteRule
+dontRerun rule insts = liftM addFalse $ rule insts
+ where
+ addFalse x = (x, False)
+
+noChange :: CheckRule -> RewriteRule
+noChange rule insts = rule insts >> return (insts, False)
+\end{code}