Rollback INLINE patches

[ghc-hetmet.git] / compiler / iface / MkIface.lhs

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index c55f54f..4976e1f 100644 (file)
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -1397,7 +1397,7 @@ instanceToIfaceInst (Instance { is_dfun = dfun_id, is_flag = oflag,
     (tvs, fds) = classTvsFds cls
     arg_names = [filterNameSet is_local (tyClsNamesOfType ty) | ty <- tys]
     orph | is_local cls_name = Just (nameOccName cls_name)
-        | all isJust mb_ns  = ASSERT( not (null mb_ns) ) head mb_ns
+        | all isJust mb_ns  = head mb_ns
         | otherwise         = Nothing
     
     mb_ns :: [Maybe OccName]   -- One for each fundep; a locally-defined name
@@ -1445,7 +1445,7 @@ toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
-              inline_hsinfo,  unfold_hsinfo] 
+              inline_hsinfo, wrkr_hsinfo,  unfold_hsinfo] 
   where
     ------------  Arity  --------------
     arity_info = arityInfo id_info
@@ -1464,29 +1464,33 @@ toIfaceIdInfo id_info
                        Just sig | not (isTopSig sig) -> Just (HsStrictness sig)
                        _other                        -> Nothing
 
+    ------------  Worker  --------------
+    work_info   = workerInfo id_info
+    has_worker  = workerExists work_info
+    wrkr_hsinfo = case work_info of
+                   HasWorker work_id wrap_arity -> 
+                       Just (HsWorker ((idName work_id)) wrap_arity)
+                   NoWorker -> Nothing
+
     ------------  Unfolding  --------------
-    unfold_hsinfo = fmap HsUnfold $ toIfUnfolding (unfoldingInfo id_info)
+    -- The unfolding is redundant if there is a worker
+    unfold_info  = unfoldingInfo id_info
+    rhs                 = unfoldingTemplate unfold_info
+    no_unfolding = neverUnfold unfold_info
+                       -- The CoreTidy phase retains unfolding info iff
+                       -- we want to expose the unfolding, taking into account
+                       -- unconditional NOINLINE, etc.  See TidyPgm.addExternal
+    unfold_hsinfo | no_unfolding = Nothing                     
+                 | has_worker   = Nothing      -- Unfolding is implicit
+                 | otherwise    = Just (HsUnfold (toIfaceExpr rhs))
                                        
     ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
-    inline_hsinfo | isAlwaysActive inline_prag = Nothing
-                 | isNothing unfold_hsinfo    = Nothing
+    inline_hsinfo | isAlwaysActive inline_prag     = Nothing
+                 | no_unfolding && not has_worker = Nothing
                        -- If the iface file give no unfolding info, we 
                        -- don't need to say when inlining is OK!
-                 | otherwise                  = Just (HsInline inline_prag)
-
---------------------------
-toIfUnfolding :: Unfolding -> Maybe IfaceUnfolding
-toIfUnfolding (CoreUnfolding { uf_tmpl = rhs, uf_guidance = guidance })
-  = case guidance of
-       UnfoldNever -> Nothing
-       _           -> Just (IfCoreUnfold (toIfaceExpr rhs))
-toIfUnfolding (InlineRule { uf_worker = Just wkr, uf_arity = arity })
-  = Just (IfWrapper arity (idName wkr))
-toIfUnfolding (InlineRule { uf_worker = Nothing, uf_tmpl = rhs, uf_arity = arity })
-  = Just (IfInlineRule arity (toIfaceExpr rhs))
-toIfUnfolding _
-  = Nothing
+                 | otherwise                      = Just (HsInline inline_prag)
 
 --------------------------
 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule
@@ -1543,6 +1547,7 @@ toIfaceExpr (Note n e)    = IfaceNote (toIfaceNote n) (toIfaceExpr e)
 ---------------------
 toIfaceNote :: Note -> IfaceNote
 toIfaceNote (SCC cc)      = IfaceSCC cc
+toIfaceNote InlineMe      = IfaceInlineMe
 toIfaceNote (CoreNote s)  = IfaceCoreNote s
 
 ---------------------