[project @ 2000-06-10 00:34:52 by lewie]

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

diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index 9702944..beb70cb 100644 (file)
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -21,12 +21,12 @@ import SrcLoc               ( mkSrcLoc )
 
 import Rename          ( renameModule )
 
-import MkIface         ( startIface, ifaceDecls, endIface )
+import MkIface         ( writeIface )
 import TcModule                ( TcResults(..), typecheckModule )
 import Desugar         ( deSugar )
 import SimplCore       ( core2core )
 import CoreLint                ( endPass )
-import CoreSyn         ( coreBindsSize )
+import CoreUtils       ( coreBindsSize )
 import CoreTidy                ( tidyCorePgm )
 import CoreToStg       ( topCoreBindsToStg )
 import StgSyn          ( collectFinalStgBinders, pprStgBindings )
@@ -56,7 +56,7 @@ import NativeInfo       ( os, arch )
 \end{code}
 
 \begin{code}
-main =
+main = stderr `seq`    -- Bug fix.  Sigh
  --  _scc_ "main" 
  doIt classifyOpts
 \end{code}
@@ -123,23 +123,18 @@ doIt (core_cmds, stg_cmds)
                        reportCompile mod_name "Compilation NOT required!" >>
                        return ();
        
-       Just (this_mod, rn_mod, iface_file_stuff, 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
 
@@ -150,16 +145,22 @@ doIt (core_cmds, stg_cmds)
 
        --------------------------  Desugaring ----------------
     _scc_     "DeSugar"
-    deSugar this_mod ds_uniqs tc_results       >>= \ (desugared, rules, h_code, c_code) ->
+    deSugar this_mod ds_uniqs tc_results       >>= \ (desugared, rules, h_code, c_code, fe_binders) ->
 
 
        --------------------------  Main Core-language transformations ----------------
     _scc_     "Core2Core"
-    core2core core_cmds desugared rules                        >>= \ (simplified, imp_rule_ids) ->
+    core2core core_cmds desugared rules                        >>= \ (simplified, orphan_rules) ->
 
        -- Do the final tidy-up
     tidyCorePgm tidy_uniqs this_mod
-               simplified imp_rule_ids                 >>= \ (tidy_binds, tidy_imp_rule_ids) -> 
+               simplified orphan_rules                 >>= \ (tidy_binds, tidy_orphan_rules) -> 
+
+    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
+
 
 
        --------------------------  Convert to STG code -------------------------------
@@ -181,16 +182,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 imp_rule_ids      >>
-    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 tidy_binds tidy_orphan_rules           >>
 
 
        --------------------------  Code generation -------------------------------
@@ -198,6 +192,7 @@ doIt (core_cmds, stg_cmds)
     _scc_     "CodeGen"
     codeGen this_mod imported_modules
            cost_centre_info
+           fe_binders
            local_tycons local_classes 
            stg_binds2                          >>= \ abstractC ->
 
@@ -205,7 +200,10 @@ doIt (core_cmds, stg_cmds)
        --------------------------  Code output -------------------------------
     show_pass "CodeOutput"                             >>
     _scc_     "CodeOutput"
-    codeOutput this_mod c_code h_code abstractC ncg_uniqs      >>
+    codeOutput this_mod local_tycons local_classes
+              tidy_binds stg_binds2
+              c_code h_code abstractC 
+              ncg_uniqs                                >>
 
 
        --------------------------  Final report -------------------------------
@@ -325,11 +323,11 @@ 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 _ _ _ _ _)
+    class_info (ClassDecl _ _ _ _ meth_sigs def_meths _ _ _ _ _ _)
        = case count_sigs meth_sigs of
            (_,classops,_,_) ->
               (classops, addpr (count_monobinds def_meths))