X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=f271aa5f7b93abd83dfa5aeeef56b0e4f1af0257;hb=16c7844d29b7b90e6cf432ec646f70d466ca9cc9;hp=2c106b0a1abb857c9e88393dd92a3059af5fd585;hpb=a263737bbf44050a7b5ecbe267ddf85d410b73e5;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 2c106b0..f271aa5 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -54,7 +54,7 @@ import IfaceSyn
 import LoadIface
 import Id
 import IdInfo
-import NewDemand
+import Demand
 import Annotations
 import CoreSyn
 import CoreFVs
@@ -399,7 +399,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls
 	       , let out = localOccs $ freeNamesDeclABI abi
                ]
 
-       name_module n = ASSERT( isExternalName n ) nameModule n
+       name_module n = ASSERT2( isExternalName n, ppr n ) nameModule n
        localOccs = map (getUnique . getParent . getOccName) 
                         . filter ((== this_mod) . name_module)
                         . nameSetToList
@@ -1466,12 +1466,13 @@ toIfaceIdInfo id_info
 
     ------------  Strictness  --------------
 	-- No point in explicitly exporting TopSig
-    strict_hsinfo = case newStrictnessInfo id_info of
+    strict_hsinfo = case strictnessInfo id_info of
 			Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
 			_other			      -> Nothing
 
     ------------  Unfolding  --------------
-    unfold_hsinfo = toIfUnfolding (unfoldingInfo id_info)
+    unfold_hsinfo = toIfUnfolding loop_breaker (unfoldingInfo id_info) 
+    loop_breaker  = isNonRuleLoopBreaker (occInfo id_info)
 					
     ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
@@ -1479,20 +1480,25 @@ toIfaceIdInfo id_info
                   | otherwise = Just (HsInline inline_prag)
 
 --------------------------
-toIfUnfolding :: Unfolding -> Maybe IfaceInfoItem
-toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
+toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity, uf_guidance = guidance })
   = case guidance of
-	InlineRule { ir_info = InlWrapper w } -> Just (HsUnfold (IfWrapper arity (idName w)))
-	InlineRule { ir_sat = InlSat }        -> Just (HsUnfold (IfInlineRule arity True  (toIfaceExpr rhs)))
-	InlineRule { ir_sat = InlUnSat }      -> Just (HsUnfold (IfInlineRule arity False (toIfaceExpr rhs)))
-	UnfoldNever         -> Nothing
-	UnfoldIfGoodArgs {} -> Just (HsUnfold (IfCoreUnfold (toIfaceExpr rhs)))
-
-toIfUnfolding (DFunUnfolding _con ops)
-  = Just (HsUnfold (IfDFunUnfold (map toIfaceExpr ops)))
+	InlineRule { ir_info = InlWrapper w } -> Just (HsUnfold lb (IfWrapper arity (idName w)))
+	InlineRule { ir_sat = InlSat }        -> Just (HsUnfold lb (IfInlineRule arity True  (toIfaceExpr rhs)))
+	InlineRule { ir_sat = InlUnSat }      -> Just (HsUnfold lb (IfInlineRule arity False (toIfaceExpr rhs)))
+	UnfoldIfGoodArgs {} -> vanilla_unfold
+	UnfoldNever         -> vanilla_unfold	-- Yes, even if guidance is UnfoldNever, expose the unfolding
+			       			-- If we didn't want to expose the unfolding, TidyPgm would
+			       			-- have stuck in NoUnfolding.  For supercompilation we want 
+						-- to see that unfolding!
+  where
+    vanilla_unfold = Just (HsUnfold lb (IfCoreUnfold (toIfaceExpr rhs)))
+
+toIfUnfolding lb (DFunUnfolding _con ops)
+  = Just (HsUnfold lb (IfDFunUnfold (map toIfaceExpr ops)))
       -- No need to serialise the data constructor; 
       -- we can recover it from the type of the dfun
-toIfUnfolding _
+toIfUnfolding _ _
   = Nothing
 
 --------------------------