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(..), hsModule, hsImports,
  25         collectStmtsBinders,
  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         Module
  55         (Maybe Version)         -- source interface version number
  56         (Maybe [IE name])       -- export list; Nothing => 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 name iface_version exports imports
  73                       decls deprec src_loc)
  74       = vcat [
  75             case exports of
  76               Nothing -> pp_header (ptext SLIT("where"))
  77               Just es -> vcat [
  78                             pp_header lparen,
  79                             nest 8 (fsep (punctuate comma (map ppr es))),
  80                             nest 4 (ptext SLIT(") where"))
  81                           ],
  82             pp_nonnull imports,
  83             pp_nonnull decls
  84         ]
  85       where
  86         pp_header rest = case deprec of
  87            Nothing -> pp_modname <+> rest
  88            Just d -> vcat [ pp_modname, ppr d, rest ]
  89
  90         pp_modname = ptext SLIT("module") <+> ppr name
  91
  92         pp_nonnull [] = empty
  93         pp_nonnull xs = vcat (map ppr xs)
  94
  95 hsModule  (HsModule mod _ _ _ _ _ _) = mod
  96 hsImports (HsModule mod vers exports imports decls deprec src_loc) = imports
  97 \end{code}
  98
  99
 100 %************************************************************************
 101 %*                                                                      *
 102 \subsection{Collecting binders from @HsBinds@}
 103 %*                                                                      *
 104 %************************************************************************
 105
 106 Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
 107
 108 These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
 109
 110 \begin{verbatim}
 111 ...
 112 where
 113   (x, y) = ...
 114   f i j  = ...
 115   [a, b] = ...
 116 \end{verbatim}
 117 it should return @[x, y, f, a, b]@ (remember, order important).
 118
 119 \begin{code}
 120 collectLocatedHsBinders :: HsBinds name -> [(name,SrcLoc)]
 121 -- Used at top level only; so no need for an IPBinds case
 122 collectLocatedHsBinders EmptyBinds = []
 123 collectLocatedHsBinders (MonoBind b _ _)
 124  = collectLocatedMonoBinders b
 125 collectLocatedHsBinders (ThenBinds b1 b2)
 126  = collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2
 127
 128 collectHsBinders :: HsBinds name -> [name]
 129 collectHsBinders EmptyBinds        = []
 130 collectHsBinders (IPBinds _ _)     = []         -- Implicit parameters don't create
 131                                                 -- ordinary bindings
 132 collectHsBinders (MonoBind b _ _)  = collectMonoBinders b
 133 collectHsBinders (ThenBinds b1 b2) = collectHsBinders b1 ++ collectHsBinders b2
 134
 135 collectLocatedMonoBinders :: MonoBinds name -> [(name,SrcLoc)]
 136 collectLocatedMonoBinders binds
 137   = go binds []
 138   where
 139     go EmptyMonoBinds          acc = acc
 140     go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
 141     go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
 142     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
 143
 144 collectMonoBinders :: MonoBinds name -> [name]
 145 collectMonoBinders binds
 146   = go binds []
 147   where
 148     go EmptyMonoBinds          acc = acc
 149     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
 150     go (FunMonoBind f _ _ loc) acc = f : acc
 151     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
 152 \end{code}
 153
 154
 155 %************************************************************************
 156 %*                                                                      *
 157 \subsection{Getting patterns out of bindings}
 158 %*                                                                      *
 159 %************************************************************************
 160
 161 Get all the pattern type signatures out of a bunch of bindings
 162
 163 \begin{code}
 164 collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
 165 collectSigTysFromHsBinds EmptyBinds        = []
 166 collectSigTysFromHsBinds (IPBinds _ _)     = []
 167 collectSigTysFromHsBinds (MonoBind b _ _)  = collectSigTysFromMonoBinds b
 168 collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
 169                                              collectSigTysFromHsBinds b2
 170
 171
 172 collectSigTysFromMonoBinds :: MonoBinds name -> [HsType name]
 173 collectSigTysFromMonoBinds bind
 174   = go bind []
 175   where
 176     go EmptyMonoBinds           acc = acc
 177     go (PatMonoBind pat _ loc)  acc = collectSigTysFromPat pat ++ acc
 178     go (FunMonoBind f _ ms loc) acc = go_matches ms acc
 179     go (AndMonoBinds bs1 bs2)   acc = go bs1 (go bs2 acc)
 180
 181         -- A binding like    x :: a = f y
 182         -- is parsed as FunMonoBind, but for this purpose we
 183         -- want to treat it as a pattern binding
 184     go_matches []                                acc = acc
 185     go_matches (Match [] (Just sig) _ : matches) acc = sig : go_matches matches acc
 186     go_matches (match                 : matches) acc = go_matches matches acc
 187 \end{code}
 188
 189 \begin{code}
 190 collectStmtsBinders :: [Stmt id] -> [id]
 191 collectStmtsBinders = concatMap collectStmtBinders
 192
 193 collectStmtBinders :: Stmt id -> [id]
 194   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 195 collectStmtBinders (BindStmt pat _ _) = collectPatBinders pat
 196 collectStmtBinders (LetStmt binds)    = collectHsBinders binds
 197 collectStmtBinders (ExprStmt _ _ _)   = []
 198 collectStmtBinders (ResultStmt _ _)   = []
 199 collectStmtBinders other              = panic "collectStmtBinders"
 200 \end{code}
 201