From: simonpj@microsoft.com <unknown>
Date: Wed, 27 Aug 2008 15:27:28 +0000 (+0000)
Subject: Fix Trac #2520: duplicate symbols
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=a1a96ab952241f1ffbe3e3246bc2fb1715bbcf3b

Fix Trac #2520: duplicate symbols

The problem here was that were were quantifying over an *External* Name,
which causes no end of confusion.  See Note [Const rule dicts] in DsBinds.

The fix is very easy, I'm happy to say.
---

diff --git a/compiler/deSugar/DsBinds.lhs b/compiler/deSugar/DsBinds.lhs
index b1b77d0..3df57d7 100644
--- a/compiler/deSugar/DsBinds.lhs
+++ b/compiler/deSugar/DsBinds.lhs
@@ -30,12 +30,13 @@ import MkCore
 import CoreUtils
 import CoreFVs
 
-import TcHsSyn		( mkArbitraryType )	-- Mis-placed?
+import TcHsSyn	( mkArbitraryType )	-- Mis-placed?
 import TcType
 import OccurAnal
 import CostCentre
 import Module
 import Id
+import Name	( localiseName )
 import Var	( TyVar )
 import VarSet
 import Rules
@@ -333,6 +334,9 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 	; spec_name <- newLocalName poly_name
 	; ds_spec_expr  <- dsExpr spec_expr
 	; let (bndrs, body) = collectBinders (occurAnalyseExpr ds_spec_expr)
+	      -- ds_spec_expr may look like
+	      --     /\a. f a Int dOrdInt
+	      -- or  /\a.\d:Ord a. let { dl::Ord [a] = dOrdList a d } in f [a] dl
 		-- The occurrence-analysis does two things
 		-- (a) identifies unused binders: Note [Unused spec binders]
 		-- (b) sorts dict bindings into NonRecs 
@@ -358,7 +362,9 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
 		  spec_rhs    = Let (NonRec local_poly poly_f_body) ds_spec_expr
 		  poly_f_body = mkLams (tvs ++ dicts) f_body
 			   	
-		  extra_dict_bndrs = filter isDictId (varSetElems (exprFreeVars ds_spec_expr))
+		  extra_dict_bndrs = [localise d 
+		  		     | d <- varSetElems (exprFreeVars ds_spec_expr)
+		  		     , isDictId d]
 			-- Note [Const rule dicts]
 
 		  rule =  mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))
@@ -385,6 +391,9 @@ dsSpec all_tvs dicts tvs poly_id mono_id mono_bind
     decomp_msg = hang (ptext (sLit "Specialisation too complicated to desugar; ignored"))
 		    2 (ppr spec_expr)
 
+    localise d = mkLocalId (localiseName (idName d)) (idType d)
+    	     -- See Note [Constant rule dicts]
+
 mkArbitraryTypeEnv :: [TyVar] -> [([TyVar], a, b, c)] -> DsM (TyVarEnv Type)
 -- If any of the tyvars is missing from any of the lists in 
 -- the second arg, return a binding in the result
@@ -442,6 +451,9 @@ And from that we want the rule
 	RULE forall dInt. f Int dInt = f_spec
 	f_spec = let f = <rhs> in f Int dInt
 
+But be careful!  That dInt might be GHC.Base.$fOrdInt, which is an External
+Name, and you can't bind them in a lambda or forall without getting things
+confused. Hence the use of 'localise' to make it Internal.
 
 
 %************************************************************************