ghc/compiler/reader/RdrHsSyn.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1996-1998
   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 module RdrHsSyn (
  11         RdrNameArithSeqInfo,
  12         RdrNameBangType,
  13         RdrNameClassOpSig,
  14         RdrNameConDecl,
  15         RdrNameContext,
  16         RdrNameSpecDataSig,
  17         RdrNameDefaultDecl,
  18         RdrNameForeignDecl,
  19         RdrNameGRHS,
  20         RdrNameGRHSs,
  21         RdrNameHsBinds,
  22         RdrNameHsDecl,
  23         RdrNameHsExpr,
  24         RdrNameHsModule,
  25         RdrNameIE,
  26         RdrNameImportDecl,
  27         RdrNameInstDecl,
  28         RdrNameMatch,
  29         RdrNameMonoBinds,
  30         RdrNamePat,
  31         RdrNameHsType,
  32         RdrNameSig,
  33         RdrNameStmt,
  34         RdrNameTyClDecl,
  35
  36         RdrNameClassOpPragmas,
  37         RdrNameClassPragmas,
  38         RdrNameDataPragmas,
  39         RdrNameGenPragmas,
  40         RdrNameInstancePragmas,
  41         extractHsTyVars, extractHsCtxtTyVars, extractPatsTyVars,
  42
  43         mkOpApp, mkClassDecl
  44     ) where
  45
  46 #include "HsVersions.h"
  47
  48 import HsSyn
  49 import Name             ( mkClassTyConOcc, mkClassDataConOcc )
  50 import RdrName          ( RdrName, isRdrTyVar, mkRdrUnqual, rdrNameOcc )
  51 import Util             ( thenCmp )
  52 import HsPragmas        ( GenPragmas, ClassPragmas, DataPragmas, ClassOpPragmas, InstancePragmas )
  53 import List             ( nub )
  54 import Outputable
  55 \end{code}
  56
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection{Type synonyms}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 \begin{code}
  65 type RdrNameArithSeqInfo        = ArithSeqInfo          RdrName RdrNamePat
  66 type RdrNameBangType            = BangType              RdrName
  67 type RdrNameClassOpSig          = Sig                   RdrName
  68 type RdrNameConDecl             = ConDecl               RdrName
  69 type RdrNameContext             = Context               RdrName
  70 type RdrNameHsDecl              = HsDecl                RdrName RdrNamePat
  71 type RdrNameSpecDataSig         = SpecDataSig           RdrName
  72 type RdrNameDefaultDecl         = DefaultDecl           RdrName
  73 type RdrNameForeignDecl         = ForeignDecl           RdrName
  74 type RdrNameGRHS                = GRHS                  RdrName RdrNamePat
  75 type RdrNameGRHSs               = GRHSs                 RdrName RdrNamePat
  76 type RdrNameHsBinds             = HsBinds               RdrName RdrNamePat
  77 type RdrNameHsExpr              = HsExpr                RdrName RdrNamePat
  78 type RdrNameHsModule            = HsModule              RdrName RdrNamePat
  79 type RdrNameIE                  = IE                    RdrName
  80 type RdrNameImportDecl          = ImportDecl            RdrName
  81 type RdrNameInstDecl            = InstDecl              RdrName RdrNamePat
  82 type RdrNameMatch               = Match                 RdrName RdrNamePat
  83 type RdrNameMonoBinds           = MonoBinds             RdrName RdrNamePat
  84 type RdrNamePat                 = InPat                 RdrName
  85 type RdrNameHsType              = HsType                RdrName
  86 type RdrNameSig                 = Sig                   RdrName
  87 type RdrNameStmt                = Stmt                  RdrName RdrNamePat
  88 type RdrNameTyClDecl            = TyClDecl              RdrName RdrNamePat
  89
  90 type RdrNameClassOpPragmas      = ClassOpPragmas        RdrName
  91 type RdrNameClassPragmas        = ClassPragmas          RdrName
  92 type RdrNameDataPragmas         = DataPragmas           RdrName
  93 type RdrNameGenPragmas          = GenPragmas            RdrName
  94 type RdrNameInstancePragmas     = InstancePragmas       RdrName
  95 \end{code}
  96
  97
  98 %************************************************************************
  99 %*                                                                      *
 100 \subsection{A few functions over HsSyn at RdrName}
 101 %*                                                                      *
 102 %************************************************************************
 103
 104 @extractHsTyVars@ looks just for things that could be type variables.
 105 It's used when making the for-alls explicit.
 106
 107 \begin{code}
 108 extractHsTyVars :: HsType RdrName -> [RdrName]
 109 extractHsTyVars ty = nub (extract_ty ty [])
 110
 111 extractHsCtxtTyVars :: Context RdrName -> [RdrName]
 112 extractHsCtxtTyVars ty = nub (extract_ctxt ty [])
 113
 114 extract_ctxt ctxt acc = foldr extract_ass acc ctxt
 115                       where
 116                         extract_ass (cls, tys) acc = foldr extract_ty acc tys
 117
 118 extract_ty (MonoTyApp ty1 ty2)      acc = extract_ty ty1 (extract_ty ty2 acc)
 119 extract_ty (MonoListTy ty)          acc = extract_ty ty acc
 120 extract_ty (MonoTupleTy tys _)      acc = foldr extract_ty acc tys
 121 extract_ty (MonoFunTy ty1 ty2)      acc = extract_ty ty1 (extract_ty ty2 acc)
 122 extract_ty (MonoDictTy cls tys)     acc = foldr extract_ty acc tys
 123 extract_ty (MonoTyVar tv)           acc = insertTV tv acc
 124 extract_ty (HsForAllTy tvs ctxt ty) acc = acc ++
 125                                           (filter (`notElem` locals) $
 126                                            extract_ctxt ctxt (extract_ty ty []))
 127                                         where
 128                                           locals = map getTyVarName tvs
 129
 130 insertTV name   acc | isRdrTyVar name = name : acc
 131 insertTV other  acc                   = acc
 132
 133 extractPatsTyVars :: [RdrNamePat] -> [RdrName]
 134 extractPatsTyVars pats = nub (foldr extract_pat [] pats)
 135
 136 extract_pat (SigPatIn pat ty)      acc = extract_ty ty acc
 137 extract_pat WildPatIn              acc = acc
 138 extract_pat (VarPatIn var)         acc = acc
 139 extract_pat (LitPatIn _)           acc = acc
 140 extract_pat (LazyPatIn pat)        acc = extract_pat pat acc
 141 extract_pat (AsPatIn a pat)        acc = extract_pat pat acc
 142 extract_pat (NPlusKPatIn n _)      acc = acc
 143 extract_pat (ConPatIn c pats)      acc = foldr extract_pat acc pats
 144 extract_pat (ConOpPatIn p1 c f p2) acc = extract_pat p1 (extract_pat p2 acc)
 145 extract_pat (NegPatIn  pat)        acc = extract_pat pat acc
 146 extract_pat (ParPatIn  pat)        acc = extract_pat pat acc
 147 extract_pat (ListPatIn pats)       acc = foldr extract_pat acc pats
 148 extract_pat (TuplePatIn pats _)    acc = foldr extract_pat acc pats
 149 extract_pat (RecPatIn c fields)    acc = foldr (\ (f,pat,_) acc -> extract_pat pat acc) acc fields
 150 \end{code}
 151
 152
 153 A useful function for building @OpApps@.  The operator is always a variable,
 154 and we don't know the fixity yet.
 155
 156 \begin{code}
 157 mkOpApp e1 op e2 = OpApp e1 (HsVar op) (error "mkOpApp:fixity") e2
 158 \end{code}
 159
 160 mkClassDecl builds a RdrClassDecl, filling in the names for tycon and datacon
 161 by deriving them from the name of the class.  We fill in the names for the
 162 tycon and datacon corresponding to the class, by deriving them from the
 163 name of the class itself.  This saves recording the names in the interface
 164 file (which would be equally godd).
 165
 166 \begin{code}
 167 mkClassDecl cxt cname tyvars sigs mbinds prags loc
 168   = ClassDecl cxt cname tyvars sigs mbinds prags tname dname loc
 169   where
 170     cls_occ = rdrNameOcc cname
 171     dname   = mkRdrUnqual (mkClassDataConOcc cls_occ)
 172     tname   = mkRdrUnqual (mkClassTyConOcc   cls_occ)
 173 \end{code}
 174
 175