From 2c1c4d3540e5671274d45a473f1d1da5d37f76c1 Mon Sep 17 00:00:00 2001 From: Adam Megacz Date: Tue, 8 Mar 2011 16:06:50 -0800 Subject: [PATCH] make exports/imports of depth>0 identifiers work correctly --- compiler/iface/BinIface.hs | 11 +++++++++-- compiler/iface/TcIface.lhs | 2 +- compiler/parser/Parser.y.pp | 2 +- compiler/parser/RdrHsSyn.lhs | 1 + 4 files changed, 12 insertions(+), 4 deletions(-) diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index b1c97cd..ac21632 100644 --- 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 --- 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 --- 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 --- 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) -- 1.7.10.4