X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Freader%2FRdrHsSyn.lhs;h=053915204f13f7d30060ee5e696053339dea3859;hb=73ac6d4be0763fa34160f1e47df387f3c69a259e;hp=ab07b885e6ae40604f3ba0d29f830e2840dcc316;hpb=8de16184643ea3c2f9f30b5eaed18db6ef247760;p=ghc-hetmet.git

diff --git a/ghc/compiler/reader/RdrHsSyn.lhs b/ghc/compiler/reader/RdrHsSyn.lhs
index ab07b88..0539152 100644
--- a/ghc/compiler/reader/RdrHsSyn.lhs
+++ b/ghc/compiler/reader/RdrHsSyn.lhs
@@ -12,7 +12,6 @@ they are used somewhat later on in the compiler...)
 module RdrHsSyn (
 	SYN_IE(RdrNameArithSeqInfo),
 	SYN_IE(RdrNameBangType),
-	SYN_IE(RdrNameBind),
 	SYN_IE(RdrNameClassDecl),
 	SYN_IE(RdrNameClassOpSig),
 	SYN_IE(RdrNameConDecl),
@@ -33,7 +32,6 @@ module RdrHsSyn (
 	SYN_IE(RdrNameMonoBinds),
 	SYN_IE(RdrNamePat),
 	SYN_IE(RdrNameHsType),
-	SYN_IE(RdrNameQual),
 	SYN_IE(RdrNameSig),
 	SYN_IE(RdrNameSpecInstSig),
 	SYN_IE(RdrNameStmt),
@@ -48,11 +46,11 @@ module RdrHsSyn (
 	extractHsTyVars,
 
 	RdrName(..),
-	qual, varQual, tcQual, varUnqual,
+	qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
 	dummyRdrVarName, dummyRdrTcName,
 	isUnqual, isQual,
-	showRdr, rdrNameOcc,
-	cmpRdr,
+	showRdr, rdrNameOcc, ieOcc,
+	cmpRdr, prefixRdrName,
 	mkOpApp
 
     ) where
@@ -62,17 +60,23 @@ IMP_Ubiq()
 import HsSyn
 import Lex
 import PrelMods		( pRELUDE )
-import Name		( ExportFlag(..), Module(..), pprModule,
-			  OccName(..), pprOccName )
+import BasicTypes	( Module(..), NewOrData, IfaceFlavour(..) )
+import Name		( ExportFlag(..), pprModule,
+			  OccName(..), pprOccName, 
+			  prefixOccName, SYN_IE(NamedThing) )
 import Pretty		
-import PprStyle		( PprStyle(..) )
-import Util		( cmpPString, panic, thenCmp )
+import Outputable	( PprStyle(..) )
+import Util		--( cmpPString, panic, thenCmp )
+import Outputable
+#if __GLASGOW_HASKELL__ >= 202
+import CoreSyn   ( GenCoreExpr )
+import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
+#endif
 \end{code}
 
 \begin{code}
 type RdrNameArithSeqInfo	= ArithSeqInfo		Fake Fake RdrName RdrNamePat
 type RdrNameBangType		= BangType		RdrName
-type RdrNameBind		= Bind			Fake Fake RdrName RdrNamePat
 type RdrNameClassDecl		= ClassDecl		Fake Fake RdrName RdrNamePat
 type RdrNameClassOpSig		= Sig			RdrName
 type RdrNameConDecl		= ConDecl		RdrName
@@ -93,7 +97,6 @@ type RdrNameMatch		= Match			Fake Fake RdrName RdrNamePat
 type RdrNameMonoBinds		= MonoBinds		Fake Fake RdrName RdrNamePat
 type RdrNamePat			= InPat			RdrName
 type RdrNameHsType		= HsType		RdrName
-type RdrNameQual		= Qualifier		Fake Fake RdrName RdrNamePat
 type RdrNameSig			= Sig			RdrName
 type RdrNameSpecInstSig		= SpecInstSig 		RdrName
 type RdrNameStmt		= Stmt			Fake Fake RdrName RdrNamePat
@@ -121,13 +124,21 @@ extractHsTyVars ty
     get (MonoFunTy ty1 ty2)	 acc = get ty1 (get ty2 acc)
     get (MonoDictTy cls ty)	 acc = get ty acc
     get (MonoTyVar tv) 	         acc = insert tv acc
-    get (HsPreForAllTy ctxt ty)  acc = foldr (get . snd) (get ty acc) ctxt
-    get (HsForAllTy tvs ctxt ty) acc = filter (`notElem` locals) $
-				       foldr (get . snd) (get ty acc) ctxt
+
+	-- In (All a => a -> a) -> Int, there are no free tyvars
+	-- We just assume that we quantify over all type variables mentioned in the context.
+    get (HsPreForAllTy ctxt ty)  acc = filter (`notElem` locals) (get ty [])
+				       ++ acc
+				     where
+				       locals = foldr (get . snd) [] ctxt
+
+    get (HsForAllTy tvs ctxt ty) acc = (filter (`notElem` locals) $
+				        foldr (get . snd) (get ty []) ctxt)
+				       ++ acc
 				     where
 				       locals = map getTyVarName tvs
 
-    insert (Qual _ _)	      acc = acc
+    insert (Qual _ _ _)	      acc = acc
     insert (Unqual (TCOcc _)) acc = acc
     insert other 	      acc | other `elem` acc = acc
 				  | otherwise	     = other : acc
@@ -151,11 +162,15 @@ mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
 \begin{code}
 data RdrName
   = Unqual OccName
-  | Qual   Module OccName
+  | Qual   Module OccName IfaceFlavour	-- HiBootFile for M!.t (interface files only), 
+					-- HiFile for the common M.t
 
-qual     (m,n) = Qual m n
-tcQual   (m,n) = Qual m (TCOcc n)
-varQual  (m,n) = Qual m (VarOcc n)
+qual     (m,n) = Qual m n HiFile
+tcQual   (m,n) = Qual m (TCOcc n) HiFile
+varQual  (m,n) = Qual m (VarOcc n) HiFile
+
+lexTcQual  (m,n,hif) = Qual m (TCOcc n) hif
+lexVarQual (m,n,hif) = Qual m (VarOcc n) hif
 
 	-- This guy is used by the reader when HsSyn has a slot for
 	-- an implicit name that's going to be filled in by
@@ -167,24 +182,32 @@ dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
 
 varUnqual n = Unqual (VarOcc n)
 
-isUnqual (Unqual _) = True
-isUnqual (Qual _ _) = False
+isUnqual (Unqual _)   = True
+isUnqual (Qual _ _ _) = False
+
+isQual (Unqual _)   = False
+isQual (Qual _ _ _) = True
 
-isQual (Unqual _) = False
-isQual (Qual _ _) = True
+	-- Used for adding a prefix to a RdrName
+prefixRdrName :: FAST_STRING -> RdrName -> RdrName
+prefixRdrName prefix (Qual m n hif) = Qual m (prefixOccName prefix n) hif
+prefixRdrName prefix (Unqual n)     = Unqual (prefixOccName prefix n)
 
-cmpRdr (Unqual  n1) (Unqual  n2) = n1 `cmp` n2
-cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
-cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
-cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
+cmpRdr (Unqual  n1) (Unqual  n2)     = n1 `cmp` n2
+cmpRdr (Unqual  n1) (Qual m2 n2 _)   = LT_
+cmpRdr (Qual m1 n1 _) (Unqual  n2)   = GT_
+cmpRdr (Qual m1 n1 _) (Qual m2 n2 _) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
 				   -- always compare module-names *second*
 
 rdrNameOcc :: RdrName -> OccName
-rdrNameOcc (Unqual occ) = occ
-rdrNameOcc (Qual _ occ) = occ
+rdrNameOcc (Unqual occ)   = occ
+rdrNameOcc (Qual _ occ _) = occ
+
+ieOcc :: RdrNameIE -> OccName
+ieOcc ie = rdrNameOcc (ieName ie)
 
 instance Text RdrName where -- debugging
-    showsPrec _ rn = showString (ppShow 80 (ppr PprDebug rn))
+    showsPrec _ rn = showString (show (ppr PprDebug rn))
 
 instance Eq RdrName where
     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
@@ -200,13 +223,13 @@ instance Ord3 RdrName where
     cmp = cmpRdr
 
 instance Outputable RdrName where
-    ppr sty (Unqual n) = pprOccName sty n
-    ppr sty (Qual m n) = ppBesides [pprModule sty m, ppStr ".", pprOccName sty n]
+    ppr sty (Unqual n)   = pprQuote sty $ \ sty -> pprOccName sty n
+    ppr sty (Qual m n _) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
 
 instance NamedThing RdrName where		-- Just so that pretty-printing of expressions works
     getOccName = rdrNameOcc
     getName = panic "no getName for RdrNames"
 
-showRdr sty rdr = ppShow 100 (ppr sty rdr)
+showRdr sty rdr = render (ppr sty rdr)
 \end{code}