1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
|
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section{Haskell abstract syntax definition}
This module glues together the pieces of the Haskell abstract syntax,
which is declared in the various \tr{Hs*} modules. This module,
therefore, is almost nothing but re-exporting.
\begin{code}
module HsSyn (
-- NB: don't reexport HsCore
-- this module tells about "real Haskell"
module HsSyn,
module HsBinds,
module HsDecls,
module HsExpr,
module HsImpExp,
module HsLit,
module HsPat,
module HsTypes,
Fixity, NewOrData,
collectHsBinders, collectLocatedHsBinders,
collectMonoBinders, collectLocatedMonoBinders,
collectSigTysFromHsBinds, collectSigTysFromMonoBinds,
hsModule, hsImports
) where
#include "HsVersions.h"
-- friends:
import HsDecls
import HsBinds
import HsExpr
import HsImpExp
import HsLit
import HsPat
import HsTypes
import BasicTypes ( Fixity, Version, NewOrData )
-- others:
import Name ( NamedThing )
import Outputable
import SrcLoc ( SrcLoc )
import Module ( Module )
\end{code}
All we actually declare here is the top-level structure for a module.
\begin{code}
data HsModule name
= HsModule
Module
(Maybe Version) -- source interface version number
(Maybe [IE name]) -- export list; Nothing => export everything
-- Just [] => export *nothing* (???)
-- Just [...] => as you would expect...
[ImportDecl name] -- We snaffle interesting stuff out of the
-- imported interfaces early on, adding that
-- info to TyDecls/etc; so this list is
-- often empty, downstream.
[HsDecl name] -- Type, class, value, and interface signature decls
(Maybe DeprecTxt) -- reason/explanation for deprecation of this module
SrcLoc
\end{code}
\begin{code}
instance (NamedThing name, OutputableBndr name)
=> Outputable (HsModule name) where
ppr (HsModule name iface_version exports imports
decls deprec src_loc)
= vcat [
case exports of
Nothing -> pp_header (ptext SLIT("where"))
Just es -> vcat [
pp_header lparen,
nest 8 (fsep (punctuate comma (map ppr es))),
nest 4 (ptext SLIT(") where"))
],
pp_nonnull imports,
pp_nonnull decls
]
where
pp_header rest = case deprec of
Nothing -> pp_modname <+> rest
Just d -> vcat [ pp_modname, ppr d, rest ]
pp_modname = ptext SLIT("module") <+> ppr name
pp_nonnull [] = empty
pp_nonnull xs = vcat (map ppr xs)
hsModule (HsModule mod _ _ _ _ _ _) = mod
hsImports (HsModule mod vers exports imports decls deprec src_loc) = imports
\end{code}
%************************************************************************
%* *
\subsection{Collecting binders from @HsBinds@}
%* *
%************************************************************************
Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
\begin{verbatim}
...
where
(x, y) = ...
f i j = ...
[a, b] = ...
\end{verbatim}
it should return @[x, y, f, a, b]@ (remember, order important).
\begin{code}
collectLocatedHsBinders :: HsBinds name -> [(name,SrcLoc)]
collectLocatedHsBinders EmptyBinds = []
collectLocatedHsBinders (MonoBind b _ _)
= collectLocatedMonoBinders b
collectLocatedHsBinders (ThenBinds b1 b2)
= collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2
collectHsBinders :: HsBinds name -> [name]
collectHsBinders EmptyBinds = []
collectHsBinders (MonoBind b _ _)
= collectMonoBinders b
collectHsBinders (ThenBinds b1 b2)
= collectHsBinders b1 ++ collectHsBinders b2
collectLocatedMonoBinders :: MonoBinds name -> [(name,SrcLoc)]
collectLocatedMonoBinders binds
= go binds []
where
go EmptyMonoBinds acc = acc
go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
go (AndMonoBinds bs1 bs2) acc = go bs1 (go bs2 acc)
collectMonoBinders :: MonoBinds name -> [name]
collectMonoBinders binds
= go binds []
where
go EmptyMonoBinds acc = acc
go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
go (FunMonoBind f _ _ loc) acc = f : acc
go (AndMonoBinds bs1 bs2) acc = go bs1 (go bs2 acc)
\end{code}
Get all the pattern type signatures out of a bunch of bindings
\begin{code}
collectSigTysFromHsBinds :: HsBinds name -> [HsType name]
collectSigTysFromHsBinds EmptyBinds = []
collectSigTysFromHsBinds (MonoBind b _ _) = collectSigTysFromMonoBinds b
collectSigTysFromHsBinds (ThenBinds b1 b2) = collectSigTysFromHsBinds b1 ++
collectSigTysFromHsBinds b2
collectSigTysFromMonoBinds :: MonoBinds name -> [HsType name]
collectSigTysFromMonoBinds bind
= go bind []
where
go EmptyMonoBinds acc = acc
go (PatMonoBind pat _ loc) acc = collectSigTysFromPat pat ++ acc
go (FunMonoBind f _ ms loc) acc = go_matches ms acc
go (AndMonoBinds bs1 bs2) acc = go bs1 (go bs2 acc)
-- A binding like x :: a = f y
-- is parsed as FunMonoBind, but for this purpose we
-- want to treat it as a pattern binding
go_matches [] acc = acc
go_matches (Match [] (Just sig) _ : matches) acc = sig : go_matches matches acc
go_matches (match : matches) acc = go_matches matches acc
\end{code}
\begin{code}
collectStmtsBinders :: [Stmt id] -> [id]
collectStmtsBinders = concatMap collectStmtBinders
collectStmtBinders :: Stmt id -> [id]
-- Id Binders for a Stmt... [but what about pattern-sig type vars]?
collectStmtBinders (BindStmt pat _ _) = collectPatBinders pat
collectStmtBinders (LetStmt binds) = collectHsBinders binds
collectStmtBinders (ExprStmt _ _ _) = []
collectStmtBinders (ResultStmt _ _) = []
collectStmtBinders other = panic "collectStmtBinders"
\end{code}
|
