X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=9282920beec5ede79ec990a1d1eefb61bdd59678;hb=a0ca27ac659bcbe0c291b3bd1a12a965f43f5f55;hp=4da21d8d9128a7c0ce9ace87ab1b3d6be797cdf4;hpb=6a944ae7fe1e8e2e456c68717188463263f8978f;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 4da21d8..9282920 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
@@ -741,7 +741,7 @@ ruleOrphWarn unqual mod rule
   = mkWarnMsg silly_loc unqual $
     ptext (sLit "Orphan rule:") <+> ppr rule
   where
-    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 0)
+    silly_loc = srcLocSpan (mkSrcLoc (moduleNameFS (moduleName mod)) 1 1)
     -- We don't have a decent SrcSpan for a Rule, not even the CoreRule
     -- Could readily be fixed by adding a SrcSpan to CoreRule, if we wanted to
 
@@ -1466,7 +1466,7 @@ 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
 
@@ -1481,23 +1481,26 @@ toIfaceIdInfo id_info
 
 --------------------------
 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 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!
+toIfUnfolding lb (CoreUnfolding { uf_tmpl = rhs, uf_arity = arity
+                                , uf_src = src, uf_guidance = guidance })
+  = case src of
+	InlineWrapper w -> Just (HsUnfold lb (IfWrapper arity (idName w)))
+	InlineRule {}   -> Just (HsUnfold lb (IfInlineRule arity sat (toIfaceExpr rhs)))
+        _other          -> Just (HsUnfold lb (IfCoreUnfold (toIfaceExpr rhs)))
+	-- Yes, even if guidance is UnfNever, 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)))
+    sat = case guidance of
+            UnfWhen unsat_ok _ -> unsat_ok
+            _other             -> needSaturated
 
 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 _ _
   = Nothing