[project @ 1996-12-19 09:10:02 by simonpj]
[ghc-hetmet.git] / ghc / compiler / rename / Rename.lhs
1 %
2 % (c) The GRASP Project, Glasgow University, 1992-1996
3 %
4 \section[Rename]{Renaming and dependency analysis passes}
5
6 \begin{code}
7 #include "HsVersions.h"
8
9 module Rename ( renameModule ) where
10
11 import PreludeGlaST     ( thenPrimIO )
12
13 IMP_Ubiq()
14 IMPORT_1_3(List(partition))
15
16 import HsSyn
17 import RdrHsSyn         ( RdrName, SYN_IE(RdrNameHsModule), SYN_IE(RdrNameImportDecl) )
18 import RnHsSyn          ( SYN_IE(RenamedHsModule), SYN_IE(RenamedHsDecl), extractHsTyNames )
19
20 import CmdLineOpts      ( opt_HiMap )
21 import RnMonad
22 import RnNames          ( getGlobalNames )
23 import RnSource         ( rnDecl )
24 import RnIfaces         ( getImportedInstDecls, getDecl, getImportVersions, getSpecialInstModules,
25                           mkSearchPath, getWiredInDecl
26                         )
27 import RnEnv            ( availsToNameSet, addAvailToNameSet, addImplicitOccsRn )
28 import Id               ( GenId {- instance NamedThing -} )
29 import Name             ( Name, Provenance, ExportFlag(..), isLocallyDefined,
30                           NameSet(..), elemNameSet, mkNameSet, unionNameSets, nameSetToList,
31                           isWiredInName, modAndOcc
32                         )
33 import TysWiredIn       ( unitTyCon, intTyCon, doubleTyCon )
34 import TyCon            ( TyCon )
35 import ErrUtils         ( SYN_IE(Error), SYN_IE(Warning) )
36 import FiniteMap        ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
37 import Pretty
38 import PprStyle         ( PprStyle(..) )
39 import Util             ( panic, assertPanic, pprTrace )
40 \end{code}
41
42
43
44 \begin{code}
45 renameModule :: UniqSupply
46              -> RdrNameHsModule
47              -> IO (Maybe                       -- Nothing <=> everything up to date;
48                                                 -- no ned to recompile any further
49                           (RenamedHsModule,     -- Output, after renaming
50                            InterfaceDetails,    -- Interface; for interface file generatino
51                            RnNameSupply,        -- Final env; for renaming derivings
52                            [Module]),           -- Imported modules; for profiling
53                     Bag Error, 
54                     Bag Warning
55                    )
56 \end{code} 
57
58
59 \begin{code}
60 renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
61   =     -- INITIALISE THE RENAMER MONAD
62     initRn mod_name us (mkSearchPath opt_HiMap) loc $
63
64         -- FIND THE GLOBAL NAME ENVIRONMENT
65     getGlobalNames this_mod                     `thenRn` \ global_name_info ->
66
67     case global_name_info of {
68         Nothing ->      -- Everything is up to date; no need to recompile further
69                         returnRn Nothing ;
70
71                         -- Otherwise, just carry on
72         Just (export_env, rn_env, local_avails) ->
73
74         -- RENAME THE SOURCE
75         -- We also add occurrences for Int, Double, and (), because they
76         -- are the types to which ambigious type variables may be defaulted by
77         -- the type checker; so they won't every appear explicitly.
78         -- [The () one is a GHC extension for defaulting CCall results.]
79     initRnMS rn_env mod_name SourceMode (mapRn rnDecl local_decls)      `thenRn` \ rn_local_decls ->
80     addImplicitOccsRn [getName intTyCon, 
81                        getName doubleTyCon, 
82                        getName unitTyCon]               `thenRn_` 
83
84         -- SLURP IN ALL THE NEEDED DECLARATIONS
85         -- Notice that the rnEnv starts empty
86     closeDecls rn_local_decls (availsToNameSet local_avails) []
87                                                 `thenRn` \ (rn_all_decls, imported_avails) ->
88
89         -- SLURP IN ALL NEEDED INSTANCE DECLARATIONS
90         -- We keep the ones that only mention things (type constructors, classes) that are
91         -- already imported.  Ones which don't can't possibly be useful to us.
92     getImportedInstDecls                                `thenRn` \ imported_insts ->
93     let
94         all_big_names = mkNameSet [name | Avail name _ <- local_avails]    `unionNameSets` 
95                         mkNameSet [name | Avail name _ <- imported_avails]
96
97         rn_needed_insts = [ initRnMS emptyRnEnv mod_name InterfaceMode (rnDecl (InstD inst_decl))
98                           | (inst_names, mod_name, inst_decl) <- imported_insts,
99                             all (`elemNameSet` all_big_names) inst_names
100                           ]
101     in
102     sequenceRn rn_needed_insts                          `thenRn` \ inst_decls ->
103         -- Maybe we need to do another close-decls?
104
105
106         -- GENERATE THE VERSION/USAGE INFO
107     getImportVersions imported_avails                   `thenRn` \ import_versions ->
108     getNameSupplyRn                                     `thenRn` \ name_supply ->
109
110
111         -- GENERATE THE SPECIAL-INSTANCE MODULE LIST
112         -- The "special instance" modules are those modules that contain instance
113         -- declarations that contain no type constructor or class that was declared
114         -- in that module.
115     getSpecialInstModules                               `thenRn` \ imported_special_inst_mods ->
116     let
117         special_inst_decls = [d | InstD d@(InstDecl inst_ty _ _ _ _) <- rn_local_decls,
118                                   all (not.isLocallyDefined) (nameSetToList (extractHsTyNames inst_ty))
119                              ]
120         special_inst_mods | null special_inst_decls = imported_special_inst_mods
121                           | otherwise               = mod_name : imported_special_inst_mods
122     in
123                   
124     
125
126         -- RETURN THE RENAMED MODULE
127     let
128         import_mods = [mod | ImportDecl mod _ _ _ _ <- imports]
129
130         renamed_module = HsModule mod_name vers 
131                                   trashed_exports trashed_imports trashed_fixities
132                                   (inst_decls ++ rn_all_decls)
133                                   loc
134     in
135     returnRn (Just (renamed_module, 
136                     (import_versions, export_env, special_inst_mods),
137                      name_supply,
138                      import_mods))
139     }
140   where
141     trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
142     trashed_imports  = {-trace "rnSource:trashed_imports"-} []
143     trashed_fixities = []
144 \end{code}
145
146 \begin{code}
147 closeDecls :: [RenamedHsDecl]                   -- Declarations got so far
148            -> NameSet                           -- Names bound by those declarations
149            -> [AvailInfo]                       -- Available stuff generated by closeDecls so far
150            -> RnMG ([RenamedHsDecl],            -- The closed set
151                     [AvailInfo])                -- Available stuff generated by closeDecls
152         -- The monad includes a list of possibly-unresolved Names
153         -- This list is empty when closeDecls returns
154
155 closeDecls decls decl_names import_avails
156   = popOccurrenceName           `thenRn` \ maybe_unresolved ->
157
158     case maybe_unresolved of
159
160         -- No more unresolved names; we're done
161         Nothing ->      returnRn (decls, import_avails)
162
163         -- An "unresolved" name that we've already dealt with
164         Just (name,_) | name `elemNameSet` decl_names 
165           -> closeDecls decls decl_names import_avails
166         
167         -- An unresolved name that's wired in.  In this case there's no 
168         -- declaration to get, but we still want to record it as now available,
169         -- so that we remember to look for instance declarations involving it.
170         Just (name,_) | isWiredInName name
171           -> getWiredInDecl name        `thenRn` \ decl_avail ->
172                      closeDecls decls 
173                                 (addAvailToNameSet decl_names decl_avail)
174                                 (decl_avail : import_avails)
175
176         -- Genuinely unresolved name
177         Just (name,necessity) | otherwise
178           -> getDecl name               `thenRn` \ (decl_avail,new_decl) ->
179              case decl_avail of
180
181                 -- Can't find the declaration; check that it was optional
182                 NotAvailable -> checkRn (case necessity of { Optional -> True; other -> False})
183                                         (getDeclErr name)       `thenRn_` 
184                                 closeDecls decls decl_names import_avails
185
186                 -- Found it
187                 other -> initRnMS emptyRnEnv mod_name InterfaceMode (
188                                      rnDecl new_decl
189                          )                              `thenRn` \ rn_decl ->
190                          closeDecls (rn_decl : decls)
191                                     (addAvailToNameSet decl_names decl_avail)
192                                     (decl_avail : import_avails)
193                      where
194                          (mod_name,_) = modAndOcc name
195
196 getDeclErr name sty
197   = ppSep [ppStr "Failed to find interface decl for", ppr sty name]
198 \end{code}
199
200