| ... |
... |
@@ -1554,7 +1554,8 @@ exprIsConApp_maybe :: HasDebugCallStack |
|
1554
|
1554
|
=> InScopeEnv -> CoreExpr
|
|
1555
|
1555
|
-> Maybe (InScopeSet, FloatBinds, DataCon, [Type], [CoreExpr])
|
|
1556
|
1556
|
exprIsConApp_maybe ise@(ISE in_scope id_unf) expr
|
|
1557
|
|
- = go (Left in_scope) emptyFloatBinds expr (CC [] MRefl)
|
|
|
1557
|
+ = -- pprTrace "exprIsConApp" (ppr expr) $
|
|
|
1558
|
+ go (Left in_scope) emptyFloatBinds expr (CC [] MRefl)
|
|
1558
|
1559
|
where
|
|
1559
|
1560
|
go :: Either InScopeSet Subst
|
|
1560
|
1561
|
-- Left in-scope means "empty substitution"
|
| ... |
... |
@@ -1667,7 +1668,8 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr |
|
1667
|
1668
|
| idArity fun == 0
|
|
1668
|
1669
|
, Just rhs <- expandUnfolding_maybe unfolding
|
|
1669
|
1670
|
, let in_scope' = extend_in_scope (exprFreeVars rhs)
|
|
1670
|
|
- = go (Left in_scope') floats rhs cont
|
|
|
1671
|
+ = -- pprTrace "exprIsConApp:unf" (ppr fun <+> ppr rhs) $
|
|
|
1672
|
+ go (Left in_scope') floats rhs cont
|
|
1671
|
1673
|
|
|
1672
|
1674
|
-- See Note [exprIsConApp_maybe on literal strings]
|
|
1673
|
1675
|
| (fun `hasKey` unpackCStringIdKey) ||
|
| ... |
... |
@@ -1707,17 +1709,21 @@ exprIsConApp_maybe ise@(ISE in_scope id_unf) expr |
|
1707
|
1709
|
subst_co (Right s) co = GHC.Core.Subst.substCo s co
|
|
1708
|
1710
|
|
|
1709
|
1711
|
subst_expr (Left {}) e = e
|
|
1710
|
|
- subst_expr (Right s) e = substExpr s e
|
|
|
1712
|
+ subst_expr (Right s) e = -- pprTrace "subst_expr" (text "subst" <+> ppr s $$ text "expr" <+> ppr e) $
|
|
|
1713
|
+ substExpr s e
|
|
1711
|
1714
|
|
|
1712
|
|
- subst_bndr msubst bndr
|
|
1713
|
|
- = (Right subst', bndr')
|
|
|
1715
|
+ subst_bndrs subst bs = mapAccumL subst_bndr subst bs
|
|
|
1716
|
+
|
|
|
1717
|
+ subst_bndr (Left in_scope) bndr
|
|
|
1718
|
+ | bndr `elemInScopeSet` in_scope = subst_bndr1 (mkEmptySubst in_scope) bndr
|
|
|
1719
|
+ | otherwise = (Left in_scope, bndr)
|
|
|
1720
|
+ subst_bndr (Right subst) bndr = subst_bndr1 subst bndr
|
|
|
1721
|
+
|
|
|
1722
|
+ subst_bndr1 subst bndr
|
|
|
1723
|
+ = -- pprTrace "subst_bndr1" (ppr bndr <+> ppr bndr' $$ ppr subst) $
|
|
|
1724
|
+ (Right subst', bndr')
|
|
1714
|
1725
|
where
|
|
1715
|
1726
|
(subst', bndr') = substBndr subst bndr
|
|
1716
|
|
- subst = case msubst of
|
|
1717
|
|
- Left in_scope -> mkEmptySubst in_scope
|
|
1718
|
|
- Right subst -> subst
|
|
1719
|
|
-
|
|
1720
|
|
- subst_bndrs subst bs = mapAccumL subst_bndr subst bs
|
|
1721
|
1727
|
|
|
1722
|
1728
|
extend (Left in_scope) v e = Right (extendSubst (mkEmptySubst in_scope) v e)
|
|
1723
|
1729
|
extend (Right s) v e = Right (extendSubst s v e)
|