[project @ 2001-02-26 15:06:57 by simonmar]
[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         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 HsPat
40 import HsTypes
41 import BasicTypes       ( Fixity, Version, NewOrData )
42
43 -- others:
44 import Name             ( NamedThing )
45 import Outputable
46 import SrcLoc           ( SrcLoc )
47 import Module           ( ModuleName )
48 \end{code}
49
50 All we actually declare here is the top-level structure for a module.
51 \begin{code}
52 data HsModule name pat
53   = HsModule
54         ModuleName              -- module name
55         (Maybe Version)         -- source interface version number
56         (Maybe [IE name])       -- export list; Nothing => export everything
57                                 -- Just [] => export *nothing* (???)
58                                 -- Just [...] => as you would expect...
59         [ImportDecl name]       -- We snaffle interesting stuff out of the
60                                 -- imported interfaces early on, adding that
61                                 -- info to TyDecls/etc; so this list is
62                                 -- often empty, downstream.
63         [HsDecl name pat]       -- Type, class, value, and interface signature decls
64         (Maybe DeprecTxt)       -- reason/explanation for deprecation of this module
65         SrcLoc
66 \end{code}
67
68 \begin{code}
69 instance (NamedThing name, Outputable name, Outputable pat)
70         => Outputable (HsModule name pat) where
71
72     ppr (HsModule name iface_version exports imports
73                       decls deprec src_loc)
74       = vcat [
75             case exports of
76               Nothing -> pp_header (ptext SLIT("where"))
77               Just es -> vcat [
78                             pp_header lparen,
79                             nest 8 (fsep (punctuate comma (map ppr es))),
80                             nest 4 (ptext SLIT(") where"))
81                           ],
82             pp_nonnull imports,
83             pp_nonnull decls
84         ]
85       where
86         pp_header rest = case deprec of
87            Nothing -> pp_modname <+> rest
88            Just d -> vcat [ pp_modname, ppr d, rest ]
89
90         pp_modname = ptext SLIT("module") <+> ppr name
91
92         pp_nonnull [] = empty
93         pp_nonnull xs = vcat (map ppr xs)
94
95 hsModuleName    (HsModule mod_name _ _ _ _ _ _) = mod_name
96 hsModuleImports (HsModule mod_name vers exports imports decls deprec src_loc) = imports
97 \end{code}
98
99
100 %************************************************************************
101 %*                                                                      *
102 \subsection{Collecting binders from @HsBinds@}
103 %*                                                                      *
104 %************************************************************************
105
106 Get all the binders in some @MonoBinds@, IN THE ORDER OF APPEARANCE.
107
108 These functions are here, rather than in HsBinds, to avoid a loop between HsPat and HsBinds.
109
110 \begin{verbatim}
111 ...
112 where
113   (x, y) = ...
114   f i j  = ...
115   [a, b] = ...
116 \end{verbatim}
117 it should return @[x, y, f, a, b]@ (remember, order important).
118
119 \begin{code}
120 collectLocatedHsBinders :: HsBinds name (InPat name) -> [(name,SrcLoc)]
121 collectLocatedHsBinders EmptyBinds = []
122 collectLocatedHsBinders (MonoBind b _ _) 
123  = collectLocatedMonoBinders b
124 collectLocatedHsBinders (ThenBinds b1 b2)
125  = collectLocatedHsBinders b1 ++ collectLocatedHsBinders b2
126
127 collectHsBinders :: HsBinds name (InPat name) -> [name]
128 collectHsBinders EmptyBinds = []
129 collectHsBinders (MonoBind b _ _) 
130  = collectMonoBinders b
131 collectHsBinders (ThenBinds b1 b2)
132  = collectHsBinders b1 ++ collectHsBinders b2
133
134 collectLocatedMonoBinders :: MonoBinds name (InPat name) -> [(name,SrcLoc)]
135 collectLocatedMonoBinders binds
136   = go binds []
137   where
138     go EmptyMonoBinds          acc = acc
139     go (PatMonoBind pat _ loc) acc = map (\v->(v,loc)) (collectPatBinders pat) ++ acc
140     go (FunMonoBind f _ _ loc) acc = (f,loc) : acc
141     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
142
143 collectMonoBinders :: MonoBinds name (InPat name) -> [name]
144 collectMonoBinders binds
145   = go binds []
146   where
147     go EmptyMonoBinds          acc = acc
148     go (PatMonoBind pat _ loc) acc = collectPatBinders pat ++ acc
149     go (FunMonoBind f _ _ loc) acc = f : acc
150     go (AndMonoBinds bs1 bs2)  acc = go bs1 (go bs2 acc)
151 \end{code}