File tree 3 files changed +14
-11
lines changed
3 files changed +14
-11
lines changed Original file line number Diff line number Diff line change @@ -352,13 +352,16 @@ instance Matchable (Prim.Vec Term Term) where
352
352
-- Term builders
353
353
354
354
newtype TermBuilder v =
355
- TermBuilder { runTermBuilder :: forall m . Monad m => (TermF Term -> m Term ) -> m v }
355
+ TermBuilder
356
+ { runTermBuilder ::
357
+ forall m . Monad m => (Ident -> m Term ) -> (TermF Term -> m Term ) -> m v
358
+ }
356
359
357
360
instance Monad TermBuilder where
358
- m >>= h = TermBuilder $ \ mk -> do
359
- r <- runTermBuilder m mk
360
- runTermBuilder (h r) mk
361
- return v = TermBuilder $ \ _ -> return v
361
+ m >>= h = TermBuilder $ \ mg mk -> do
362
+ r <- runTermBuilder m mg mk
363
+ runTermBuilder (h r) mg mk
364
+ return v = TermBuilder $ \ _ _ -> return v
362
365
363
366
instance Functor TermBuilder where
364
367
fmap = liftM
@@ -368,10 +371,10 @@ instance Applicative TermBuilder where
368
371
(<*>) = ap
369
372
370
373
mkTermF :: TermF Term -> TermBuilder Term
371
- mkTermF tf = TermBuilder (\ mk -> mk tf)
374
+ mkTermF tf = TermBuilder (\ _ mk -> mk tf)
372
375
373
376
mkGlobalDef :: Ident -> TermBuilder Term
374
- mkGlobalDef i = mkTermF ( FTermF ( GlobalDef i) )
377
+ mkGlobalDef i = TermBuilder ( \ mg _ -> mg i )
375
378
376
379
infixl 9 `mkApp`
377
380
infixl 9 `pureApp`
Original file line number Diff line number Diff line change @@ -572,7 +572,7 @@ rewriteSharedTerm sc ss t0 =
572
572
-- print (Net.toPat conv)
573
573
case runConversion conv t of
574
574
Nothing -> apply rules t
575
- Just tb -> rewriteAll =<< runTermBuilder tb (scTermF sc)
575
+ Just tb -> rewriteAll =<< runTermBuilder tb (scGlobalDef sc) ( scTermF sc)
576
576
577
577
-- | Type-safe rewriter for shared terms
578
578
rewriteSharedTermTypeSafe
@@ -644,7 +644,7 @@ rewriteSharedTermTypeSafe sc ss t0 =
644
644
apply (Right conv : rules) t =
645
645
case runConversion conv t of
646
646
Nothing -> apply rules t
647
- Just tb -> rewriteAll =<< runTermBuilder tb (scTermF sc)
647
+ Just tb -> rewriteAll =<< runTermBuilder tb (scGlobalDef sc) ( scTermF sc)
648
648
649
649
-- | Generate a new SharedContext that normalizes terms as it builds them.
650
650
rewritingSharedContext :: SharedContext -> Simpset -> SharedContext
@@ -677,7 +677,7 @@ rewritingSharedContext sc ss = sc'
677
677
apply (Right conv : rules) t =
678
678
case runConversion conv t of
679
679
Nothing -> apply rules t
680
- Just tb -> runTermBuilder tb (scTermF sc')
680
+ Just tb -> runTermBuilder tb (scGlobalDef sc) ( scTermF sc')
681
681
682
682
683
683
-- FIXME: is there some way to have sensable term replacement in the presence of loose variables
Original file line number Diff line number Diff line change @@ -22,7 +22,7 @@ import Test.Tasty
22
22
import Test.Tasty.HUnit
23
23
24
24
scMkTerm :: SharedContext -> TermBuilder Term -> IO Term
25
- scMkTerm sc t = runTermBuilder t (scTermF sc)
25
+ scMkTerm sc t = runTermBuilder t (scGlobalDef sc) ( scTermF sc)
26
26
27
27
rewriter_tests :: [TestTree ]
28
28
rewriter_tests =
You can’t perform that action at this time.
0 commit comments