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         module HsUtils,
  20         Fixity, NewOrData,
  21
  22         HsModule(..), HsExtCore(..),
  23         collectStmtsBinders, collectStmtBinders, collectLStmtBinders,
  24         collectGroupBinders, collectHsBindLocatedBinders,
  25         collectHsBindBinders,
  26         collectSigTysFromHsBind, collectSigTysFromHsBinds
  27      ) where
  28
  29 #include "HsVersions.h"
  30
  31 -- friends:
  32 import HsDecls
  33 import HsBinds
  34 import HsExpr
  35 import HsImpExp
  36 import HsLit
  37 import HsPat
  38 import HsTypes
  39 import HscTypes         ( DeprecTxt )
  40 import BasicTypes       ( Fixity, NewOrData )
  41 import HsUtils
  42
  43 -- others:
  44 import IfaceSyn         ( IfaceBinding )
  45 import Outputable
  46 import SrcLoc           ( Located(..), unLoc, noLoc )
  47 import Module           ( Module )
  48 import Bag              ( Bag, foldrBag )
  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         (Maybe (Located Module))-- Nothing => "module X where" is omitted
  56                                 --      (in which case the next field is Nothing too)
  57         (Maybe [LIE name])      -- Export list; Nothing => export list omitted, so export everything
  58                                 -- Just [] => export *nothing*
  59                                 -- Just [...] => as you would expect...
  60         [LImportDecl 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         [LHsDecl name]  -- Type, class, value, and interface signature decls
  65         (Maybe DeprecTxt)       -- reason/explanation for deprecation of this module
  66
  67 data HsExtCore name     -- Read from Foo.hcr
  68   = HsExtCore
  69         Module
  70         [TyClDecl name] -- Type declarations only; just as in Haskell source,
  71                         -- so that we can infer kinds etc
  72         [IfaceBinding]  -- And the bindings
  73 \end{code}
  74
  75 \begin{code}
  76 instance (OutputableBndr name)
  77         => Outputable (HsModule name) where
  78
  79     ppr (HsModule Nothing _ imports decls _)
  80       = pp_nonnull imports $$ pp_nonnull decls
  81
  82     ppr (HsModule (Just name) exports imports decls deprec)
  83       = vcat [
  84             case exports of
  85               Nothing -> pp_header (ptext SLIT("where"))
  86               Just es -> vcat [
  87                            pp_header lparen,
  88                            nest 8 (fsep (punctuate comma (map ppr es))),
  89                            nest 4 (ptext SLIT(") where"))
  90                           ],
  91             pp_nonnull imports,
  92             pp_nonnull decls
  93         ]
  94       where
  95         pp_header rest = case deprec of
  96            Nothing -> pp_modname <+> rest
  97            Just d -> vcat [ pp_modname, ppr d, rest ]
  98
  99         pp_modname = ptext SLIT("module") <+> ppr name
 100
 101 pp_nonnull [] = empty
 102 pp_nonnull xs = vcat (map ppr xs)
 103 \end{code}
 104
 105
 106 %************************************************************************
 107 %*                                                                      *
 108 \subsection{Collecting binders from @HsBinds@}
 109 %*                                                                      *
 110 %************************************************************************
 111
 112 Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
 113
 114 These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
 115
 116 \begin{verbatim}
 117 ...
 118 where
 119   (x, y) = ...
 120   f i j  = ...
 121   [a, b] = ...
 122 \end{verbatim}
 123 it should return @[x, y, f, a, b]@ (remember, order important).
 124
 125 \begin{code}
 126 collectGroupBinders :: [HsBindGroup name] -> [Located name]
 127 collectGroupBinders groups = foldr collect_group [] groups
 128         where
 129           collect_group (HsBindGroup bag sigs is_rec) acc
 130                 = foldrBag (collectAcc . unLoc) acc bag
 131           collect_group (HsIPBinds _) acc = acc
 132
 133
 134 collectAcc :: HsBind name -> [Located name] -> [Located name]
 135 collectAcc (PatBind pat _) acc = collectLocatedPatBinders pat ++ acc
 136 collectAcc (FunBind f _ _) acc = f : acc
 137 collectAcc (VarBind f _) acc  = noLoc f : acc
 138 collectAcc (AbsBinds _ _ dbinds _ binds) acc
 139   = [noLoc dp | (_,dp,_) <- dbinds] ++ acc
 140         -- ++ foldr collectAcc acc binds
 141         -- I don't think we want the binders from the nested binds
 142         -- The only time we collect binders from a typechecked
 143         -- binding (hence see AbsBinds) is in zonking in TcHsSyn
 144
 145 collectHsBindBinders :: Bag (LHsBind name) -> [name]
 146 collectHsBindBinders binds = map unLoc (collectHsBindLocatedBinders binds)
 147
 148 collectHsBindLocatedBinders :: Bag (LHsBind name) -> [Located name]
 149 collectHsBindLocatedBinders binds = foldrBag (collectAcc . unLoc) [] binds
 150 \end{code}
 151
 152
 153 %************************************************************************
 154 %*                                                                      *
 155 \subsection{Getting patterns out of bindings}
 156 %*                                                                      *
 157 %************************************************************************
 158
 159 Get all the pattern type signatures out of a bunch of bindings
 160
 161 \begin{code}
 162 collectSigTysFromHsBinds :: [LHsBind name] -> [LHsType name]
 163 collectSigTysFromHsBinds binds = concat (map collectSigTysFromHsBind binds)
 164
 165 collectSigTysFromHsBind :: LHsBind name -> [LHsType name]
 166 collectSigTysFromHsBind bind
 167   = go (unLoc bind)
 168   where
 169     go (PatBind pat _)  = collectSigTysFromPat pat
 170     go (FunBind f _ ms) = go_matches (map unLoc ms)
 171
 172         -- A binding like    x :: a = f y
 173         -- is parsed as FunMonoBind, but for this purpose we
 174         -- want to treat it as a pattern binding
 175     go_matches []                                = []
 176     go_matches (Match [] (Just sig) _ : matches) = sig : go_matches matches
 177     go_matches (match                 : matches) = go_matches matches
 178 \end{code}
 179
 180 \begin{code}
 181 collectStmtsBinders :: [LStmt id] -> [Located id]
 182 collectStmtsBinders = concatMap collectLStmtBinders
 183
 184 collectLStmtBinders = collectStmtBinders . unLoc
 185
 186 collectStmtBinders :: Stmt id -> [Located id]
 187   -- Id Binders for a Stmt... [but what about pattern-sig type vars]?
 188 collectStmtBinders (BindStmt pat _)   = collectLocatedPatBinders pat
 189 collectStmtBinders (LetStmt binds)    = collectGroupBinders binds
 190 collectStmtBinders (ExprStmt _ _)     = []
 191 collectStmtBinders (ResultStmt _)     = []
 192 collectStmtBinders (RecStmt ss _ _ _) = collectStmtsBinders ss
 193 collectStmtBinders other              = panic "collectStmtBinders"
 194 \end{code}