X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fiface%2FMkIface.lhs;h=019602a6591de9261b85791ad99c10028f253db1;hb=527f52a72acf214994921ad36de92f934e9632da;hp=4976e1fc8f8d5029f79c2c70d21dbbb9e8dbe5b7;hpb=25ed0cf7d4c2fbf9e455405f0a8525e0ae27b4e7;p=ghc-hetmet.git

diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 4976e1f..019602a 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -631,7 +631,8 @@ freeNamesDeclABI (_mod, decl, extras) =
 data IfaceDeclExtras 
   = IfaceIdExtras    Fixity [IfaceRule]
   | IfaceDataExtras  Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
-  | IfaceClassExtras [IfaceInstABI] [(Fixity,[IfaceRule])]
+  | IfaceClassExtras Fixity [IfaceInstABI] [(Fixity,[IfaceRule])]
+  | IfaceSynExtras   Fixity
   | IfaceOtherDeclExtras
 
 freeNamesDeclExtras :: IfaceDeclExtras -> NameSet
@@ -639,8 +640,10 @@ freeNamesDeclExtras (IfaceIdExtras    _ rules)
   = unionManyNameSets (map freeNamesIfRule rules)
 freeNamesDeclExtras (IfaceDataExtras  _ _insts subs)
   = unionManyNameSets (map freeNamesSub subs)
-freeNamesDeclExtras (IfaceClassExtras _insts subs)
+freeNamesDeclExtras (IfaceClassExtras _ _insts subs)
   = unionManyNameSets (map freeNamesSub subs)
+freeNamesDeclExtras (IfaceSynExtras _)
+  = emptyNameSet
 freeNamesDeclExtras IfaceOtherDeclExtras
   = emptyNameSet
 
@@ -653,10 +656,12 @@ instance Binary IfaceDeclExtras where
    putByte bh 1; put_ bh fix; put_ bh rules
   put_ bh (IfaceDataExtras fix insts cons) = do
    putByte bh 2; put_ bh fix; put_ bh insts; put_ bh cons
-  put_ bh (IfaceClassExtras insts methods) = do
-   putByte bh 3; put_ bh insts; put_ bh methods
+  put_ bh (IfaceClassExtras fix insts methods) = do
+   putByte bh 3; put_ bh fix; put_ bh insts; put_ bh methods
+  put_ bh (IfaceSynExtras fix) = do
+   putByte bh 4; put_ bh fix
   put_ bh IfaceOtherDeclExtras = do
-   putByte bh 4
+   putByte bh 5
 
 declExtras :: (OccName -> Fixity)
            -> OccEnv [IfaceRule]
@@ -673,9 +678,10 @@ declExtras fix_fn rule_env inst_env decl
                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
                         (map (id_extras . ifConOcc) (visibleIfConDecls cons))
       IfaceClass{ifSigs=sigs} -> 
-                     IfaceClassExtras 
+                     IfaceClassExtras (fix_fn n)
                         (map IfaceInstABI $ lookupOccEnvL inst_env n)
                         [id_extras op | IfaceClassOp op _ _ <- sigs]
+      IfaceSyn{} -> IfaceSynExtras (fix_fn n)
       _other -> IfaceOtherDeclExtras
   where
         n = ifName decl
@@ -1271,9 +1277,10 @@ tyThingToIfaceDecl :: TyThing -> IfaceDecl
 -- Reason: Iface stuff uses OccNames, and the conversion here does
 --	   not do tidying on the way
 tyThingToIfaceDecl (AnId id)
-  = IfaceId { ifName   = getOccName id,
-	      ifType   = toIfaceType (idType id),
-	      ifIdInfo = info }
+  = IfaceId { ifName      = getOccName id,
+	      ifType      = toIfaceType (idType id),
+	      ifIdDetails = toIfaceIdDetails (idDetails id),
+	      ifIdInfo    = info }
   where
     info = case toIfaceIdInfo (idInfo id) of
 		[]    -> NoInfo
@@ -1351,6 +1358,7 @@ tyThingToIfaceDecl (ATyCon tycon)
     ifaceConDecl data_con 
 	= IfCon   { ifConOcc   	 = getOccName (dataConName data_con),
 		    ifConInfix 	 = dataConIsInfix data_con,
+		    ifConWrapper = isJust (dataConWrapId_maybe data_con),
 		    ifConUnivTvs = toIfaceTvBndrs (dataConUnivTyVars data_con),
 		    ifConExTvs   = toIfaceTvBndrs (dataConExTyVars data_con),
 		    ifConEqSpec  = to_eq_spec (dataConEqSpec data_con),
@@ -1438,10 +1446,17 @@ toIfaceLetBndr id  = IfLetBndr (occNameFS (getOccName id))
 	-- See Note [IdInfo on nested let-bindings] in IfaceSyn
     id_info = idInfo id
     inline_prag = inlinePragInfo id_info
-    prag_info | isAlwaysActive inline_prag = NoInfo
-	      | otherwise		   = HasInfo [HsInline inline_prag]
+    prag_info | isDefaultInlinePragma inline_prag = NoInfo
+	      | otherwise		          = HasInfo [HsInline inline_prag]
 
 --------------------------
+toIfaceIdDetails :: IdDetails -> IfaceIdDetails
+toIfaceIdDetails VanillaId 		        = IfVanillaId
+toIfaceIdDetails DFunId    		        = IfVanillaId	            
+toIfaceIdDetails (RecSelId { sel_naughty = n }) = IfRecSelId n
+toIfaceIdDetails other	     		        = pprTrace "toIfaceIdDetails" (ppr other) 
+                                                  IfVanillaId   -- Unexpected
+
 toIfaceIdInfo :: IdInfo -> [IfaceInfoItem]
 toIfaceIdInfo id_info
   = catMaybes [arity_hsinfo, caf_hsinfo, strict_hsinfo, 
@@ -1486,11 +1501,13 @@ toIfaceIdInfo id_info
 					
     ------------  Inline prag  --------------
     inline_prag = inlinePragInfo id_info
-    inline_hsinfo | isAlwaysActive inline_prag     = Nothing
-		  | no_unfolding && not has_worker = Nothing
+    inline_hsinfo | isDefaultInlinePragma inline_prag = Nothing
+		  | no_unfolding && not has_worker 
+                      && isFunLike (inlinePragmaRuleMatchInfo inline_prag)
+                                                      = Nothing
 			-- If the iface file give no unfolding info, we 
 			-- don't need to say when inlining is OK!
-		  | otherwise			   = Just (HsInline inline_prag)
+		  | otherwise			      = Just (HsInline inline_prag)
 
 --------------------------
 coreRuleToIfaceRule :: Module -> CoreRule -> IfaceRule