add -fsimpleopt-before-flatten
[ghc-hetmet.git] / compiler / deSugar / DsBinds.lhs
index 8cbcf81..815c0d1 100644 (file)
@@ -56,7 +56,6 @@ import OrdList
 import Bag
 import BasicTypes hiding ( TopLevel )
 import FastString
--- import StaticFlags  ( opt_DsMultiTyVar )
 import Util
 
 import MonadUtils
@@ -98,7 +97,7 @@ dsHsBind _ (VarBind { var_id = var, var_rhs = expr, var_inline = inline_regardle
        ; let var' | inline_regardless = var `setIdUnfolding` mkCompulsoryUnfolding core_expr'
                   | otherwise         = var
 
-       ; return (unitOL (var', core_expr')) }
+       ; return (unitOL (makeCorePair var' False 0 core_expr')) }
 
 dsHsBind auto_scc (FunBind { fun_id = L _ fun, fun_matches = matches
                    , fun_co_fn = co_fn, fun_tick = tick 
@@ -527,13 +526,14 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
   where
     is_local_id = isJust mb_poly_rhs
     poly_rhs | Just rhs <-  mb_poly_rhs
-             = rhs
-             | Just unfolding <- maybeUnfoldingTemplate (idUnfolding poly_id)
-             = unfolding
+             = rhs         -- Local Id; this is its rhs
+             | Just unfolding <- maybeUnfoldingTemplate (realIdUnfolding poly_id)
+             = unfolding    -- Imported Id; this is its unfolding
+                           -- Use realIdUnfolding so we get the unfolding 
+                           -- even when it is a loop breaker. 
+                           -- We want to specialise recursive functions!
              | otherwise = pprPanic "dsImpSpecs" (ppr poly_id)
-       -- In the Nothing case the specialisation is for an imported Id
-       -- whose unfolding gives the RHS to be specialised
-        -- The type checker has checked that it has an unfolding
+                           -- The type checker has checked that it *has* an unfolding
 
 specUnfolding :: (CoreExpr -> CoreExpr) -> Type 
               -> Unfolding -> DsM (Unfolding, OrdList (Id,CoreExpr))