[project @ 2000-10-30 13:46:24 by sewardj]
[ghc-hetmet.git] / 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 HsMatches,
23         module HsPat,
24         module HsTypes,
25         Fixity, NewOrData, 
26
27         collectTopBinders, collectMonoBinders, collectLocatedMonoBinders,
28         hsModuleName, hsModuleImports
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 HsMatches
40 import HsPat
41 import HsTypes
42 import BasicTypes       ( Fixity, Version, NewOrData )
43
44 -- others:
45 import Outputable
46 import SrcLoc           ( SrcLoc )
47 import Bag
48 import Module           ( ModuleName )
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 pat
54   = HsModule
55         ModuleName              -- module name
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 pat]       -- 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 (Outputable name, Outputable pat)
71         => Outputable (HsModule name pat) 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 hsModuleName    (HsModule mod_name _ _ _ _ _ _) = mod_name
97 hsModuleImports (HsModule mod_name 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 collectTopBinders :: HsBinds name (InPat name) -> Bag (name,SrcLoc)
122 collectTopBinders EmptyBinds        = emptyBag
123 collectTopBinders (MonoBind b _ _)  = listToBag (collectLocatedMonoBinders b)
124 collectTopBinders (ThenBinds b1 b2) = collectTopBinders b1 `unionBags` collectTopBinders b2
125
126 collectLocatedMonoBinders :: MonoBinds name (InPat name) -> [(name,SrcLoc)]
127 collectLocatedMonoBinders binds
128   = go binds []
129   where
130     go EmptyMonoBinds          acc = acc
131     go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
132     go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
133     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
134
135 collectMonoBinders :: MonoBinds name (InPat name) -> [name]
136 collectMonoBinders binds
137   = go binds []
138   where
139     go EmptyMonoBinds          acc = acc
140     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
141     go (FunMonoBind f _ _ loc) acc = f : acc
142     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
143 \end{code}