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