@@ -172,6 +172,12 @@ testConf = do
172
172
, terminalLabels = []
173
173
}
174
174
175
+ ignoreRulePredicateAndSubst :: RewriteResult Pattern -> RewriteResult Pattern
176
+ ignoreRulePredicateAndSubst =
177
+ \ case
178
+ RewriteBranch pre posts -> RewriteBranch pre (NE. map (\ (lbl, uid, p, _, _) -> (lbl, uid, p, Nothing , mempty )) posts)
179
+ other -> other
180
+
175
181
----------------------------------------
176
182
errorCases
177
183
, rewriteSuccess
@@ -244,7 +250,7 @@ rulePriority =
244
250
245
251
runWith :: Term -> IO (Either (RewriteFailed " Rewrite" ) (RewriteResult Pattern ))
246
252
runWith t =
247
- second fst <$> do
253
+ second (ignoreRulePredicateAndSubst . fst ) <$> do
248
254
conf <- testConf
249
255
runNoLoggingT $ runRewriteT conf mempty (rewriteStep [] [] $ Pattern_ t)
250
256
@@ -260,7 +266,10 @@ branchesTo :: Term -> [(Text, Term)] -> IO ()
260
266
t `branchesTo` ts =
261
267
runWith t
262
268
@?>>= Right
263
- (RewriteBranch (Pattern_ t) $ NE. fromList $ map (\ (lbl, t') -> (lbl, mockUniqueId, Pattern_ t')) ts)
269
+ ( RewriteBranch (Pattern_ t) $
270
+ NE. fromList $
271
+ map (\ (lbl, t') -> (lbl, mockUniqueId, Pattern_ t', Nothing , mempty )) ts
272
+ )
264
273
265
274
failsWith :: Term -> RewriteFailed " Rewrite" -> IO ()
266
275
failsWith t err =
@@ -276,7 +285,7 @@ runRewrite t = do
276
285
runNoLoggingT $
277
286
performRewrite conf $
278
287
Pattern_ t
279
- pure (counter, fmap (. term) res)
288
+ pure (counter, fmap (. term) (ignoreRulePredicateAndSubst res) )
280
289
281
290
aborts :: RewriteFailed " Rewrite" -> Term -> IO ()
282
291
aborts failure t = runRewrite t >>= (@?= (0 , RewriteAborted failure t))
@@ -306,11 +315,15 @@ canRewrite =
306
315
( " con1-f2"
307
316
, mockUniqueId
308
317
, [trm | kCell{}( kseq{}( inj{AnotherSort{}, SortKItem{}}( con4{}( \dv{SomeSort{}}("somethingElse"), \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
318
+ , Nothing
319
+ , mempty
309
320
)
310
321
branch2 =
311
322
( " con1-f1'"
312
323
, mockUniqueId
313
324
, [trm | kCell{}( kseq{}( inj{SomeSort{}, SortKItem{}}( f1{}( \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
325
+ , Nothing
326
+ , mempty
314
327
)
315
328
316
329
rewrites
@@ -399,11 +412,15 @@ supportsDepthControl =
399
412
( " con1-f2"
400
413
, mockUniqueId
401
414
, [trm | kCell{}( kseq{}( inj{AnotherSort{}, SortKItem{}}( con4{}( \dv{SomeSort{}}("somethingElse"), \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
415
+ , Nothing
416
+ , mempty
402
417
)
403
418
branch2 =
404
419
( " con1-f1'"
405
420
, mockUniqueId
406
421
, [trm | kCell{}( kseq{}( inj{SomeSort{}, SortKItem{}}( f1{}( \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
422
+ , Nothing
423
+ , mempty
407
424
)
408
425
409
426
rewritesToDepth
@@ -419,7 +436,7 @@ supportsDepthControl =
419
436
conf <- testConf
420
437
(counter, _, res) <-
421
438
runNoLoggingT $ performRewrite conf{mbMaxDepth = Just depth} $ Pattern_ t
422
- (counter, fmap (. term) res) @?= (n, f t')
439
+ (counter, fmap (. term) (ignoreRulePredicateAndSubst res) ) @?= (n, f t')
423
440
424
441
supportsCutPoints :: TestTree
425
442
supportsCutPoints =
@@ -452,11 +469,15 @@ supportsCutPoints =
452
469
( " con1-f2"
453
470
, mockUniqueId
454
471
, [trm | kCell{}( kseq{}( inj{AnotherSort{}, SortKItem{}}( con4{}( \dv{SomeSort{}}("somethingElse"), \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
472
+ , Nothing
473
+ , mempty
455
474
)
456
475
branch2 =
457
476
( " con1-f1'"
458
477
, mockUniqueId
459
478
, [trm | kCell{}( kseq{}( inj{SomeSort{}, SortKItem{}}( f1{}( \dv{SomeSort{}}("somethingElse") ) ), C:SortK{}) ) |]
479
+ , Nothing
480
+ , mempty
460
481
)
461
482
462
483
rewritesToCutPoint
@@ -474,7 +495,7 @@ supportsCutPoints =
474
495
runNoLoggingT $
475
496
performRewrite conf{cutLabels = [lbl]} $
476
497
Pattern_ t
477
- (counter, fmap (. term) res) @?= (n, f t')
498
+ (counter, fmap (. term) (ignoreRulePredicateAndSubst res) ) @?= (n, f t')
478
499
479
500
supportsTerminalRules :: TestTree
480
501
supportsTerminalRules =
0 commit comments