From: sewardj <unknown>
Date: Tue, 24 Oct 2000 16:33:02 +0000 (+0000)
Subject: [project @ 2000-10-24 16:33:02 by sewardj]
X-Git-Tag: Approximately_9120_patches~3515
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=ae54717718aefc3a9f246bb09c0bab66a8062a63;p=ghc-hetmet.git

[project @ 2000-10-24 16:33:02 by sewardj]
More bitz n pieces.
---

diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 4cdf005..1f59315 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -115,31 +115,93 @@ hscRecomp dflags core_cmds stg_cmds summary hit hst pcs maybe_old_iface
       let tc_pcs = tc_pcs tc_result
       let tc_env = tc_env tc_result
       let tc_binds = tc_binds tc_result
+      let local_tycons = tc_tycons tc_result
+      let local_classes = tc_classes tc_result
 
       -- desugar, simplify and tidy, to create the unfoldings
       -- why is this IO-typed?
-      (core_binds, orphan_rules) 
-         <- dsThenSimplThenTidy dflags mod tc_binds rule_base
+      (tidy_binds, orphan_rules, fe_binders, h_code, c_code)   -- return modDetails?
+         <- dsThenSimplThenTidy dflags mod tc_result rule_base ds_uniqs
 
       -- convert to Stg; needed for binders
-      let (stg_binds, top_level_ids) = myCoreToStg core_binds
-      					-- myCoreToStg does occurAnalyseBinds, 
-					-- `seq`, topCoreBindsToStg
+      (stg_binds, cost_centre_info, top_level_ids) 
+         <- myCoreToStg c2s_uniqs st_uniqs this_mod tidy_binds
 
       -- cook up a new ModDetails now we (finally) have all the bits
-      let new_details = completeModDetails tc_env core_binds top_level_ids orphan_rules
+      let new_details = completeModDetails tc_env tidy_binds top_level_ids orphan_rules
 
       -- and possibly create a new ModIface
       let maybe_final_iface = completeIface maybe_old_iface new_iface new_details 
 
       -- do the rest of code generation/emission
-      (unlinkeds, stub_h_filename, stub_c_filename) <- restOfCodeGeneration stg_binds
+      -- this is obviously nonsensical: FIX
+      (unlinkeds, stub_h_filename, stub_c_filename) 
+         <- restOfCodeGeneration this_mod imported_modules cost_centre_info 
+                                 fe_binders local_tycons local_classes stg_binds
 
       -- and the answer is ...
       return (HscOK new_details maybe_final_iface stub_h_filename stub_c_filename
                     unlinkeds tc_pcs (unionBags rn_warns tc_warns))
 
 
+restOfCodeGeneration this_mod imported_modules cost_centre_info 
+                     fe_binders local_tycons local_classes stg_binds
+ = do --------------------------  Code generation -------------------------------
+      show_pass "CodeGen"
+      -- _scc_     "CodeGen"
+      abstractC <- codeGen this_mod imported_modules
+                           cost_centre_info fe_binders
+                           local_tycons local_classes stg_binds
+
+      --------------------------  Code output -------------------------------
+      show_pass "CodeOutput"
+      -- _scc_     "CodeOutput"
+      (maybe_stub_h_name, maybe_stub_c_name)
+         <- codeOutput this_mod local_tycons local_classes
+                       occ_anal_tidy_binds stg_binds2
+                       c_code h_code abstractC ncg_uniqs
+
+      -- this is obviously nonsensical: FIX
+      return (maybe_stub_h_name, maybe_stub_c_name, [])
+
+
+dsThenSimplThenTidy dflags mod tc_result rule_base ds_uniqs
+ = do --------------------------  Desugaring ----------------
+      -- _scc_     "DeSugar"
+      (desugared, rules, h_code, c_code, fe_binders) 
+         <- deSugar this_mod ds_uniqs tc_results
+
+      --------------------------  Main Core-language transformations ----------------
+      -- _scc_     "Core2Core"
+      (simplified, orphan_rules)  <- core2core core_cmds desugared rules
+
+      -- Do the final tidy-up
+      (tidy_binds, tidy_orphan_rules) 
+         <- tidyCorePgm this_mod simplified orphan_rules
+      
+      return (tidy_binds, tidy_orphan_rules, fe_binders, h_code, c_code)
+
+
+
+myCoreToStg c2s_uniqs st_uniqs this_mod tidy_binds
+ = do let occ_anal_tidy_binds = occurAnalyseBinds tidy_binds
+
+      () <- coreBindsSize occ_anal_tidy_binds `seq` return ()
+      -- TEMP: the above call zaps some space usage allocated by the
+      -- simplifier, which for reasons I don't understand, persists
+      -- thoroughout code generation
+
+      show_pass "Core2Stg"
+      -- _scc_     "Core2Stg"
+      let stg_binds   = topCoreBindsToStg c2s_uniqs occ_anal_tidy_binds
+
+      show_pass "Stg2Stg"
+      -- _scc_     "Stg2Stg"
+      (stg_binds2, cost_centre_info) <- stg2stg stg_cmds this_mod st_uniqs stg_binds
+      let final_ids = collectFinalStgBinders (map fst stg_binds2)
+
+      return (stg_binds2, cost_centre_info, final_ids)
+
 #if 0
 -- BEGIN old stuff
 	--------------------------  Reader  ----------------