cb42ba5625a37e422a9722be88bfc5405e5aa011
[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, 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 collectLocatedMonoBinders :: MonoBinds name (InPat 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 (InPat 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 %************************************************************************
155 %*                                                                      *
156 \subsection{Getting patterns out of bindings}
157 %*                                                                      *
158 %************************************************************************
159
160 Get all the pattern type signatures out of a bunch of bindings
161
162 \begin{code}
163 collectSigTysFromMonoBinds :: MonoBinds name (InPat name) -> [HsType name]
164 collectSigTysFromMonoBinds bind
165   = go bind []
166   where
167     go EmptyMonoBinds           acc = acc
168     go (PatMonoBind pat _ loc)  acc = collectSigTysFromPat pat ++ acc
169     go (FunMonoBind f _ ms loc) acc = go_matches ms acc
170     go (AndMonoBinds bs1 bs2)   acc = go bs1 (go bs2 acc)
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 []                                acc = acc
176     go_matches (Match [] (Just sig) _ : matches) acc = sig : go_matches matches acc
177     go_matches (match                 : matches) acc = go_matches matches acc
178 \end{code}
179