adapt to upstream changes

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

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 9b48cce..1ba877a 100644 (file)
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -254,11 +254,11 @@ deSugar hsc_env
         -- You might think it doesn't matter, but the simplifier brings all top-level
         -- things into the in-scope set before simplifying; so we get no unfolding for F#!
 
-       ; (final_pgm', rules_for_imps') <- if dopt Opt_F_simpleopt_before_flatten dflags
-                                            then simpleOptPgm dflags final_pgm rules_for_imps
-                                            else return (final_pgm, rules_for_imps)
+       ; (final_pgm1, rules_for_imps1, ds_vects1) <- if dopt Opt_F_simpleopt_before_flatten dflags
+                                                      then simpleOptPgm dflags final_pgm rules_for_imps vects0
+                                                      else return (final_pgm, rules_for_imps, vects0)
 
-        ; ds_binds <- if dopt Opt_F_coqpass dflags
+        ; ds_binds1 <- if dopt Opt_F_coqpass dflags
                        then do { us <- mkSplitUniqSupply '~'
                                ; let do_flatten   = dopt Opt_F_flatten dflags
                                ; let do_skolemize = dopt Opt_F_skolemize dflags
@@ -271,7 +271,7 @@ deSugar hsc_env
                                              hetmet_unflatten
                                              hetmet_flattened_id
                                              us
-                                             final_pgm'
+                                             final_pgm1
                                              hetmet_PGArrow
                                              hetmet_PGArrow_unit
                                              hetmet_PGArrow_tensor
@@ -299,22 +299,22 @@ deSugar hsc_env
                                }
                        else return final_pgm
 
-       ; (ds_binds', ds_rules_for_imps) <- if dopt Opt_F_simpleopt_before_flatten dflags
-                                            then return (ds_binds, rules_for_imps')
-                                            else simpleOptPgm dflags ds_binds rules_for_imps'
+       ; (ds_binds2, ds_rules_for_imps2, ds_vects2) <- if dopt Opt_F_simpleopt_before_flatten dflags
+                                                        then return (ds_binds1, rules_for_imps1, ds_vects1)
+                                                        else simpleOptPgm dflags ds_binds1 rules_for_imps1 ds_vects1
                         -- The simpleOptPgm gets rid of type 
                         -- bindings plus any stupid dead code
 
-        ; dumpIfSet_dyn dflags Opt_D_dump_proofs "Coq Pass Output" $ text $ coqPassCoreToString ds_binds'
+        ; dumpIfSet_dyn dflags Opt_D_dump_proofs "Coq Pass Output" $ text $ coqPassCoreToString ds_binds1
 
-        ; dumpIfSet_dyn dflags Opt_D_coqpass "After Coq Pass" (text $ showSDoc $ pprCoreBindings ds_binds')
+        ; dumpIfSet_dyn dflags Opt_D_coqpass "After Coq Pass" (text $ showSDoc $ pprCoreBindings ds_binds1)
 
-        ; (ds_binds, ds_rules_for_imps, ds_vects) 
-            <- simpleOptPgm dflags final_pgm rules_for_imps vects0
+        ; (ds_binds3, ds_rules_for_imps3, ds_vects3) 
+            <- simpleOptPgm dflags ds_binds2 ds_rules_for_imps2 ds_vects2
                          -- The simpleOptPgm gets rid of type 
                          -- bindings plus any stupid dead code
 
-        ; endPass dflags CoreDesugar ds_binds ds_rules_for_imps
+        ; endPass dflags CoreDesugar ds_binds3 ds_rules_for_imps3
 
         ; let used_names = mkUsedNames tcg_env
         ; deps <- mkDependencies tcg_env
@@ -335,12 +335,12 @@ deSugar hsc_env
                mg_fam_insts    = fam_insts,
                mg_inst_env     = inst_env,
                mg_fam_inst_env = fam_inst_env,
-               mg_rules        = ds_rules_for_imps,
-               mg_binds        = ds_binds',
+               mg_rules        = ds_rules_for_imps3,
+               mg_binds        = ds_binds3,
                mg_foreign      = ds_fords,
                mg_hpc_info     = ds_hpc_info,
                 mg_modBreaks    = modBreaks,
-                mg_vect_decls   = ds_vects,
+                mg_vect_decls   = ds_vects2,
                 mg_vect_info    = noVectInfo
               }
         ; return (msgs, Just mod_guts)