X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcExpr.lhs;h=93d3fe93caa49942e9c8f44f064828d949db97e1;hb=2f223e8f4a4e2fb22a8bb0638cd48256e9f2f0e2;hp=b101cb5ad0b6eaacfa4c7dfc5c779db2b809199c;hpb=80d071f68134bf3ad89d4de0d83807e2f0ec32c0;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index b101cb5..93d3fe9 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -457,12 +457,22 @@ field isn't part of the existential. For example, this should be ok.
   data T a where { MkT { f1::a, f2::b->b } :: T a }
   f :: T a -> b -> T b
   f t b = t { f1=b }
+
 The criterion we use is this:
 
   The types of the updated fields
   mention only the universally-quantified type variables
   of the data constructor
 
+NB: this is not (quite) the same as being a "naughty" record selector
+(See Note [Naughty record selectors]) in TcTyClsDecls), at least 
+in the case of GADTs. Consider
+   data T a where { MkT :: { f :: a } :: T [a] }
+Then f is not "naughty" because it has a well-typed record selector.
+But we don't allow updates for 'f'.  (One could consider trying to
+allow this, but it makes my head hurt.  Badly.  And no one has asked
+for it.)
+
 In principle one could go further, and allow
   g :: T a -> T a
   g t = t { f2 = \x -> x }
@@ -529,7 +539,7 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _ _) res_ty
 	      con1_flds = dataConFieldLabels con1
 	      con1_res_ty = mkFamilyTyConApp tycon (mkTyVarTys con1_tvs)
    	      
-	-- STEP 2
+	-- Step 2
 	-- Check that at least one constructor has all the named fields
 	-- i.e. has an empty set of bad fields returned by badFields
 	; checkTc (not (null relevant_cons)) (badFieldsUpd rbinds)
@@ -551,8 +561,8 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _ _) res_ty
 	-- Figure out types for the scrutinee and result
 	-- Both are of form (T a b c), with fresh type variables, but with
 	-- common variables where the scrutinee and result must have the same type
-	-- These are variables that appear in *any* arg of *any* of the relevant constructors
-        -- *except* in the updated fields
+	-- These are variables that appear in *any* arg of *any* of the
+	-- relevant constructors *except* in the updated fields
 	-- 
 	; let fixed_tvs = getFixedTyVars con1_tvs relevant_cons
 	      is_fixed_tv tv = tv `elemVarSet` fixed_tvs
@@ -601,8 +611,9 @@ tcExpr expr@(RecordUpd record_expr rbinds _ _ _) res_ty
     			    fixed_tvs = exactTyVarsOfTypes fixed_tys
 			    	    -- fixed_tys: See Note [Type of a record update]
 			    	        `unionVarSet` tyVarsOfTheta theta 
-				    -- Universally-quantified tyvars that appear in any of the 
-				    -- *implicit* arguments to the constructor are fixed
+				    -- Universally-quantified tyvars that
+				    -- appear in any of the *implicit*
+				    -- arguments to the constructor are fixed
 			    	    -- See Note [Implict type sharing]
 			    	        
 		            fixed_tys = [ty | (fld,ty) <- zip flds arg_tys
@@ -1151,18 +1162,33 @@ thBrackId orig id ps_var lie_var
 		-- so we zap it to a LiftedTypeKind monotype
 		-- C.f. the call in TcPat.newLitInst
 
-	; setLIEVar lie_var	$ do
-	{ lift <- newMethodFromName orig id_ty' DsMeta.liftName
-		   -- Put the 'lift' constraint into the right LIE
+	; lift <- if isStringTy id_ty' then
+	       	     tcLookupId DsMeta.liftStringName
+		     -- See Note [Lifting strings]
+	          else
+                     setLIEVar lie_var	$ do  -- Put the 'lift' constraint into the right LIE
+                     newMethodFromName orig id_ty' DsMeta.liftName
 	   
 		   -- Update the pending splices
 	; ps <- readMutVar ps_var
 	; writeMutVar ps_var ((idName id, nlHsApp (nlHsVar lift) (nlHsVar id)) : ps)
 
-	; return id } }
+	; return id }
 #endif /* GHCI */
 \end{code}
 
+Note [Lifting strings]
+~~~~~~~~~~~~~~~~~~~~~~
+If we see $(... [| s |] ...) where s::String, we don't want to
+generate a mass of Cons (CharL 'x') (Cons (CharL 'y') ...)) etc.
+So this conditional short-circuits the lifting mechanism to generate
+(liftString "xy") in that case.  I didn't want to use overlapping instances
+for the Lift class in TH.Syntax, because that can lead to overlapping-instance
+errors in a polymorphic situation.  
+
+If this check fails (which isn't impossible) we get another chance; see
+Note [Converting strings] in Convert.lhs 
+
 Local record selectors
 ~~~~~~~~~~~~~~~~~~~~~~
 Record selectors for TyCons in this module are ordinary local bindings,