X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=4976e1fc8f8d5029f79c2c70d21dbbb9e8dbe5b7;hp=c55f54f772fd3f0aedb35507e69623f50d637c7d;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=6ccd648bf016aa9cfa13612f0f19be6badea16d1

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index c55f54f..4976e1f 100644
--- 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
 
 ---------------------