[project @ 2005-03-08 17:12:51 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcExpr.lhs b/ghc/compiler/typecheck/TcExpr.lhs
index 3d42d8d..a67d30e 100644 (file)
--- a/ghc/compiler/typecheck/TcExpr.lhs
+++ b/ghc/compiler/typecheck/TcExpr.lhs
@@ -25,8 +25,7 @@ import TcRnMonad
 import TcUnify         ( Expected(..), tcInfer, zapExpectedType, zapExpectedTo, tcSubExp, tcGen,
                          unifyFunTys, zapToListTy, zapToTyConApp )
 import BasicTypes      ( isMarkedStrict )
-import Inst            ( InstOrigin(..), 
-                         newOverloadedLit, newMethodFromName, newIPDict,
+import Inst            ( newOverloadedLit, newMethodFromName, newIPDict,
                          newDicts, newMethodWithGivenTy, tcInstStupidTheta, tcInstCall )
 import TcBinds         ( tcBindsAndThen )
 import TcEnv           ( tcLookup, tcLookupId, checkProcLevel,
@@ -50,6 +49,7 @@ import Name           ( Name )
 import TyCon           ( TyCon, FieldLabel, tyConTyVars, tyConStupidTheta, 
                          tyConDataCons, tyConFields )
 import Type            ( zipTopTvSubst, substTheta, substTy )
+import Var             ( tyVarKind )
 import VarSet          ( emptyVarSet, elemVarSet )
 import TysWiredIn      ( boolTy, parrTyCon, tupleTyCon )
 import PrelNames       ( enumFromName, enumFromThenName, 
@@ -459,11 +459,11 @@ tc_expr expr@(RecordUpd record_expr rbinds) res_ty
        non_upd_field_lbls  = concat relevant_field_lbls_s `minusList` upd_field_lbls
        common_tyvars       = tyVarsOfTypes [ty | (fld,ty,_) <- tyConFields tycon,
                                                  fld `elem` non_upd_field_lbls]
+       is_common_tv tv = tv `elemVarSet` common_tyvars
 
-       mk_inst_ty tyvar result_inst_ty 
-         | tyvar `elemVarSet` common_tyvars = returnM result_inst_ty   -- Same as result type
--- gaw 2004 FIX?
-         | otherwise                        = newTyFlexiVarTy liftedTypeKind   -- Fresh type
+       mk_inst_ty tv result_inst_ty 
+         | is_common_tv tv = returnM result_inst_ty            -- Same as result type
+         | otherwise       = newTyFlexiVarTy (tyVarKind tv)    -- Fresh type, of correct kind
     in
     zipWithM mk_inst_ty tycon_tyvars result_inst_tys   `thenM` \ inst_tys ->
 
@@ -776,7 +776,8 @@ tcId id_name        -- Look up the Id and instantiate its type
          -> do { checkProcLevel id proc_level
                ; tc_local_id id th_level }
 
-    ;  other -> pprPanic "tcId" (ppr id_name $$ ppr thing)
+       -- THis 
+    ;  other -> failWithTc (ppr other <+> ptext SLIT("used where a value identifer was expected"))
     }
   where