Template Haskell: allow type splices

[ghc-hetmet.git] / compiler / typecheck / TcExpr.lhs

diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index b101cb5..784d466 100644 (file)
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -551,8 +551,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 +601,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 +1152,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,