[project @ 2001-03-08 12:07:38 by simonpj]

[ghc-hetmet.git] / ghc / compiler / deSugar / Desugar.lhs

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index fb21765..0765a94 100644 (file)
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -25,12 +25,12 @@ import DsExpr               ()      -- Forces DsExpr to be compiled; DsBinds only
                                -- depends on DsExpr.hi-boot.
 import Module          ( Module )
 import Id              ( Id )
-import Name            ( lookupNameEnv )
+import NameEnv         ( lookupNameEnv )
 import VarEnv
 import VarSet
 import Bag             ( isEmptyBag )
 import CoreLint                ( showPass, endPass )
-import ErrUtils                ( doIfSet, pprBagOfWarnings )
+import ErrUtils                ( doIfSet, dumpIfSet_dyn, pprBagOfWarnings )
 import Outputable
 import UniqSupply      ( mkSplitUniqSupply )
 import HscTypes                ( HomeSymbolTable, PersistentCompilerState(..), TyThing(..), lookupType,  )
@@ -50,7 +50,7 @@ deSugar :: DynFlags
        -> PersistentCompilerState -> HomeSymbolTable
        -> Module -> PrintUnqualified
         -> TcResults
-       -> IO ([CoreBind], [(Id,CoreRule)], SDoc, SDoc, [CoreBndr])
+       -> IO ([CoreBind], [(Id,CoreRule)], (SDoc, SDoc, [CoreBndr]))
 
 deSugar dflags pcs hst mod_name unqual
         (TcResults {tc_env   = local_type_env,
@@ -63,18 +63,18 @@ deSugar dflags pcs hst mod_name unqual
        -- Do desugaring
        ; let (result, ds_warns) = initDs dflags us lookup mod_name
                                          (dsProgram mod_name all_binds rules fo_decls)    
-             (ds_binds, ds_rules, _, _, _) = result
+             (ds_binds, ds_rules, _) = result
 
        -- Display any warnings
         ; doIfSet (not (isEmptyBag ds_warns))
                  (printErrs unqual (pprBagOfWarnings ds_warns))
 
        -- Lint result if necessary
-        ; let do_dump_ds = dopt Opt_D_dump_ds dflags
-        ; endPass dflags "Desugar" do_dump_ds ds_binds
+        ; endPass dflags "Desugar" Opt_D_dump_ds ds_binds
 
        -- Dump output
-       ; doIfSet do_dump_ds (printDump (ppr_ds_rules ds_rules))
+       ; doIfSet (dopt Opt_D_dump_ds dflags) 
+               (printDump (ppr_ds_rules ds_rules))
 
         ; return result
        }
@@ -110,8 +110,7 @@ deSugarExpr dflags pcs hst mod_name unqual tc_expr
                  (printErrs unqual (pprBagOfWarnings ds_warns))
 
        -- Dump output
-        ; let do_dump_ds = dopt Opt_D_dump_ds dflags
-       ; doIfSet do_dump_ds (printDump (pprCoreExpr core_expr))
+       ; dumpIfSet_dyn dflags Opt_D_dump_ds "Desugared" (pprCoreExpr core_expr)
 
         ; return core_expr
        }
@@ -135,7 +134,7 @@ dsProgram mod_name all_binds rules fo_decls
        local_binders = mkVarSet (bindersOfBinds ds_binds)
     in
     mapDs (dsRule local_binders) rules `thenDs` \ rules' ->
-    returnDs (ds_binds, rules', h_code, c_code, fe_binders)
+    returnDs (ds_binds, rules', (h_code, c_code, fe_binders))
   where
     auto_scc | opt_SccProfilingOn = TopLevel
             | otherwise          = NoSccs