make exports/imports of depth>0 identifiers work correctly

diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index b1c97cd..ac21632 100644 (file)
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -1282,10 +1282,14 @@ instance Binary IfaceNote where
 -- to avoid re-building it in various places.  So we build the OccName
 -- when de-serialising.
 
+-- NOTE regarding HetMet extensions: this screws up Adam's heinous
+-- hide-the-syntactical-level-in-the-namespace trick.
+
 instance Binary IfaceDecl where
     put_ bh (IfaceId name ty details idinfo) = do
            putByte bh 0
            put_ bh (occNameFS name)
+           put_ bh (getOccNameDepth name)
            put_ bh ty
            put_ bh details
            put_ bh idinfo
@@ -1321,10 +1325,11 @@ instance Binary IfaceDecl where
            h <- getByte bh
            case h of
              0 -> do name    <- get bh
+                     depth   <- get bh
                      ty      <- get bh
                      details <- get bh
                      idinfo  <- get bh
-                      occ <- return $! mkOccNameFS varName name
+                      occ <- return $! mkOccNameFS (varNameDepth depth) name
                      return (IfaceId occ ty details idinfo)
              1 -> error "Binary.get(TyClDecl): ForeignType"
              2 -> do
@@ -1436,13 +1441,15 @@ instance Binary IfaceConDecl where
 instance Binary IfaceClassOp where
    put_ bh (IfaceClassOp n def ty) = do        
        put_ bh (occNameFS n)
+       put_ bh (getOccNameDepth n)
        put_ bh def     
        put_ bh ty
    get bh = do
        n <- get bh
+       depth <- get bh
        def <- get bh
        ty <- get bh
-        occ <- return $! mkOccNameFS varName n
+        occ <- return $! mkOccNameFS (varNameDepth depth) n
        return (IfaceClassOp occ def ty)
 
 instance Binary IfaceRule where

diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 8dccc72..3a274a0 100644 (file)
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -144,7 +144,7 @@ importDecl name
   where
     nd_doc = ptext (sLit "Need decl for") <+> ppr name
     not_found_msg = hang (ptext (sLit "Can't find interface-file declaration for") <+>
-                               pprNameSpace (occNameSpace (nameOccName name)) <+> ppr name)
+                               pprNameSpace (occNameSpace (nameOccName name)) <+> (ppr (nameOccName name)))
                       2 (vcat [ptext (sLit "Probable cause: bug in .hi-boot file, or inconsistent .hi file"),
                                ptext (sLit "Use -ddump-if-trace to get an idea of which file caused the error")])
 \end{code}

diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp
index 62eebef..26bb4e7 100644 (file)
--- a/compiler/parser/Parser.y.pp
+++ b/compiler/parser/Parser.y.pp
@@ -476,7 +476,7 @@ export      :: { LIE RdrName }
        |  oqtycon '(' ')'              { LL (IEThingWith (unLoc $1) []) }
        |  oqtycon '(' qcnames ')'      { LL (IEThingWith (unLoc $1) (reverse $3)) }
        |  'module' modid               { LL (IEModuleContents (unLoc $2)) }
-
+        | '<[' incdepth export decdepth ']>' { $3 }
 qcnames :: { [RdrName] }
        :  qcnames ',' qcname_ext       { unLoc $3 : $1 }
        |  qcname_ext                   { [unLoc $1]  }

diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index ed11fd8..5135c71 100644 (file)
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -677,6 +677,7 @@ checkAPat :: DynFlags -> SrcSpan -> HsExpr RdrName -> P (Pat RdrName)
 checkAPat dynflags loc e0 = case e0 of
    EWildPat -> return (WildPat placeHolderType)
    HsVar x  -> return (VarPat x)
+   HsHetMetBrak _ p -> checkAPat dynflags loc (unLoc p)
    HsLit l  -> return (LitPat l)
 
    -- Overloaded numeric patterns (e.g. f 0 x = x)