| ... |
... |
@@ -1357,37 +1357,37 @@ decomposeRuleLhs dflags orig_bndrs orig_lhs rhs_fvs |
|
1357
|
1357
|
= Left (DsRuleIgnoredDueToConstructor con) -- See Note [No RULES on datacons]
|
|
1358
|
1358
|
|
|
1359
|
1359
|
| otherwise = case decompose fun2 args2 of
|
|
1360
|
|
- Nothing -> pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
1361
|
|
- , text "orig_lhs:" <+> ppr orig_lhs
|
|
1362
|
|
- , text "rhs_fvs:" <+> ppr rhs_fvs
|
|
1363
|
|
- , text "lhs1:" <+> ppr lhs1
|
|
1364
|
|
- , text "lhs2:" <+> ppr lhs2
|
|
1365
|
|
- , text "fun2:" <+> ppr fun2
|
|
1366
|
|
- , text "args2:" <+> ppr args2
|
|
1367
|
|
- ]) $
|
|
|
1360
|
+ Nothing -> -- pprTrace "decomposeRuleLhs 3" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
|
1361
|
+ -- , text "orig_lhs:" <+> ppr orig_lhs
|
|
|
1362
|
+ -- , text "rhs_fvs:" <+> ppr rhs_fvs
|
|
|
1363
|
+ -- , text "lhs1:" <+> ppr lhs1
|
|
|
1364
|
+ -- , text "lhs2:" <+> ppr lhs2
|
|
|
1365
|
+ -- , text "fun2:" <+> ppr fun2
|
|
|
1366
|
+ -- , text "args2:" <+> ppr args2
|
|
|
1367
|
+ -- ]) $
|
|
1368
|
1368
|
Left (DsRuleLhsTooComplicated orig_lhs lhs2)
|
|
1369
|
1369
|
|
|
1370
|
1370
|
Just (fn_id, args)
|
|
1371
|
1371
|
| not (null unbound) ->
|
|
1372
|
1372
|
-- Check for things unbound on LHS
|
|
1373
|
1373
|
-- See Note [Unused spec binders]
|
|
1374
|
|
- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
1375
|
|
- , text "orig_lhs:" <+> ppr orig_lhs
|
|
1376
|
|
- , text "lhs_fvs:" <+> ppr lhs_fvs
|
|
1377
|
|
- , text "rhs_fvs:" <+> ppr rhs_fvs
|
|
1378
|
|
- , text "unbound:" <+> ppr unbound
|
|
1379
|
|
- ]) $
|
|
|
1374
|
+ -- pprTrace "decomposeRuleLhs 1" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
|
1375
|
+ -- , text "orig_lhs:" <+> ppr orig_lhs
|
|
|
1376
|
+ -- , text "lhs_fvs:" <+> ppr lhs_fvs
|
|
|
1377
|
+ -- , text "rhs_fvs:" <+> ppr rhs_fvs
|
|
|
1378
|
+ -- , text "unbound:" <+> ppr unbound
|
|
|
1379
|
+ -- ]) $
|
|
1380
|
1380
|
Left (DsRuleBindersNotBound unbound orig_bndrs orig_lhs lhs2)
|
|
1381
|
1381
|
| otherwise ->
|
|
1382
|
|
- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
1383
|
|
- , text "orig_lhs:" <+> ppr orig_lhs
|
|
1384
|
|
- , text "lhs1:" <+> ppr lhs1
|
|
1385
|
|
- , text "trimmed_bndrs:" <+> ppr trimmed_bndrs
|
|
1386
|
|
- , text "extra_dicts:" <+> ppr extra_dicts
|
|
1387
|
|
- , text "fn_id:" <+> ppr fn_id
|
|
1388
|
|
- , text "args:" <+> ppr args
|
|
1389
|
|
- , text "args fvs:" <+> ppr (exprsFreeVarsList args)
|
|
1390
|
|
- ]) $
|
|
|
1382
|
+ -- pprTrace "decomposeRuleLhs 2" (vcat [ text "orig_bndrs:" <+> ppr orig_bndrs
|
|
|
1383
|
+ -- , text "orig_lhs:" <+> ppr orig_lhs
|
|
|
1384
|
+ -- , text "lhs1:" <+> ppr lhs1
|
|
|
1385
|
+ -- , text "trimmed_bndrs:" <+> ppr trimmed_bndrs
|
|
|
1386
|
+ -- , text "extra_dicts:" <+> ppr extra_dicts
|
|
|
1387
|
+ -- , text "fn_id:" <+> ppr fn_id
|
|
|
1388
|
+ -- , text "args:" <+> ppr args
|
|
|
1389
|
+ -- , text "args fvs:" <+> ppr (exprsFreeVarsList args)
|
|
|
1390
|
+ -- ]) $
|
|
1391
|
1391
|
Right (trimmed_bndrs ++ extra_dicts, fn_id, args)
|
|
1392
|
1392
|
|
|
1393
|
1393
|
where -- See Note [Variables unbound on the LHS]
|