X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FdeSugar%2FDesugar.lhs;h=b45b8c53dcb8932a7492e272725eb90937b54ff9;hb=cae34044d89a87bd3da83b0e867b4a5d6994079a;hp=a870cd433cbe903e9bb2ff4b05dc2d68785d0a9b;hpb=495ef8bd9ef30bffe50ea399b91e3ba09646b59a;p=ghc-hetmet.git

diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index a870cd4..b45b8c5 100644
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -10,29 +10,26 @@ module Desugar ( deSugar ) where
 
 import CmdLineOpts	( opt_D_dump_ds )
 import HsSyn		( MonoBinds, RuleDecl(..), RuleBndr(..), HsExpr(..), HsBinds(..), MonoBinds(..) )
-import TcHsSyn		( TypecheckedMonoBinds, TypecheckedForeignDecl, TypecheckedRuleDecl )
+import TcHsSyn		( TypecheckedRuleDecl )
 import TcModule		( TcResults(..) )
 import CoreSyn
 import Rules		( ProtoCoreRule(..), pprProtoCoreRule )
-import Subst		( substExpr, mkSubst )
+import Subst		( substExpr, mkSubst, mkInScopeSet )
 import DsMonad
 import DsExpr		( dsExpr )
 import DsBinds		( dsMonoBinds, AutoScc(..) )
 import DsForeign	( dsForeigns )
-import DsUtils
 import DsExpr		()	-- Forces DsExpr to be compiled; DsBinds only
 				-- depends on DsExpr.hi-boot.
-import Module		( Module, moduleString )
-import Id		( Id )
-import Name		( isLocallyDefined )
+import Module		( Module )
 import VarEnv
 import VarSet
-import Bag		( isEmptyBag, unionBags )
+import Bag		( isEmptyBag )
 import CmdLineOpts	( opt_SccProfilingOn )
 import CoreLint		( beginPass, endPass )
 import ErrUtils		( doIfSet, pprBagOfWarnings )
 import Outputable
-import UniqSupply	( splitUniqSupply, UniqSupply )
+import UniqSupply	( UniqSupply )
 \end{code}
 
 %************************************************************************
@@ -75,10 +72,15 @@ deSugar mod_name us (TcResults {tc_env = global_val_env,
 
 dsProgram mod_name all_binds rules fo_decls
   = dsMonoBinds auto_scc all_binds []	`thenDs` \ core_prs ->
-    dsForeigns mod_name fo_decls	`thenDs` \ (fi_binds, fe_binds, h_code, c_code) ->
+    dsForeigns mod_name fo_decls	`thenDs` \ (fe_binders, foreign_binds, h_code, c_code) ->
     let
-	ds_binds      = fi_binds ++ [Rec core_prs] ++ fe_binds
-	fe_binders    = bindersOfBinds fe_binds
+	ds_binds      = [Rec (foreign_binds ++ core_prs)]
+	-- Notice that we put the whole lot in a big Rec, even the foreign binds
+	-- When compiling PrelFloat, which defines data Float = F# Float#
+	-- we want F# to be in scope in the foreign marshalling code!
+	-- 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#!
+
 	local_binders = mkVarSet (bindersOfBinds ds_binds)
     in
     mapDs (dsRule local_binders) rules	`thenDs` \ rules' ->
@@ -113,7 +115,7 @@ dsRule in_scope (HsRule name sig_tvs vars lhs rhs loc)
 			    (Rule name tpl_vars args core_rhs))
   where
     tpl_vars = sig_tvs ++ [var | RuleBndr var <- vars]
-    all_vars = in_scope `unionVarSet` mkVarSet tpl_vars
+    all_vars = mkInScopeSet (in_scope `unionVarSet` mkVarSet tpl_vars)
 
 ds_lhs all_vars lhs
   = let