[project @ 2002-02-11 08:20:38 by chak]
[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 HsPat,
23         module HsTypes,
24         Fixity, NewOrData, 
25
26         collectHsBinders, collectHsOutBinders, collectLocatedHsBinders, 
27         collectMonoBinders, collectLocatedMonoBinders,
28         collectSigTysFromMonoBinds,
29         hsModuleName, hsModuleImports
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           ( 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 (NamedThing name, 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 collectLocatedHsBinders :: HsBinds name (InPat 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 (InPat name) -> [name]
129 collectHsBinders EmptyBinds = []
130 collectHsBinders (MonoBind b _ _) 
131  = collectMonoBinders b
132 collectHsBinders (ThenBinds b1 b2)
133  = collectHsBinders b1 ++ collectHsBinders b2
134
135 -- corresponds to `collectHsBinders', but operates on renamed patterns
136 --
137 collectHsOutBinders :: HsBinds name (OutPat name) -> [name]
138 collectHsOutBinders EmptyBinds = []
139 collectHsOutBinders (MonoBind b _ _) 
140  = collectMonoOutBinders b
141 collectHsOutBinders (ThenBinds b1 b2)
142  = collectHsOutBinders b1 ++ collectHsOutBinders b2
143
144 collectLocatedMonoBinders :: MonoBinds name (InPat name) -> [(name,SrcLoc)]
145 collectLocatedMonoBinders binds
146   = go binds []
147   where
148     go EmptyMonoBinds          acc = acc
149     go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
150     go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
151     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
152
153 collectMonoBinders :: MonoBinds name (InPat name) -> [name]
154 collectMonoBinders binds
155   = go binds []
156   where
157     go EmptyMonoBinds          acc = acc
158     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
159     go (FunMonoBind f _ _ loc) acc = f : acc
160     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
161
162 -- corresponds to `collectMonoBinders', but operates on renamed patterns
163 --
164 collectMonoOutBinders :: MonoBinds name (OutPat name) -> [name]
165 collectMonoOutBinders binds
166   = go binds []
167   where
168     go EmptyMonoBinds          acc = acc
169     go (PatMonoBind pat _ loc) acc = collectOutPatBinders pat ++ acc
170     go (FunMonoBind f _ _ loc) acc = f : acc
171     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
172 \end{code}
173
174 %************************************************************************
175 %*                                                                      *
176 \subsection{Getting patterns out of bindings}
177 %*                                                                      *
178 %************************************************************************
179
180 Get all the pattern type signatures out of a bunch of bindings
181
182 \begin{code}
183 collectSigTysFromMonoBinds :: MonoBinds name (InPat name) -> [HsType name]
184 collectSigTysFromMonoBinds bind
185   = go bind []
186   where
187     go EmptyMonoBinds           acc = acc
188     go (PatMonoBind pat _ loc)  acc = collectSigTysFromPat pat ++ acc
189     go (FunMonoBind f _ ms loc) acc = go_matches ms acc
190     go (AndMonoBinds bs1 bs2)   acc = go bs1 (go bs2 acc)
191
192         -- A binding like    x :: a = f y
193         -- is parsed as FunMonoBind, but for this purpose we    
194         -- want to treat it as a pattern binding
195     go_matches []                                acc = acc
196     go_matches (Match [] (Just sig) _ : matches) acc = sig : go_matches matches acc
197     go_matches (match                 : matches) acc = go_matches matches acc
198 \end{code}
199