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