[project @ 1997-07-25 22:47:18 by sof]

[ghc-hetmet.git] / ghc / compiler / reader / RdrHsSyn.lhs

diff --git a/ghc/compiler/reader/RdrHsSyn.lhs b/ghc/compiler/reader/RdrHsSyn.lhs
index d7bbd7f..0539152 100644 (file)
--- 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),
@@ -47,7 +46,7 @@ module RdrHsSyn (
        extractHsTyVars,
 
        RdrName(..),
-       qual, varQual, tcQual, varUnqual,
+       qual, varQual, tcQual, varUnqual, lexVarQual, lexTcQual,
        dummyRdrVarName, dummyRdrTcName,
        isUnqual, isQual,
        showRdr, rdrNameOcc, ieOcc,
@@ -61,17 +60,23 @@ IMP_Ubiq()
 import HsSyn
 import Lex
 import PrelMods                ( pRELUDE )
-import Name            ( ExportFlag(..), Module(..), pprModule,
-                         OccName(..), pprOccName, prefixOccName )
+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
@@ -119,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
@@ -149,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 HiFile
+tcQual   (m,n) = Qual m (TCOcc n) HiFile
+varQual  (m,n) = Qual m (VarOcc n) HiFile
 
-qual     (m,n) = Qual m n
-tcQual   (m,n) = Qual m (TCOcc n)
-varQual  (m,n) = Qual m (VarOcc n)
+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
@@ -165,32 +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) = Qual m (prefixOccName prefix n)
-prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
+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 }
@@ -206,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, ppChar '.', 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}