From: Adam Megacz <megacz@cs.berkeley.edu>
Date: Thu, 2 Jun 2011 02:06:16 +0000 (-0700)
Subject: add support for flattening recursive-let
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=afdc0885532e8fb28840e8b78b02056c64fbaf77

add support for flattening recursive-let
---

diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs
index c8f6390..2e51823 100644
--- 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
 
diff --git a/compiler/hetmet b/compiler/hetmet
index 0f137f4..3282a2b 160000
--- a/compiler/hetmet
+++ b/compiler/hetmet
@@ -1 +1 @@
-Subproject commit 0f137f4fbe7076b7a0f6b33d661b4f7aa8b4f160
+Subproject commit 3282a2b78028238987a5a49e59d8e8d495aea0e1
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 4bbb479..f84f0a4 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -238,6 +238,8 @@ basicKnownKeyNames
         hetmet_pga_applyr_name,
         hetmet_pga_curryl_name,
         hetmet_pga_curryr_name,
+        hetmet_pga_loopl_name,
+        hetmet_pga_loopr_name,
 
         -- Annotation type checking
         toAnnotationWrapperName
@@ -971,6 +973,10 @@ hetmet_pga_curryl_name :: Name
 hetmet_pga_curryl_name = varQual gHC_HETMET_PRIVATE (fsLit "pga_curryl") hetmet_pga_curryl_key
 hetmet_pga_curryr_name :: Name
 hetmet_pga_curryr_name = varQual gHC_HETMET_PRIVATE (fsLit "pga_curryr") hetmet_pga_curryr_key
+hetmet_pga_loopl_name :: Name
+hetmet_pga_loopl_name = varQual gHC_HETMET_PRIVATE (fsLit "pga_loopl") hetmet_pga_loopl_key
+hetmet_pga_loopr_name :: Name
+hetmet_pga_loopr_name = varQual gHC_HETMET_PRIVATE (fsLit "pga_loopr") hetmet_pga_loopr_key
 
 -- IO things
 ioTyConName, ioDataConName, thenIOName, bindIOName, returnIOName,
@@ -1643,6 +1649,11 @@ hetmet_brak_key    = mkPreludeMiscIdUnique 161
 hetmet_esc_key     = mkPreludeMiscIdUnique 162
 hetmet_csp_key     = mkPreludeMiscIdUnique 163
 
+hetmet_pga_loopl_key :: Unique
+hetmet_pga_loopl_key = mkPreludeMiscIdUnique 164
+hetmet_pga_loopr_key :: Unique
+hetmet_pga_loopr_key = mkPreludeMiscIdUnique 165
+
 
 ---------------- Template Haskell -------------------
 --	USES IdUniques 200-499
diff --git a/libraries/base b/libraries/base
index a166b10..9404945 160000
--- a/libraries/base
+++ b/libraries/base
@@ -1 +1 @@
-Subproject commit a166b102f16b45e2116f84f01fed840b981d3d40
+Subproject commit 9404945188d8f4e4daf851c0bc53a61c80b8fdfc