ghc/compiler/reader/RdrHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996
   3 %
   4 \section[RdrHsSyn]{Specialisations of the @HsSyn@ syntax for the reader}
   5
   6 (Well, really, for specialisations involving @RdrName@s, even if
   7 they are used somewhat later on in the compiler...)
   8
   9 \begin{code}
  10 #include "HsVersions.h"
  11
  12 module RdrHsSyn (
  13         SYN_IE(RdrNameArithSeqInfo),
  14         SYN_IE(RdrNameBangType),
  15         SYN_IE(RdrNameClassDecl),
  16         SYN_IE(RdrNameClassOpSig),
  17         SYN_IE(RdrNameConDecl),
  18         SYN_IE(RdrNameContext),
  19         SYN_IE(RdrNameSpecDataSig),
  20         SYN_IE(RdrNameDefaultDecl),
  21         SYN_IE(RdrNameFixityDecl),
  22         SYN_IE(RdrNameGRHS),
  23         SYN_IE(RdrNameGRHSsAndBinds),
  24         SYN_IE(RdrNameHsBinds),
  25         SYN_IE(RdrNameHsDecl),
  26         SYN_IE(RdrNameHsExpr),
  27         SYN_IE(RdrNameHsModule),
  28         SYN_IE(RdrNameIE),
  29         SYN_IE(RdrNameImportDecl),
  30         SYN_IE(RdrNameInstDecl),
  31         SYN_IE(RdrNameMatch),
  32         SYN_IE(RdrNameMonoBinds),
  33         SYN_IE(RdrNamePat),
  34         SYN_IE(RdrNameHsType),
  35         SYN_IE(RdrNameSig),
  36         SYN_IE(RdrNameSpecInstSig),
  37         SYN_IE(RdrNameStmt),
  38         SYN_IE(RdrNameTyDecl),
  39
  40         SYN_IE(RdrNameClassOpPragmas),
  41         SYN_IE(RdrNameClassPragmas),
  42         SYN_IE(RdrNameDataPragmas),
  43         SYN_IE(RdrNameGenPragmas),
  44         SYN_IE(RdrNameInstancePragmas),
  45         SYN_IE(RdrNameCoreExpr),
  46         extractHsTyVars,
  47
  48         RdrName(..),
  49         qual, varQual, tcQual, varUnqual,
  50         dummyRdrVarName, dummyRdrTcName,
  51         isUnqual, isQual,
  52         showRdr, rdrNameOcc, ieOcc,
  53         cmpRdr, prefixRdrName,
  54         mkOpApp
  55
  56     ) where
  57
  58 IMP_Ubiq()
  59
  60 import HsSyn
  61 import Lex
  62 import PrelMods         ( pRELUDE )
  63 import BasicTypes       ( Module(..), NewOrData )
  64 import Name             ( ExportFlag(..), pprModule,
  65                           OccName(..), pprOccName,
  66                           prefixOccName, SYN_IE(NamedThing) )
  67 import Pretty
  68 import Outputable       ( PprStyle(..) )
  69 import Util             --( cmpPString, panic, thenCmp )
  70 import Outputable
  71 #if __GLASGOW_HASKELL__ >= 202
  72 import CoreSyn   ( GenCoreExpr )
  73 import HsPragmas ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
  74 #endif
  75 \end{code}
  76
  77 \begin{code}
  78 type RdrNameArithSeqInfo        = ArithSeqInfo          Fake Fake RdrName RdrNamePat
  79 type RdrNameBangType            = BangType              RdrName
  80 type RdrNameClassDecl           = ClassDecl             Fake Fake RdrName RdrNamePat
  81 type RdrNameClassOpSig          = Sig                   RdrName
  82 type RdrNameConDecl             = ConDecl               RdrName
  83 type RdrNameContext             = Context               RdrName
  84 type RdrNameHsDecl              = HsDecl                Fake Fake RdrName RdrNamePat
  85 type RdrNameSpecDataSig         = SpecDataSig           RdrName
  86 type RdrNameDefaultDecl         = DefaultDecl           RdrName
  87 type RdrNameFixityDecl          = FixityDecl            RdrName
  88 type RdrNameGRHS                = GRHS                  Fake Fake RdrName RdrNamePat
  89 type RdrNameGRHSsAndBinds       = GRHSsAndBinds         Fake Fake RdrName RdrNamePat
  90 type RdrNameHsBinds             = HsBinds               Fake Fake RdrName RdrNamePat
  91 type RdrNameHsExpr              = HsExpr                Fake Fake RdrName RdrNamePat
  92 type RdrNameHsModule            = HsModule              Fake Fake RdrName RdrNamePat
  93 type RdrNameIE                  = IE                    RdrName
  94 type RdrNameImportDecl          = ImportDecl            RdrName
  95 type RdrNameInstDecl            = InstDecl              Fake Fake RdrName RdrNamePat
  96 type RdrNameMatch               = Match                 Fake Fake RdrName RdrNamePat
  97 type RdrNameMonoBinds           = MonoBinds             Fake Fake RdrName RdrNamePat
  98 type RdrNamePat                 = InPat                 RdrName
  99 type RdrNameHsType              = HsType                RdrName
 100 type RdrNameSig                 = Sig                   RdrName
 101 type RdrNameSpecInstSig         = SpecInstSig           RdrName
 102 type RdrNameStmt                = Stmt                  Fake Fake RdrName RdrNamePat
 103 type RdrNameTyDecl              = TyDecl                RdrName
 104
 105 type RdrNameClassOpPragmas      = ClassOpPragmas        RdrName
 106 type RdrNameClassPragmas        = ClassPragmas          RdrName
 107 type RdrNameDataPragmas         = DataPragmas           RdrName
 108 type RdrNameGenPragmas          = GenPragmas            RdrName
 109 type RdrNameInstancePragmas     = InstancePragmas       RdrName
 110 type RdrNameCoreExpr            = GenCoreExpr           RdrName RdrName RdrName RdrName
 111 \end{code}
 112
 113 @extractHsTyVars@ looks just for things that could be type variables.
 114 It's used when making the for-alls explicit.
 115
 116 \begin{code}
 117 extractHsTyVars :: HsType RdrName -> [RdrName]
 118 extractHsTyVars ty
 119   = get ty []
 120   where
 121     get (MonoTyApp ty1 ty2)      acc = get ty1 (get ty2 acc)
 122     get (MonoListTy tc ty)       acc = get ty acc
 123     get (MonoTupleTy tc tys)     acc = foldr get acc tys
 124     get (MonoFunTy ty1 ty2)      acc = get ty1 (get ty2 acc)
 125     get (MonoDictTy cls ty)      acc = get ty acc
 126     get (MonoTyVar tv)           acc = insert tv acc
 127
 128         -- In (All a => a -> a) -> Int, there are no free tyvars
 129         -- We just assume that we quantify over all type variables mentioned in the context.
 130     get (HsPreForAllTy ctxt ty)  acc = filter (`notElem` locals) (get ty [])
 131                                        ++ acc
 132                                      where
 133                                        locals = foldr (get . snd) [] ctxt
 134
 135     get (HsForAllTy tvs ctxt ty) acc = (filter (`notElem` locals) $
 136                                         foldr (get . snd) (get ty []) ctxt)
 137                                        ++ acc
 138                                      where
 139                                        locals = map getTyVarName tvs
 140
 141     insert (Qual _ _)         acc = acc
 142     insert (Unqual (TCOcc _)) acc = acc
 143     insert other              acc | other `elem` acc = acc
 144                                   | otherwise        = other : acc
 145 \end{code}
 146
 147
 148 A useful function for building @OpApps@.  The operator is always a variable,
 149 and we don't know the fixity yet.
 150
 151 \begin{code}
 152 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
 153 \end{code}
 154
 155
 156 %************************************************************************
 157 %*                                                                      *
 158 \subsection[RdrName]{The @RdrName@ datatype; names read from files}
 159 %*                                                                      *
 160 %************************************************************************
 161
 162 \begin{code}
 163 data RdrName
 164   = Unqual OccName
 165   | Qual   Module OccName
 166
 167 qual     (m,n) = Qual m n
 168 tcQual   (m,n) = Qual m (TCOcc n)
 169 varQual  (m,n) = Qual m (VarOcc n)
 170
 171         -- This guy is used by the reader when HsSyn has a slot for
 172         -- an implicit name that's going to be filled in by
 173         -- the renamer.  We can't just put "error..." because
 174         -- we sometimes want to print out stuff after reading but
 175         -- before renaming
 176 dummyRdrVarName = Unqual (VarOcc SLIT("V-DUMMY"))
 177 dummyRdrTcName = Unqual (VarOcc SLIT("TC-DUMMY"))
 178
 179 varUnqual n = Unqual (VarOcc n)
 180
 181 isUnqual (Unqual _) = True
 182 isUnqual (Qual _ _) = False
 183
 184 isQual (Unqual _) = False
 185 isQual (Qual _ _) = True
 186
 187         -- Used for adding a prefix to a RdrName
 188 prefixRdrName :: FAST_STRING -> RdrName -> RdrName
 189 prefixRdrName prefix (Qual m n) = Qual m (prefixOccName prefix n)
 190 prefixRdrName prefix (Unqual n) = Unqual (prefixOccName prefix n)
 191
 192 cmpRdr (Unqual  n1) (Unqual  n2) = n1 `cmp` n2
 193 cmpRdr (Unqual  n1) (Qual m2 n2) = LT_
 194 cmpRdr (Qual m1 n1) (Unqual  n2) = GT_
 195 cmpRdr (Qual m1 n1) (Qual m2 n2) = (n1 `cmp` n2) `thenCmp` (_CMP_STRING_ m1 m2)
 196                                    -- always compare module-names *second*
 197
 198 rdrNameOcc :: RdrName -> OccName
 199 rdrNameOcc (Unqual occ) = occ
 200 rdrNameOcc (Qual _ occ) = occ
 201
 202 ieOcc :: RdrNameIE -> OccName
 203 ieOcc ie = rdrNameOcc (ieName ie)
 204
 205 instance Text RdrName where -- debugging
 206     showsPrec _ rn = showString (show (ppr PprDebug rn))
 207
 208 instance Eq RdrName where
 209     a == b = case (a `cmp` b) of { EQ_ -> True;  _ -> False }
 210     a /= b = case (a `cmp` b) of { EQ_ -> False; _ -> True }
 211
 212 instance Ord RdrName where
 213     a <= b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> True;  GT__ -> False }
 214     a <  b = case (a `cmp` b) of { LT_ -> True;  EQ_ -> False; GT__ -> False }
 215     a >= b = case (a `cmp` b) of { LT_ -> False; EQ_ -> True;  GT__ -> True  }
 216     a >  b = case (a `cmp` b) of { LT_ -> False; EQ_ -> False; GT__ -> True  }
 217
 218 instance Ord3 RdrName where
 219     cmp = cmpRdr
 220
 221 instance Outputable RdrName where
 222     ppr sty (Unqual n) = pprQuote sty $ \ sty -> pprOccName sty n
 223     ppr sty (Qual m n) = pprQuote sty $ \ sty -> hcat [pprModule sty m, char '.', pprOccName sty n]
 224
 225 instance NamedThing RdrName where               -- Just so that pretty-printing of expressions works
 226     getOccName = rdrNameOcc
 227     getName = panic "no getName for RdrNames"
 228
 229 showRdr sty rdr = render (ppr sty rdr)
 230 \end{code}
 231