[project @ 2004-08-13 13:04:50 by simonmar]

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

diff --git a/ghc/compiler/typecheck/TcHsSyn.lhs b/ghc/compiler/typecheck/TcHsSyn.lhs
index 8968e49..0670a0c 100644 (file)
--- a/ghc/compiler/typecheck/TcHsSyn.lhs
+++ b/ghc/compiler/typecheck/TcHsSyn.lhs
@@ -37,8 +37,8 @@ import Id     ( idType, setIdType, Id )
 
 import TcRnMonad
 import Type      ( Type )
-import TcType    ( TcType, TcTyVar, eqKind, isTypeKind, mkTyVarTy,
-                   tcGetTyVar, isAnyTypeKind, mkTyConApp )
+import TcType    ( TcType, TcTyVar, mkTyVarTy, tcGetTyVar, mkTyConApp )
+import Kind      ( isLiftedTypeKind, liftedTypeKind, isSubKind )
 import qualified  Type
 import TcMType   ( zonkTcTyVarToTyVar, zonkType, zonkTcType, zonkTcTyVars,
                    putTcTyVar )
@@ -48,8 +48,8 @@ import TysPrim          ( charPrimTy, intPrimTy, floatPrimTy,
 import TysWiredIn ( charTy, stringTy, intTy, 
                    mkListTy, mkPArrTy, mkTupleTy, unitTy,
                    voidTy, listTyCon, tupleTyCon )
-import TyCon     ( mkPrimTyCon, tyConKind )
-import PrimRep   ( PrimRep(VoidRep) )
+import TyCon     ( mkPrimTyCon, tyConKind, PrimRep(..) )
+import Kind      ( splitKindFunTys )
 import Name      ( getOccName, mkInternalName, mkDerivedTyConOcc )
 import Var       ( Var, isId, isLocalVar, tyVarKind )
 import VarSet
@@ -407,8 +407,8 @@ zonkExpr env (HsBracketOut body bs)
     zonk_b (n,e) = zonkLExpr env e     `thenM` \ e' ->
                   returnM (n,e')
 
-zonkExpr env (HsSplice n e) = WARN( True, ppr e )      -- Should not happen
-                             returnM (HsSplice n e)
+zonkExpr env (HsSpliceE s) = WARN( True, ppr s )       -- Should not happen
+                            returnM (HsSpliceE s)
 
 zonkExpr env (OpApp e1 op fixity e2)
   = zonkLExpr env e1   `thenM` \ new_e1 ->
@@ -565,7 +565,7 @@ zonkReboundNames :: ZonkEnv -> ReboundNames Id -> TcM (ReboundNames Id)
 zonkReboundNames env prs 
   = mapM zonk prs
   where
-    zonk (n, e) = zonkLExpr env e `thenM` \ new_e ->
+    zonk (n, e) = zonkExpr env e `thenM` \ new_e ->
                  returnM (n, new_e)
 
 
@@ -914,16 +914,16 @@ mkArbitraryType :: TcTyVar -> Type
 -- Make up an arbitrary type whose kind is the same as the tyvar.
 -- We'll use this to instantiate the (unbound) tyvar.
 mkArbitraryType tv 
-  | isAnyTypeKind kind = voidTy                -- The vastly common case
-  | otherwise         = mkTyConApp tycon []
+  | liftedTypeKind `isSubKind` kind = voidTy           -- The vastly common case
+  | otherwise                      = mkTyConApp tycon []
   where
     kind       = tyVarKind tv
-    (args,res) = Type.splitFunTys kind -- Kinds are simple; use Type.splitFunTys
+    (args,res) = splitKindFunTys kind
 
-    tycon | kind `eqKind` tyConKind listTyCon  -- *->*
+    tycon | kind == tyConKind listTyCon        -- *->*
          = listTyCon                           -- No tuples this size
 
-         | all isTypeKind args && isTypeKind res
+         | all isLiftedTypeKind args && isLiftedTypeKind res
          = tupleTyCon Boxed (length args)      -- *-> ... ->*->*
 
          | otherwise