X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FIfaceSyn.lhs;h=c8348cb6cd7e24e8432b8ae7462b827d2e3b11ff;hb=2b8358cfe8b6399874090c099e3b96e932c6ccbb;hp=c844d627f93c6c281965a7708e6cbc3f4d231d01;hpb=7a7fe41638ef01160b8d8db981f9187528416760;p=ghc-hetmet.git

diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index c844d62..c8348cb 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -105,7 +105,7 @@ data IfaceDecl
                                                 -- beyond .NET
 		   ifExtName :: Maybe FastString }
 
-data IfaceClassOp = IfaceClassOp OccName DefMeth IfaceType
+data IfaceClassOp = IfaceClassOp OccName DefMethSpec IfaceType
 	-- Nothing    => no default method
 	-- Just False => ordinary polymorphic default method
 	-- Just True  => generic default method
@@ -133,7 +133,7 @@ data IfaceConDecl
 	ifConCtxt    :: IfaceContext,		-- Non-stupid context
 	ifConArgTys  :: [IfaceType],		-- Arg types
 	ifConFields  :: [OccName],		-- ...ditto... (field labels)
-	ifConStricts :: [StrictnessMark]}	-- Empty (meaning all lazy),
+	ifConStricts :: [HsBang]}		-- Empty (meaning all lazy),
 						-- or 1-1 corresp with arg tys
 
 data IfaceInst 
@@ -210,7 +210,8 @@ data IfaceInfoItem
 -- only later attached to the Id.  Partial reason: some are orphans.
 
 data IfaceUnfolding 
-  = IfCoreUnfold IfaceExpr
+  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
+
   | IfCompulsory IfaceExpr	-- Only used for default methods, in fact
 
   | IfInlineRule Arity 
@@ -524,10 +525,13 @@ pprIfaceConDecl tc
 	 if is_infix then ptext (sLit "Infix") else empty,
 	 if has_wrap then ptext (sLit "HasWrapper") else empty,
 	 ppUnless (null strs) $
-	    nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr strs)),
+	    nest 4 (ptext (sLit "Stricts:") <+> hsep (map ppr_bang strs)),
 	 ppUnless (null fields) $
 	    nest 4 (ptext (sLit "Fields:") <+> hsep (map ppr fields))]
   where
+    ppr_bang HsNoBang = char '_'	-- Want to see these
+    ppr_bang bang     = ppr bang
+        
     main_payload = ppr name <+> dcolon <+> 
 		   pprIfaceForAllPart (univ_tvs ++ ex_tvs) (eq_ctxt ++ ctxt) pp_tau
 
@@ -685,11 +689,13 @@ instance Outputable IfaceInfoItem where
 
 instance Outputable IfaceUnfolding where
   ppr (IfCompulsory e)     = ptext (sLit "<compulsory>") <+> parens (ppr e)
-  ppr (IfCoreUnfold e)     = parens (ppr e)
+  ppr (IfCoreUnfold s e)   = (if s then ptext (sLit "<stable>") else empty) <+> parens (ppr e)
   ppr (IfInlineRule a uok bok e) = sep [ptext (sLit "InlineRule") <+> ppr (a,uok,bok),
       		           	        pprParendIfaceExpr e]
-  ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr <+> parens (ptext (sLit "arity") <+> int a)
-  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:") <+> brackets (pprWithCommas pprParendIfaceExpr ns)
+  ppr (IfWrapper a wkr)    = ptext (sLit "Worker:") <+> ppr wkr
+                             <+> parens (ptext (sLit "arity") <+> int a)
+  ppr (IfDFunUnfold ns)    = ptext (sLit "DFun:")
+                             <+> brackets (pprWithCommas pprParendIfaceExpr ns)
 
 
 -- -----------------------------------------------------------------------------
@@ -807,7 +813,7 @@ freeNamesItem (HsUnfold _ u) = freeNamesIfUnfold u
 freeNamesItem _              = emptyNameSet
 
 freeNamesIfUnfold :: IfaceUnfolding -> NameSet
-freeNamesIfUnfold (IfCoreUnfold e)       = freeNamesIfExpr e
+freeNamesIfUnfold (IfCoreUnfold _ e)     = freeNamesIfExpr e
 freeNamesIfUnfold (IfCompulsory e)       = freeNamesIfExpr e
 freeNamesIfUnfold (IfInlineRule _ _ _ e) = freeNamesIfExpr e
 freeNamesIfUnfold (IfWrapper _ v)        = unitNameSet v