ghc/compiler/hsSyn/HsSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Haskell abstract syntax definition}
   5
   6 This module glues together the pieces of the Haskell abstract syntax,
   7 which is declared in the various \tr{Hs*} modules.  This module,
   8 therefore, is almost nothing but re-exporting.
   9
  10 \begin{code}
  11 module HsSyn (
  12         module HsBinds,
  13         module HsDecls,
  14         module HsExpr,
  15         module HsImpExp,
  16         module HsLit,
  17         module HsPat,
  18         module HsTypes,
  19         Fixity, NewOrData,
  20
  21         HsModule(..), HsExtCore(..),
  22         collectStmtsBinders, collectStmtBinders,
  23         collectHsBinders,   collectLocatedHsBinders,
  24         collectMonoBinders, collectLocatedMonoBinders,
  25         collectSigTysFromHsBinds, collectSigTysFromMonoBinds
  26      ) where
  27
  28 #include "HsVersions.h"
  29
  30 -- friends:
  31 import HsDecls
  32 import HsBinds
  33 import HsExpr
  34 import HsImpExp
  35 import HsLit
  36 import HsPat
  37 import HsTypes
  38 import HscTypes         ( DeprecTxt )
  39 import BasicTypes       ( Fixity, NewOrData )
  40
  41 -- others:
  42 import IfaceSyn         ( IfaceBinding )
  43 import Outputable
  44 import SrcLoc           ( SrcLoc )
  45 import Module           ( Module )
  46 \end{code}
  47
  48 All we actually declare here is the top-level structure for a module.
  49 \begin{code}
  50 data HsModule name
  51   = HsModule
  52         (Maybe Module)          -- Nothing => "module X where" is omitted
  53                                 --      (in which case the next field is Nothing too)
  54         (Maybe [IE name])       -- Export list; Nothing => export list omitted, so export everything
  55                                 -- Just [] => export *nothing*
  56                                 -- Just [...] => as you would expect...
  57         [ImportDecl name]       -- We snaffle interesting stuff out of the
  58                                 -- imported interfaces early on, adding that
  59                                 -- info to TyDecls/etc; so this list is
  60                                 -- often empty, downstream.
  61         [HsDecl name]   -- Type, class, value, and interface signature decls
  62         (Maybe DeprecTxt)       -- reason/explanation for deprecation of this module
  63         SrcLoc
  64
  65 data HsExtCore name     -- Read from Foo.hcr
  66   = HsExtCore
  67         Module
  68         [TyClDecl name] -- Type declarations only; just as in Haskell source,
  69                         -- so that we can infer kinds etc
  70         [IfaceBinding]  -- And the bindings
  71 \end{code}
  72
  73 \begin{code}
  74 instance (OutputableBndr name)
  75         => Outputable (HsModule name) where
  76
  77     ppr (HsModule Nothing _ imports decls _ src_loc)
  78       = pp_nonnull imports $$ pp_nonnull decls
  79
  80     ppr (HsModule (Just name) exports imports decls deprec src_loc)
  81       = vcat [
  82             case exports of
  83               Nothing -> pp_header (ptext SLIT("where"))
  84               Just es -> vcat [
  85                             pp_header lparen,
  86                             nest 8 (fsep (punctuate comma (map ppr es))),
  87                             nest 4 (ptext SLIT(") where"))
  88                           ],
  89             pp_nonnull imports,
  90             pp_nonnull decls
  91         ]
  92       where
  93         pp_header rest = case deprec of
  94            Nothing -> pp_modname <+> rest
  95            Just d -> vcat [ pp_modname, ppr d, rest ]
  96
  97         pp_modname = ptext SLIT("module") <+> ppr name
  98
  99 pp_nonnull [] = empty
 100 pp_nonnull xs = vcat (map ppr xs)
 101 \end{code}
 102
 103
 104 %************************************************************************
 105 %*                                                                      *
 106 \subsection{Collecting binders from @HsBinds@}
 107 %*                                                                      *
 108 %************************************************************************
 109
 110 Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
 111
 112 These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
 113
 114 \begin{verbatim}
 115 ...
 116 where
 117   (x, y) = ...
 118   f i j  = ...
 119   [a, b] = ...
 120 \end{verbatim}
 121 it should return @[x, y, f, a, b]@ (remember, order important).
 122
 123 \begin{code}
 124 collectLocatedHsBinders :: HsBinds name -> [(name,SrcLoc)]
 125 -- Used at top level only; so no need for an IPBinds case
 126 collectLocatedHsBinders EmptyBinds = []
 127 collectLocatedHsBinders (MonoBind b _ _)
 128  = collectLocatedMonoBinders b
 129 collectLocatedHsBinders (ThenBinds b1 b2)
 130  = collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2
 131
 132 collectHsBinders :: HsBinds name -> [name]
 133 collectHsBinders EmptyBinds        = []
 134 collectHsBinders (IPBinds _)       = []         -- Implicit parameters don't create
 135                                                 -- ordinary bindings
 136 collectHsBinders (MonoBind b _ _)  = collectMonoBinders b
 137 collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2
 138
 139 collectLocatedMonoBinders :: MonoBinds name -> [(name,SrcLoc)]
 140 collectLocatedMonoBinders binds
 141   = go binds []
 142   where
 143     go EmptyMonoBinds          acc = acc
 144     go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
 145     go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
 146     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
 147
 148 collectMonoBinders :: MonoBinds name -> [name]
 149 collectMonoBinders binds
 150   = go binds []
 151   where
 152     go EmptyMonoBinds          acc = acc
 153     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
 154     go (FunMonoBind f _ _ loc) acc = f : acc
 155     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
 156     go (VarMonoBind v _)       acc = v : acc
 157     go (AbsBinds _ _ dbinds _ binds) acc
 158       = [dp | (_,dp,_) <- dbinds] ++ go binds acc
 159 \end{code}
 160
 161
 162 %************************************************************************
 163 %*                                                                      *
 164 \subsection{Getting patterns out of bindings}
 165 %*                                                                      *
 166 %************************************************************************
 167
 168 Get all the pattern type signatures out of a bunch of bindings
 169
 170 \begin{code}
 171 collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
 172 collectSigTysFromHsBinds EmptyBinds        = []
 173 collectSigTysFromHsBinds (IPBinds _)       = []
 174 collectSigTysFromHsBinds (MonoBind b _ _)  = collectSigTysFromMonoBinds b
 175 collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
 176                                              collectSigTysFromHsBinds b2
 177
 178
 179 collectSigTysFromMonoBinds :: MonoBinds name -> [HsType name]
 180 collectSigTysFromMonoBinds bind
 181   = go bind []
 182   where
 183     go EmptyMonoBinds           acc = acc
 184     go (PatMonoBind pat _ loc)  acc = collectSigTysFromPat pat ++ acc
 185     go (FunMonoBind f _ ms loc) acc = go_matches ms acc
 186     go (AndMonoBinds bs1 bs2)   acc = go bs1 (go bs2 acc)
 187
 188         -- A binding like    x :: a = f y
 189         -- is parsed as FunMonoBind, but for this purpose we
 190         -- want to treat it as a pattern binding
 191     go_matches []                                acc = acc
 192     go_matches (Match [] (Just sig) _ : matches) acc = sig : go_matches matches acc
 193     go_matches (match                 : matches) acc = go_matches matches acc
 194 \end{code}
 195
 196 \begin{code}
 197 collectStmtsBinders :: [Stmt id] -> [id]
 198 collectStmtsBinders = concatMap collectStmtBinders
 199
 200 collectStmtBinders :: Stmt id -> [id]
 201   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 202 collectStmtBinders (BindStmt pat _ _) = collectPatBinders pat
 203 collectStmtBinders (LetStmt binds)    = collectHsBinders binds
 204 collectStmtBinders (ExprStmt _ _ _)   = []
 205 collectStmtBinders (ResultStmt _ _)   = []
 206 collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss
 207 collectStmtBinders other              = panic "collectStmtBinders"
 208 \end{code}
 209