ghc/compiler/hsSyn/HsSyn.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   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 #include "HsVersions.h"
  12
  13 module HsSyn (
  14
  15         -- NB: don't reexport HsCore or HsPragmas;
  16         -- this module tells about "real Haskell"
  17
  18         EXP_MODULE(HsSyn) ,
  19         EXP_MODULE(HsBinds) ,
  20         EXP_MODULE(HsDecls) ,
  21         EXP_MODULE(HsExpr) ,
  22         EXP_MODULE(HsImpExp) ,
  23         EXP_MODULE(HsBasic) ,
  24         EXP_MODULE(HsMatches) ,
  25         EXP_MODULE(HsPat) ,
  26         EXP_MODULE(HsTypes),
  27         Fixity, NewOrData,
  28
  29         collectTopBinders, collectMonoBinders
  30      ) where
  31
  32 IMP_Ubiq()
  33
  34 -- friends:
  35 import HsBinds
  36 import HsDecls          ( HsDecl(..), TyDecl(..), InstDecl(..), ClassDecl(..),
  37                           DefaultDecl(..),
  38                           FixityDecl(..),
  39                           ConDecl(..), ConDetails(..), BangType(..),
  40                           IfaceSig(..), HsIdInfo,  SpecDataSig(..), SpecInstSig(..),
  41                           hsDeclName
  42                         )
  43 import HsExpr
  44 import HsImpExp
  45 import HsBasic
  46 import HsMatches
  47 import HsPat
  48 import HsTypes
  49 import HsPragmas        ( ClassPragmas, ClassOpPragmas,
  50                           DataPragmas, GenPragmas, InstancePragmas )
  51 import HsCore
  52 import BasicTypes       ( Fixity, SYN_IE(Version), NewOrData )
  53
  54 -- others:
  55 import FiniteMap        ( FiniteMap )
  56 import Outputable       ( ifPprShowAll, ifnotPprForUser, interpp'SP, Outputable(..) )
  57 import Pretty
  58 import SrcLoc           ( SrcLoc )
  59 import Bag
  60 #if __GLASGOW_HASKELL__ >= 202
  61 import Name
  62 #endif
  63 \end{code}
  64
  65 @Fake@ is a placeholder type; for when tyvars and uvars aren't used.
  66 \begin{code}
  67 data Fake = Fake
  68 instance Eq Fake
  69 instance Outputable Fake
  70 \end{code}
  71
  72 All we actually declare here is the top-level structure for a module.
  73 \begin{code}
  74 data HsModule tyvar uvar name pat
  75   = HsModule
  76         Module                  -- module name
  77         (Maybe Version)         -- source interface version number
  78         (Maybe [IE name])       -- export list; Nothing => export everything
  79                                 -- Just [] => export *nothing* (???)
  80                                 -- Just [...] => as you would expect...
  81         [ImportDecl name]       -- We snaffle interesting stuff out of the
  82                                 -- imported interfaces early on, adding that
  83                                 -- info to TyDecls/etc; so this list is
  84                                 -- often empty, downstream.
  85         [FixityDecl name]
  86         [HsDecl tyvar uvar name pat]    -- Type, class, value, and interface signature decls
  87         SrcLoc
  88 \end{code}
  89
  90 \begin{code}
  91 instance (NamedThing name, Outputable name, Outputable pat,
  92           Eq tyvar, Outputable tyvar, Eq uvar, Outputable uvar)
  93         => Outputable (HsModule tyvar uvar name pat) where
  94
  95     ppr sty (HsModule name iface_version exports imports fixities
  96                       decls src_loc)
  97       = vcat [
  98             ifPprShowAll sty (ppr sty src_loc),
  99             ifnotPprForUser sty (pp_iface_version iface_version),
 100             case exports of
 101               Nothing -> hsep [ptext SLIT("module"), ptext name, ptext SLIT("where")]
 102               Just es -> vcat [
 103                             hsep [ptext SLIT("module"), ptext name, lparen],
 104                             nest 8 (interpp'SP sty es),
 105                             nest 4 (ptext SLIT(") where"))
 106                           ],
 107             pp_nonnull imports,
 108             pp_nonnull fixities,
 109             pp_nonnull decls
 110         ]
 111       where
 112         pp_nonnull [] = empty
 113         pp_nonnull xs = vcat (map (ppr sty) xs)
 114
 115         pp_iface_version Nothing  = empty
 116         pp_iface_version (Just n) = hsep [text "{-# INTERFACE", int n, text "#-}"]
 117 \end{code}
 118
 119
 120 %************************************************************************
 121 %*                                                                      *
 122 \subsection{Collecting binders from @HsBinds@}
 123 %*                                                                      *
 124 %************************************************************************
 125
 126 Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
 127
 128 These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
 129
 130 \begin{verbatim}
 131 ...
 132 where
 133   (x, y) = ...
 134   f i j  = ...
 135   [a, b] = ...
 136 \end{verbatim}
 137 it should return @[x, y, f, a, b]@ (remember, order important).
 138
 139 \begin{code}
 140 collectTopBinders :: HsBinds tyvar uvar name (InPat name) -> Bag (name,SrcLoc)
 141 collectTopBinders EmptyBinds     = emptyBag
 142 collectTopBinders (MonoBind b _ _) = collectMonoBinders b
 143 collectTopBinders (ThenBinds b1 b2)
 144  = collectTopBinders b1 `unionBags` collectTopBinders b2
 145
 146 collectMonoBinders :: MonoBinds tyvar uvar name (InPat name) -> Bag (name,SrcLoc)
 147 collectMonoBinders EmptyMonoBinds                      = emptyBag
 148 collectMonoBinders (PatMonoBind pat grhss_w_binds loc) = listToBag (map (\v->(v,loc)) (collectPatBinders pat))
 149 collectMonoBinders (FunMonoBind f _ matches loc)       = unitBag (f,loc)
 150 collectMonoBinders (VarMonoBind v expr)                = error "collectMonoBinders"
 151 collectMonoBinders (CoreMonoBind v expr)               = error "collectMonoBinders"
 152 collectMonoBinders (AndMonoBinds bs1 bs2)
 153  = collectMonoBinders bs1 `unionBags` collectMonoBinders bs2
 154 \end{code}
 155