[project @ 1997-07-05 03:02:04 by sof]
[ghc-hetmet.git] / ghc / compiler / main / Main.lhs
index b81182c..803a798 100644 (file)
@@ -13,6 +13,7 @@ IMPORT_1_3(IO(hGetContents,stdin,stderr,hPutStr,hClose,openFile,IOMode(..)))
 
 import HsSyn
 import RdrHsSyn                ( RdrName )
+import BasicTypes      ( NewOrData(..) )
 
 import ReadPrefix      ( rdModule )
 import Rename          ( renameModule )
@@ -49,7 +50,7 @@ import UniqSupply     ( mkSplitUniqSupply )
 
 import PprAbsC         ( dumpRealC, writeRealC )
 import PprCore         ( pprCoreBinding )
-import PprStyle                ( PprStyle(..) )
+import Outputable      ( PprStyle(..), Outputable(..) )
 import Pretty
 
 import Id              ( GenId )               -- instances
@@ -57,9 +58,6 @@ import Name           ( Name )                -- instances
 import PprType         ( GenType, GenTyVar )   -- instances
 import TyVar           ( GenTyVar )            -- instances
 import Unique          ( Unique )              -- instances
-#if __GLASGOW_HASKELL__ >= 202
-import Outputable       ( Outputable(..) )
-#endif
 \end{code}
 
 \begin{code}
@@ -76,7 +74,7 @@ main =
 doIt :: ([CoreToDo], [StgToDo]) -> String -> IO ()
 
 doIt (core_cmds, stg_cmds) input_pgm
-  = doDump opt_Verbose "Glasgow Haskell Compiler, version 2.03, for Haskell 1.4" "" >>
+  = doDump opt_Verbose "Glasgow Haskell Compiler, version 2.04, for Haskell 1.4" "" >>
 
     -- ******* READER
     show_pass "Reader" >>
@@ -90,21 +88,21 @@ doIt (core_cmds, stg_cmds) input_pgm
        (pp_show (ppSourceStats rdr_module))    >>
 
     -- UniqueSupplies for later use (these are the only lower case uniques)
-    _scc_     "spl-rn"
+--    _scc_     "spl-rn"
     mkSplitUniqSupply 'r'      >>= \ rn_uniqs  -> -- renamer
-    _scc_     "spl-tc"
+--    _scc_     "spl-tc"
     mkSplitUniqSupply 'a'      >>= \ tc_uniqs  -> -- typechecker
-    _scc_     "spl-ds"
+--    _scc_     "spl-ds"
     mkSplitUniqSupply 'd'      >>= \ ds_uniqs  -> -- desugarer
-    _scc_     "spl-sm"
+--    _scc_     "spl-sm"
     mkSplitUniqSupply 's'      >>= \ sm_uniqs  -> -- core-to-core simplifier
-    _scc_     "spl-c2s"
+--    _scc_     "spl-c2s"
     mkSplitUniqSupply 'c'      >>= \ c2s_uniqs -> -- core-to-stg
-    _scc_     "spl-st"
+--    _scc_     "spl-st"
     mkSplitUniqSupply 'g'      >>= \ st_uniqs  -> -- stg-to-stg passes
-    _scc_     "spl-absc"
+--    _scc_     "spl-absc"
     mkSplitUniqSupply 'f'      >>= \ fl_uniqs  -> -- absC flattener
-    _scc_     "spl-ncg"
+--    _scc_     "spl-ncg"
     mkSplitUniqSupply 'n'      >>= \ ncg_uniqs -> -- native-code generator
 
     -- ******* RENAMER
@@ -151,27 +149,22 @@ doIt (core_cmds, stg_cmds) input_pgm
     checkErrors tc_errs_bag tc_warns_bag       >>
 
     case tc_results
-    of {  (typechecked_quint@(recsel_binds, class_binds, inst_binds, val_binds, const_binds),
+    of {  (all_binds,
           local_tycons, local_classes, inst_info, pragma_tycon_specs,
           ddump_deriv) ->
 
     doDump opt_D_dump_tc "Typechecked:"
-       (pp_show (vcat [
-           ppr pprStyle recsel_binds,
-           ppr pprStyle class_binds,
-           ppr pprStyle inst_binds,
-           ppr pprStyle const_binds,
-           ppr pprStyle val_binds]))           >>
+       (pp_show (ppr pprStyle all_binds))      >>
 
     doDump opt_D_dump_deriv "Derived instances:"
        (pp_show (ddump_deriv pprStyle))        >>
 
     -- ******* DESUGARER
-    show_pass "DeSugar "                       >>
+    show_pass "DeSugar"                        >>
     _scc_     "DeSugar"
     let
        (desugared,ds_warnings)
-         = deSugar ds_uniqs mod_name typechecked_quint
+         = deSugar ds_uniqs mod_name all_binds
     in
     (if isEmptyBag ds_warnings then
        return ()
@@ -195,7 +188,7 @@ doIt (core_cmds, stg_cmds) input_pgm
                                                >>=
 
         \ (simplified,
-           SpecData _ _ _ gen_tycons all_tycon_specs _ _ _) ->
+           SpecData _ _ _ gen_data_tycons all_tycon_specs _ _ _) ->
 
     doDump opt_D_dump_simpl "Simplified:" (pp_show (vcat
        (map (pprCoreBinding pprStyle) simplified)))
@@ -237,7 +230,7 @@ doIt (core_cmds, stg_cmds) input_pgm
        abstractC      = codeGen mod_name               -- module name for CC labelling
                                 cost_centre_info
                                 imported_modules       -- import names for CC registering
-                                gen_tycons             -- type constructors generated locally
+                                gen_data_tycons        -- type constructors generated locally
                                 all_tycon_specs        -- tycon specialisations
                                 stg_binds2
 
@@ -426,7 +419,7 @@ ppSourceStats (HsModule name version exports imports fixities decls src_loc)
     sig_info (InlineSig _ _)      = (0,0,0,1)
     sig_info _                    = (0,0,0,0)
 
-    import_info (ImportDecl _ qual as spec _)
+    import_info (ImportDecl _ qual _ as spec _)
        = add6 (1, qual_info qual, as_info as, 0,0,0) (spec_info spec)
     qual_info False  = 0
     qual_info True   = 1