Imported ids without signatures are still inferred.
[ghc.git] / compiler / iface / IfaceSyn.hs
index c5aa1a5..27b3b43 100644 (file)
@@ -20,7 +20,7 @@ module IfaceSyn (
 
         -- Misc
         ifaceDeclImplicitBndrs, visibleIfConDecls,
-        ifaceDeclFingerprints,
+        ifaceDeclFingerprints, ifaceIdDetailsHasSig,
 
         -- Free Names
         freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
@@ -39,6 +39,7 @@ import Demand
 import Class
 import NameSet
 import CoAxiom ( BranchIndex, Role )
+import Id      ( HasSigFlag(..) )
 import Name
 import CostCentre
 import Literal
@@ -298,10 +299,14 @@ data IfaceUnfolding
 -- interface files
 
 data IfaceIdDetails
-  = IfVanillaId
+  = IfVanillaId HasSigFlag
   | IfRecSelId IfaceTyCon Bool
   | IfDFunId
 
+ifaceIdDetailsHasSig :: IfaceIdDetails -> HasSigFlag
+ifaceIdDetailsHasSig (IfVanillaId has_sig) = has_sig
+ifaceIdDetailsHasSig _                     = HasSigId
+
 {-
 Note [Versioning of instances]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -448,7 +453,7 @@ data IfaceBinding
 -- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
 -- It's used for *non-top-level* let/rec binders
 -- See Note [IdInfo on nested let-bindings]
-data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo
+data IfaceLetBndr = IfLetBndr IfLclName IfaceType HasSigFlag IfaceIdInfo
 
 {-
 Note [Empty case alternatives]
@@ -966,8 +971,8 @@ ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
 ppr_con_bs con bs = ppr con <+> hsep (map ppr bs)
 
 ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
-ppr_bind (IfLetBndr b ty info, rhs)
-  = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr info),
+ppr_bind (IfLetBndr b ty has_sig info, rhs)
+  = sep [hang (ppr b <+> dcolon <+> ppr ty) 2 (ppr has_sig $$ ppr info),
          equals <+> pprIfaceExpr noParens rhs]
 
 ------------------
@@ -993,7 +998,8 @@ instance Outputable IfaceConAlt where
 
 ------------------
 instance Outputable IfaceIdDetails where
-  ppr IfVanillaId       = Outputable.empty
+  ppr (IfVanillaId HasSigId) = Outputable.empty
+  ppr (IfVanillaId NoSigId)  = text "inferred"
   ppr (IfRecSelId tc b) = ptext (sLit "RecSel") <+> ppr tc
                           <+> if b
                                 then ptext (sLit "<naughty>")
@@ -1187,7 +1193,7 @@ freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
 -- Remember IfaceLetBndr is used only for *nested* bindings
 -- The IdInfo can contain an unfolding (in the case of
 -- local INLINE pragmas), so look there too
-freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
+freeNamesIfLetBndr (IfLetBndr _name ty info) = freeNamesIfType ty
                                              &&& freeNamesIfIdInfo info
 
 freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
@@ -1195,7 +1201,7 @@ freeNamesIfTvBndr (_fs,k) = freeNamesIfKind k
     -- kinds can have Names inside, because of promotion
 
 freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
-freeNamesIfIdBndr = freeNamesIfTvBndr
+freeNamesIfIdBndr (_fs,t,_has_sig) = freeNamesIfType t
 
 freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
 freeNamesIfIdInfo NoInfo      = emptyNameSet
@@ -1601,15 +1607,15 @@ instance Binary IfaceAnnotation where
         return (IfaceAnnotation a1 a2)
 
 instance Binary IfaceIdDetails where
-    put_ bh IfVanillaId      = putByte bh 0
+    put_ bh (IfVanillaId has_sig) = putByte bh 0 >> put_ bh has_sig
     put_ bh (IfRecSelId a b) = putByte bh 1 >> put_ bh a >> put_ bh b
     put_ bh IfDFunId         = putByte bh 2
     get bh = do
         h <- getByte bh
         case h of
-            0 -> return IfVanillaId
+            0 -> do { a <- get bh; return (IfVanillaId a) }
             1 -> do { a <- get bh; b <- get bh; return (IfRecSelId a b) }
-            _ -> return IfDFunId 
+            _ -> return IfDFunId
 
 instance Binary IfaceIdInfo where
     put_ bh NoInfo      = putByte bh 0
@@ -1833,14 +1839,16 @@ instance Binary IfaceBinding where
             _ -> do { ac <- get bh; return (IfaceRec ac) }
 
 instance Binary IfaceLetBndr where
-    put_ bh (IfLetBndr a b c) = do
+    put_ bh (IfLetBndr a b c d) = do
             put_ bh a
             put_ bh b
             put_ bh c
+            put_ bh d
     get bh = do a <- get bh
                 b <- get bh
                 c <- get bh
-                return (IfLetBndr a b c)
+                d <- get bh
+                return (IfLetBndr a b c d)
 
 instance Binary IfaceTyConParent where
     put_ bh IfNoParent = putByte bh 0