X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDesugar.lhs;fp=compiler%2FdeSugar%2FDesugar.lhs;h=1ba877ae1cf821b2161bbbcc79225cb1a493e3a9;hp=9b48cceed13f2ae7e293204ec377307b972b431c;hb=da9d10064c084fed395e6030b1cb82bee2b140ed;hpb=7e95df790b34e11d7308e43dab0a7175b69b70fc

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index 9b48cce..1ba877a 100644
--- 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)