X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=7ef13a37e1c5d73216051b7f2014381c22ec06ee;hp=16c78fda0e98cbd92d5aa6caeccf7f7a4b612aa6;hb=e79c9ce01d0ce4412bd4bcd99c8c728a6a2ec569;hpb=6ccd648bf016aa9cfa13612f0f19be6badea16d1

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index 16c78fd..7ef13a3 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -9,7 +9,7 @@ module IfaceSyn (
 
 	IfaceDecl(..), IfaceClassOp(..), IfaceConDecl(..), IfaceConDecls(..),
 	IfaceExpr(..), IfaceAlt, IfaceNote(..), IfaceLetBndr(..),
-	IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..), IfaceUnfolding(..),
+	IfaceBinding(..), IfaceConAlt(..), IfaceIdInfo(..),
 	IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
 	IfaceInst(..), IfaceFamInst(..),
 
@@ -192,18 +192,15 @@ data IfaceInfoItem
   = HsArity	 Arity
   | HsStrictness StrictSig
   | HsInline     Activation
-  | HsUnfold	 IfaceUnfolding
+  | HsUnfold	 IfaceExpr
   | HsNoCafRefs
-
+  | HsWorker	 Name Arity	-- Worker, if any see IdInfo.WorkerInfo
+					-- for why we want arity here.
+	-- NB: we need IfaceExtName (not just OccName) because the worker
+	--     can simplify to a function in another module.
 -- NB: Specialisations and rules come in separately and are
 -- only later attached to the Id.  Partial reason: some are orphans.
 
-data IfaceUnfolding 
-  = IfCoreUnfold IfaceExpr
-  | IfInlineRule Arity IfaceExpr
-  | IfWrapper    Arity Name	  -- NB: we need a Name (not just OccName) because the worker
-				  --     can simplify to a function in another module.
-
 --------------------------------
 data IfaceExpr
   = IfaceLcl 	FastString
@@ -221,6 +218,7 @@ data IfaceExpr
   | IfaceTick   Module Int
 
 data IfaceNote = IfaceSCC CostCentre
+	       | IfaceInlineMe
                | IfaceCoreNote String
 
 type IfaceAlt = (IfaceConAlt, [FastString], IfaceExpr)
@@ -631,6 +629,7 @@ pprIfaceApp fun	 	       args = sep (pprIfaceExpr parens fun : args)
 ------------------
 instance Outputable IfaceNote where
     ppr (IfaceSCC cc)     = pprCostCentreCore cc
+    ppr IfaceInlineMe     = ptext (sLit "__inline_me")
     ppr (IfaceCoreNote s) = ptext (sLit "__core_note") <+> pprHsString (mkFastString s)
 
 
@@ -647,16 +646,13 @@ instance Outputable IfaceIdInfo where
   ppr (HasInfo is) = ptext (sLit "{-") <+> fsep (map ppr is) <+> ptext (sLit "-}")
 
 instance Outputable IfaceInfoItem where
-  ppr (HsUnfold unf)  	 = ptext (sLit "Unfolding:") <+> ppr unf
+  ppr (HsUnfold unf)  	 = ptext (sLit "Unfolding:") <+>
+				  	parens (pprIfaceExpr noParens unf)
   ppr (HsInline act)     = ptext (sLit "Inline:") <+> ppr act
   ppr (HsArity arity)    = ptext (sLit "Arity:") <+> int arity
   ppr (HsStrictness str) = ptext (sLit "Strictness:") <+> pprIfaceStrictSig str
   ppr HsNoCafRefs	 = ptext (sLit "HasNoCafRefs")
-
-instance Outputable IfaceUnfolding where
-  ppr (IfCoreUnfold e)   = parens (ppr e)
-  ppr (IfInlineRule a e) = ptext (sLit "INLINE:") <+> parens (ptext (sLit "arity") <+> int a) <+> parens (ppr e)
-  ppr (IfWrapper a wkr)  = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (HsWorker w a)	 = ptext (sLit "Worker:") <+> ppr w <+> int a
 
 
 -- -----------------------------------------------------------------------------
@@ -760,14 +756,10 @@ freeNamesIfIdInfo NoInfo = emptyNameSet
 freeNamesIfIdInfo (HasInfo i) = fnList freeNamesItem i
 
 freeNamesItem :: IfaceInfoItem -> NameSet
-freeNamesItem (HsUnfold u)     = freeNamesIfUnfold u
+freeNamesItem (HsUnfold u)     = freeNamesIfExpr u
+freeNamesItem (HsWorker wkr _) = unitNameSet wkr
 freeNamesItem _                = emptyNameSet
 
-freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold e)   = freeNamesIfExpr e
-freeNamesIfUnfold (IfInlineRule _ e) = freeNamesIfExpr e
-freeNamesIfUnfold (IfWrapper _ v)    = unitNameSet v
-
 freeNamesIfExpr :: IfaceExpr -> NameSet
 freeNamesIfExpr (IfaceExt v)	  = unitNameSet v
 freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty