[project @ 2000-07-11 16:12:11 by simonmar]

[ghc-hetmet.git] / ghc / compiler / main / Main.lhs

diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index e252d73..e9827b4 100644 (file)
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -20,14 +20,14 @@ import Lex          ( PState(..), P, ParseResult(..) )
 import SrcLoc          ( mkSrcLoc )
 
 import Rename          ( renameModule )
-import RnMonad         ( InterfaceDetails(..) )
 
-import MkIface         ( startIface, ifaceDecls, endIface )
+import MkIface         ( writeIface )
 import TcModule                ( TcResults(..), typecheckModule )
 import Desugar         ( deSugar )
 import SimplCore       ( core2core )
+import OccurAnal       ( occurAnalyseBinds )
 import CoreLint                ( endPass )
-import CoreSyn         ( coreBindsSize )
+import CoreUtils       ( coreBindsSize )
 import CoreTidy                ( tidyCorePgm )
 import CoreToStg       ( topCoreBindsToStg )
 import StgSyn          ( collectFinalStgBinders, pprStgBindings )
@@ -124,24 +124,18 @@ doIt (core_cmds, stg_cmds)
                        reportCompile mod_name "Compilation NOT required!" >>
                        return ();
        
-       Just (this_mod, rn_mod, iface_file_stuff@(InterfaceDetails _ _ _ deprecations),
-             rn_name_supply, imported_modules) ->
+       Just (this_mod, rn_mod, 
+             old_iface, new_iface,
+             rn_name_supply, fixity_env,
+             imported_modules) ->
                        -- Oh well, we've got to recompile for real
 
 
-       --------------------------  Start interface file  ----------------
-    -- Safely past renaming: we can start the interface file:
-    -- (the iface file is produced incrementally, as we have
-    -- the information that we need...; we use "iface<blah>")
-    -- "endIface" finishes the job.
-    startIface this_mod iface_file_stuff       >>= \ if_handle ->
-
-
        --------------------------  Typechecking ----------------
     show_pass "TypeCheck"                              >>
     _scc_     "TypeCheck"
     typecheckModule tc_uniqs rn_name_supply
-                   iface_file_stuff rn_mod             >>= \ maybe_tc_stuff ->
+                   fixity_env rn_mod           >>= \ maybe_tc_stuff ->
     case maybe_tc_stuff of {
        Nothing -> ghcExit 1;   -- Type checker failed
 
@@ -163,12 +157,26 @@ doIt (core_cmds, stg_cmds)
     tidyCorePgm tidy_uniqs this_mod
                simplified orphan_rules                 >>= \ (tidy_binds, tidy_orphan_rules) -> 
 
+       -- Run the occurrence analyser one last time, so that
+       -- dead binders get dead-binder info.  This is exploited by
+       -- code generators to avoid spitting out redundant bindings.
+       -- The occurrence-zapping in Simplify.simplCaseBinder means
+       -- that the Simplifier nukes useful dead-var stuff especially
+       -- in case patterns.
+    let occ_anal_tidy_binds = occurAnalyseBinds tidy_binds in
+
+    coreBindsSize occ_anal_tidy_binds `seq`
+--     TEMP: the above call zaps some space usage allocated by the
+--     simplifier, which for reasons I don't understand, persists
+--     thoroughout code generation
+
+
 
        --------------------------  Convert to STG code -------------------------------
     show_pass "Core2Stg"                       >>
     _scc_     "Core2Stg"
     let
-       stg_binds   = topCoreBindsToStg c2s_uniqs tidy_binds
+       stg_binds   = topCoreBindsToStg c2s_uniqs occ_anal_tidy_binds
     in
 
        --------------------------  Simplify STG code -------------------------------
@@ -183,16 +191,9 @@ doIt (core_cmds, stg_cmds)
     let
        final_ids = collectFinalStgBinders (map fst stg_binds2)
     in
-    coreBindsSize tidy_binds `seq`
---     TEMP: the above call zaps some space usage allocated by the
---     simplifier, which for reasons I don't understand, persists
---     thoroughout code generation
-
-    ifaceDecls if_handle local_tycons local_classes inst_info
-              final_ids tidy_binds tidy_orphan_rules deprecations      >>
-    endIface if_handle                                         >>
-           -- We are definitely done w/ interface-file stuff at this point:
-           -- (See comments near call to "startIface".)
+    writeIface this_mod old_iface new_iface
+              local_tycons local_classes inst_info
+              final_ids occ_anal_tidy_binds tidy_orphan_rules          >>
 
 
        --------------------------  Code generation -------------------------------
@@ -208,7 +209,8 @@ doIt (core_cmds, stg_cmds)
        --------------------------  Code output -------------------------------
     show_pass "CodeOutput"                             >>
     _scc_     "CodeOutput"
-    codeOutput this_mod local_tycons local_classes stg_binds2
+    codeOutput this_mod local_tycons local_classes
+              occ_anal_tidy_binds stg_binds2
               c_code h_code abstractC 
               ncg_uniqs                                >>
 
@@ -330,8 +332,8 @@ ppSourceStats short (HsModule name version exports imports decls _ src_loc)
     spec_info (Just (False, _)) = (0,0,0,0,1,0)
     spec_info (Just (True, _))  = (0,0,0,0,0,1)
 
-    data_info (TyData _ _ _ _ constrs derivs _ _)
-       = (length constrs, case derivs of {Nothing -> 0; Just ds -> length ds})
+    data_info (TyData _ _ _ _ _ nconstrs derivs _ _)
+       = (nconstrs, case derivs of {Nothing -> 0; Just ds -> length ds})
     data_info other = (0,0)
 
     class_info (ClassDecl _ _ _ _ meth_sigs def_meths _ _ _ _ _ _)