add support for flattening recursive-let

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

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index c8f6390..2e51823 100644 (file)
--- a/compiler/deSugar/Desugar.lhs
+++ b/compiler/deSugar/Desugar.lhs
@@ -123,6 +123,8 @@ deSugar hsc_env
                                     , undefined
                                     , undefined
                                     , undefined
+                                    , undefined
+                                    , undefined
                                ))
                    _        -> do
                      (binds_cvr,ds_hpc_info, modBreaks)
@@ -165,6 +167,8 @@ deSugar hsc_env
                           ; hetmet_pga_applyr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_applyr_name else return undefined
                           ; hetmet_pga_curryl <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_curryl_name else return undefined
                           ; hetmet_pga_curryr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_curryr_name else return undefined
+                          ; hetmet_pga_loopl <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_loopl_name else return undefined
+                          ; hetmet_pga_loopr <- if dopt Opt_F_coqpass dflags then dsLookupGlobalId hetmet_pga_loopr_name else return undefined
                           ; let hpc_init
                                   | opt_Hpc   = hpcInitCode mod ds_hpc_info
                                   | otherwise = empty
@@ -197,6 +201,8 @@ deSugar hsc_env
                                    , hetmet_pga_applyr
                                    , hetmet_pga_curryl
                                    , hetmet_pga_curryr
+                                   , hetmet_pga_loopl
+                                   , hetmet_pga_loopr
                                    ) }
 
         ; case mb_res of {
@@ -226,7 +232,10 @@ deSugar hsc_env
                                    , hetmet_pga_applyl
                                    , hetmet_pga_applyr
                                    , hetmet_pga_curryl
-                                   , hetmet_pga_curryr) -> do
+                                   , hetmet_pga_curryr
+                                   , hetmet_pga_loopl
+                                   , hetmet_pga_loopr
+                                   ) -> do
 
        {       -- Add export flags to bindings
          keep_alive <- readIORef keep_var
@@ -288,7 +297,10 @@ deSugar hsc_env
                                              hetmet_pga_applyl
                                              hetmet_pga_applyr
                                              hetmet_pga_curryl
-                                             hetmet_pga_curryr)
+                                             hetmet_pga_curryr
+                                             hetmet_pga_loopl
+                                             hetmet_pga_loopr
+                                        )
                                }
                        else return final_pgm