merge GHC HEAD

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

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index a58761b..2174be3 100644 (file)
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -37,6 +37,7 @@ import TcMType
 import TcUnify
 import TcIface
 import TcType
+import TypeRep ( ecKind )
 import {- Kind parts of -} Type
 import Var
 import VarSet
@@ -44,7 +45,6 @@ import TyCon
 import Class
 import Name
 import NameSet
-import PrelNames
 import TysWiredIn
 import BasicTypes
 import SrcLoc
@@ -365,8 +365,10 @@ kc_hs_type (HsPArrTy ty) = do
     ty' <- kcLiftedType ty
     return (HsPArrTy ty', liftedTypeKind)
 
-kc_hs_type (HsNumTy n)
-   = return (HsNumTy n, liftedTypeKind)
+kc_hs_type (HsModalBoxType ecn ty) = do
+    kc_check_hs_type (HsTyVar ecn) (EK ecKind EkUnk)
+    ty' <- kcLiftedType ty
+    return (HsModalBoxType ecn ty', liftedTypeKind)
 
 kc_hs_type (HsKindSig ty k) = do
     ty' <- kc_check_lhs_type ty (EK k EkKindSig)
@@ -589,6 +591,11 @@ ds_type (HsPArrTy ty) = do
     checkWiredInTyCon parrTyCon
     return (mkPArrTy tau_ty)
 
+ds_type (HsModalBoxType ecn ty) = do
+    tau_ty <- dsHsType ty
+    checkWiredInTyCon hetMetCodeTypeTyCon
+    return (mkHetMetCodeTypeTy (mkTyVar ecn ecKind) tau_ty)
+
 ds_type (HsTupleTy boxity tys) = do
     tau_tys <- dsHsTypes tys
     checkWiredInTyCon tycon
@@ -606,11 +613,6 @@ ds_type (HsOpTy ty1 (L span op) ty2) = do
     tau_ty2 <- dsHsType ty2
     setSrcSpan span (ds_var_app op [tau_ty1,tau_ty2])
 
-ds_type (HsNumTy n)
-  = ASSERT(n==1) do
-    tc <- tcLookupTyCon genUnitTyConName
-    return (mkTyConApp tc [])
-
 ds_type ty@(HsAppTy _ _)
   = ds_app ty []