Tidy VectInfo in tidyProgram
[ghc-hetmet.git] / compiler / main / TidyPgm.lhs
index 7551494..88a3059 100644 (file)
@@ -29,7 +29,7 @@ import IdInfo
 import InstEnv
 import NewDemand
 import BasicTypes
-import Name
+import Name hiding (varName)
 import NameSet
 import IfaceEnv
 import NameEnv
@@ -50,8 +50,9 @@ import Data.IORef     ( IORef, readIORef, writeIORef )
 \end{code}
 
 
-Constructing the TypeEnv, Instances, Rules from which the ModIface is
-constructed, and which goes on to subsequent modules in --make mode.
+Constructing the TypeEnv, Instances, Rules, VectInfo from which the
+ModIface is constructed, and which goes on to subsequent modules in
+--make mode.
 
 Most of the interface file is obtained simply by serialising the
 TypeEnv.  One important consequence is that if the *interface file*
@@ -303,8 +304,10 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
              ; th         = dopt Opt_TemplateHaskell      dflags
               }
 
+       ; let { implicit_binds = getImplicitBinds type_env }
+
         ; (unfold_env, tidy_occ_env)
-              <- chooseExternalIds hsc_env mod omit_prags binds
+              <- chooseExternalIds hsc_env mod omit_prags binds implicit_binds
 
         ; let { ext_rules 
                   | omit_prags = []
@@ -337,8 +340,9 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                -- and indeed it does, but if omit_prags is on, ext_rules is
                -- empty
 
+              ; tidy_vect_info = tidyVectInfo tidy_env vect_info
+
              -- See Note [Injecting implicit bindings]
-             ; implicit_binds = getImplicitBinds type_env
              ; all_tidy_binds = implicit_binds ++ tidy_binds
 
              ; alg_tycons = filter isAlgTyCon (typeEnvTyCons type_env)
@@ -363,10 +367,9 @@ tidyProgram hsc_env  (ModGuts { mg_module = mod, mg_exports = exports,
                   ModDetails { md_types     = tidy_type_env,
                                md_rules     = tidy_rules,
                                md_insts     = tidy_insts,
-                               md_fam_insts = fam_insts,
+                                md_vect_info = tidy_vect_info,                                                  md_fam_insts = fam_insts,
                                md_exports   = exports,
-                               md_anns      = anns,     -- are already tidy
-                                md_vect_info = vect_info --
+                               md_anns      = anns      -- are already tidy
                               })
        }
 
@@ -475,6 +478,29 @@ tidyInstances tidy_dfun ispecs
                 tidy_dfun (instanceDFunId ispec)
 \end{code}
 
+\begin{code}
+tidyVectInfo :: TidyEnv -> VectInfo -> VectInfo
+tidyVectInfo (_, var_env) info@(VectInfo { vectInfoVar     = vars
+                                         , vectInfoPADFun  = pas
+                                         , vectInfoIso     = isos })
+  = info { vectInfoVar    = tidy_vars
+         , vectInfoPADFun = tidy_pas
+         , vectInfoIso    = tidy_isos }
+  where
+    tidy_vars = mkVarEnv
+              $ map tidy_var_mapping
+              $ varEnvElts vars
+
+    tidy_pas = mapNameEnv tidy_snd_var pas
+    tidy_isos = mapNameEnv tidy_snd_var isos
+
+    tidy_var_mapping (from, to) = (from', (from', lookup_var to))
+      where from' = lookup_var from
+    tidy_snd_var (x, var) = (x, lookup_var var)
+      
+    lookup_var var = lookupWithDefaultVarEnv var_env var var
+\end{code}
+
 
 %************************************************************************
 %*                                                                     *
@@ -495,6 +521,11 @@ why CoreUnfold.mkImplicitUnfolding uses simleExprOpt to do a bit of
 optimisation first.  (Only matters when the selector is used curried;
 eg map x ys.)  See Trac #2070.
 
+[Oct 09: in fact, record selectors are no longer implicit Ids at all,
+because we really do want to optimise them properly. They are treated
+much like any other Id.  But doing "light" optimisation on an implicit
+Id still makes sense.]
+
 At one time I tried injecting the implicit bindings *early*, at the
 beginning of SimplCore.  But that gave rise to real difficulty,
 becuase GlobalIds are supposed to have *fixed* IdInfo, but the
@@ -505,18 +536,23 @@ importing modules were expecting it to have arity 1 (Trac #2844).
 It's much safer just to inject them right at the end, after tidying.
 
 Oh: two other reasons for injecting them late:
+
   - If implicit Ids are already in the bindings when we start TidyPgm,
     we'd have to be careful not to treat them as external Ids (in
     the sense of findExternalIds); else the Ids mentioned in *their*
     RHSs will be treated as external and you get an interface file 
     saying      a18 = <blah>
     but nothing refererring to a18 (because the implicit Id is the 
-    one that does).
+    one that does, and implicit Ids don't appear in interface files).
 
   - More seriously, the tidied type-envt will include the implicit
     Id replete with a18 in its unfolding; but we won't take account
     of a18 when computing a fingerprint for the class; result chaos.
     
+There is one sort of implicit binding that is injected still later,
+namely those for data constructor workers. Reason (I think): it's
+really just a code generation trick.... binding itself makes no sense.
+See CorePrep Note [Data constructor workers].
 
 \begin{code}
 getImplicitBinds :: TypeEnv -> [CoreBind]
@@ -552,10 +588,11 @@ chooseExternalIds :: HscEnv
                   -> Module
                   -> Bool
                  -> [CoreBind]
+                  -> [CoreBind]
                   -> IO (UnfoldEnv, TidyOccEnv)
        -- Step 1 from the notes above
 
-chooseExternalIds hsc_env mod omit_prags binds
+chooseExternalIds hsc_env mod omit_prags binds implicit_binds
   = do
     (unfold_env1,occ_env1) 
         <- search (zip sorted_exports sorted_exports) emptyVarEnv init_occ_env
@@ -576,11 +613,12 @@ chooseExternalIds hsc_env mod omit_prags binds
                      filter isExportedId binders
 
   binders = bindersOfBinds binds
+  implicit_binders = bindersOfBinds implicit_binds
 
   bind_env :: IdEnv (Id,CoreExpr)
   bind_env = mkVarEnv (zip (map fst bs) bs) where bs = flattenBinds binds
 
-  avoids   = [getOccName name | bndr <- binders,
+  avoids   = [getOccName name | bndr <- binders ++ implicit_binders,
                                 let name = idName bndr,
                                 isExternalName name ]
                -- In computing our "avoids" list, we must include
@@ -589,6 +627,8 @@ chooseExternalIds hsc_env mod omit_prags binds
                --                                      all by the renamer)
                -- since their names are "taken".
                -- The type environment is a convenient source of such things.
+                -- In particular, the set of binders doesn't include
+                -- implicit Ids at this stage.
 
        -- We also make sure to avoid any exported binders.  Consider
        --      f{-u1-} = 1     -- Local decl