[project @ 2000-03-24 17:49:29 by simonpj]

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

diff --git a/ghc/compiler/main/Main.lhs b/ghc/compiler/main/Main.lhs
index 2406609..e252d73 100644 (file)
--- a/ghc/compiler/main/Main.lhs
+++ b/ghc/compiler/main/Main.lhs
@@ -20,12 +20,14 @@ import Lex          ( PState(..), P, ParseResult(..) )
 import SrcLoc          ( mkSrcLoc )
 
 import Rename          ( renameModule )
+import RnMonad         ( InterfaceDetails(..) )
 
 import MkIface         ( startIface, ifaceDecls, endIface )
 import TcModule                ( TcResults(..), typecheckModule )
 import Desugar         ( deSugar )
 import SimplCore       ( core2core )
 import CoreLint                ( endPass )
+import CoreSyn         ( coreBindsSize )
 import CoreTidy                ( tidyCorePgm )
 import CoreToStg       ( topCoreBindsToStg )
 import StgSyn          ( collectFinalStgBinders, pprStgBindings )
@@ -55,7 +57,7 @@ import NativeInfo       ( os, arch )
 \end{code}
 
 \begin{code}
-main =
+main = stderr `seq`    -- Bug fix.  Sigh
  --  _scc_ "main" 
  doIt classifyOpts
 \end{code}
@@ -73,7 +75,7 @@ parseModule = do
                ghcExit 1
                return (error "parseModule") -- just to get the types right
 
-       POk _ m@(HsModule mod _ _ _ _ _) -> 
+       POk _ m@(HsModule mod _ _ _ _ _ _) -> 
                return (mod, m)
   where
        glaexts | opt_GlasgowExts = 1#
@@ -87,13 +89,17 @@ doIt (core_cmds, stg_cmds)
   = doIfSet opt_Verbose 
        (hPutStr stderr "Glasgow Haskell Compiler, version "    >>
         hPutStr stderr compiler_version                        >>
-        hPutStr stderr ", for Haskell 98\n")                   >>
+        hPutStr stderr ", for Haskell 98, compiled by GHC version " >>
+        hPutStr stderr booter_version                          >>
+        hPutStr stderr "\n")                                   >>
 
        --------------------------  Reader  ----------------
-    show_pass "Reader" >>
-    _scc_     "Reader"
+    show_pass "Parser" >>
+    _scc_     "Parser"
     parseModule                >>= \ (mod_name, rdr_module) ->
 
+    dumpIfSet opt_D_dump_parsed "Parser" (ppr rdr_module) >>
+
     dumpIfSet opt_D_source_stats "Source Statistics"
        (ppSourceStats False rdr_module)                >>
 
@@ -118,7 +124,8 @@ 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, iface_file_stuff@(InterfaceDetails _ _ _ deprecations),
+             rn_name_supply, imported_modules) ->
                        -- Oh well, we've got to recompile for real
 
 
@@ -145,16 +152,16 @@ 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) -> 
 
 
        --------------------------  Convert to STG code -------------------------------
@@ -176,8 +183,13 @@ doIt (core_cmds, stg_cmds)
     let
        final_ids = collectFinalStgBinders (map fst stg_binds2)
     in
-    ifaceDecls if_handle local_tycons local_classes 
-              inst_info final_ids tidy_binds imp_rule_ids      >>
+    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".)
@@ -188,6 +200,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 ->
 
@@ -195,7 +208,9 @@ 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 stg_binds2
+              c_code h_code abstractC 
+              ncg_uniqs                                >>
 
 
        --------------------------  Final report -------------------------------
@@ -212,7 +227,7 @@ doIt (core_cmds, stg_cmds)
        then \ what -> hPutStr stderr ("*** "++what++":\n")
        else \ what -> return ()
 
-ppSourceStats short (HsModule name version exports imports decls src_loc)
+ppSourceStats short (HsModule name version exports imports decls _ src_loc)
  = (if short then hcat else vcat)
         (map pp_val
               [("ExportAll        ", export_all), -- 1 if no export list
@@ -298,11 +313,12 @@ ppSourceStats short (HsModule name version exports imports decls src_loc)
 
     count_sigs sigs = foldr add4 (0,0,0,0) (map sig_info sigs)
 
-    sig_info (Sig _ _ _)          = (1,0,0,0)
-    sig_info (ClassOpSig _ _ _ _) = (0,1,0,0)
-    sig_info (SpecSig _ _ _)      = (0,0,1,0)
-    sig_info (InlineSig _ _)      = (0,0,0,1)
-    sig_info _                    = (0,0,0,0)
+    sig_info (Sig _ _ _)            = (1,0,0,0)
+    sig_info (ClassOpSig _ _ _ _ _) = (0,1,0,0)
+    sig_info (SpecSig _ _ _)        = (0,0,1,0)
+    sig_info (InlineSig _ _ _)      = (0,0,0,1)
+    sig_info (NoInlineSig _ _ _)    = (0,0,0,1)
+    sig_info _                      = (0,0,0,0)
 
     import_info (ImportDecl _ _ qual as spec _)
        = add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
@@ -318,7 +334,7 @@ ppSourceStats short (HsModule name version exports imports decls src_loc)
        = (length constrs, 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))
@@ -358,6 +374,11 @@ compiler_version =
   go ls@[x,y] = '.':ls
   go (x:xs)   = x:go xs
 
+booter_version
+ = case "\ 
+       \ __GLASGOW_HASKELL__" of
+    ' ':n:ns -> n:'.':ns
+    ' ':m    -> m
 \end{code}
 
 \begin{code}