update compiler using *->*->* as the kind of environment classifiers
authorAdam Megacz <megacz@cs.berkeley.edu>
Mon, 9 May 2011 06:31:17 +0000 (23:31 -0700)
committerAdam Megacz <megacz@cs.berkeley.edu>
Mon, 9 May 2011 06:31:17 +0000 (23:31 -0700)
compiler/hetmet
compiler/prelude/TysPrim.lhs
compiler/prelude/TysWiredIn.lhs
compiler/typecheck/TcExpr.lhs
compiler/types/TypeRep.lhs
libraries/base

index cb42497..4ad68fe 160000 (submodule)
@@ -1 +1 @@
-Subproject commit cb424978e057bc2b4868517302738d52246fba04
+Subproject commit 4ad68fe2894b35c21f2feb7b176d2b0f146ff6d3
index ac3a528..a5d9335 100644 (file)
@@ -10,7 +10,7 @@
 --   They are all, therefore, wired-in TyCons.  C.f module TysWiredIn
 module TysPrim(
        alphaTyVars, betaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
-       alphaTy, betaTy, gammaTy, deltaTy,
+       alphaTy, betaTy, gammaTy, deltaTy, ecTyVars,
        openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar, openAlphaTyVars,
         argAlphaTy, argAlphaTyVar, argBetaTy, argBetaTyVar,
 
@@ -58,6 +58,7 @@ import OccName                ( mkTcOcc )
 import OccName         ( mkTyVarOccFS, mkTcOccFS )
 import TyCon           ( TyCon, mkPrimTyCon, mkLiftedPrimTyCon, mkAnyTyCon )
 import Type
+import TypeRep          ( ecKind )
 import Coercion
 import SrcLoc
 import Unique          ( mkAlphaTyVarUnique )
@@ -158,6 +159,9 @@ tyVarList kind = [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
                            where c = chr (u-2 + ord 'a')
                 ]
 
+ecTyVars :: [TyVar]
+ecTyVars = tyVarList ecKind
+
 alphaTyVars :: [TyVar]
 alphaTyVars = tyVarList liftedTypeKind
 
index 29fa628..2f1b637 100644 (file)
@@ -633,9 +633,11 @@ Heterogeneous Metaprogramming
 mkHetMetCodeTypeTy    :: TyVar -> Type -> Type
 mkHetMetCodeTypeTy ecn ty = mkTyConApp hetMetCodeTypeTyCon [(mkTyVarTy ecn), ty]
 
+ecTyVar = head ecTyVars
+
 -- | Represents the type constructor of box types
 hetMetCodeTypeTyCon :: TyCon
-hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [alphaTyVar, betaTyVar] [hetMetCodeTypeDataCon]
+hetMetCodeTypeTyCon  = pcNonRecDataTyCon hetMetCodeTypeTyConName [ecTyVar, betaTyVar] [hetMetCodeTypeDataCon]
 
 -- | Check whether a type constructor is the constructor for box types
 isHetMetCodeTypeTyCon    :: TyCon -> Bool
index 976aca7..7d7c461 100644 (file)
@@ -167,7 +167,7 @@ tcExpr (HsVar name)  res_ty = tcCheckId name res_ty
 
 tcExpr (HsHetMetBrak _ e) res_ty =
     do { (coi, [inferred_name,elt_ty]) <- matchExpectedTyConApp hetMetCodeTypeTyCon res_ty
-       ; fresh_ec_name <- newFlexiTyVar liftedTypeKind
+       ; fresh_ec_name <- newFlexiTyVar ecKind
        ; expr' <-  updHetMetLevel (\old_lev -> (fresh_ec_name:old_lev))
                    $ tcPolyExpr e elt_ty
        ; unifyType (TyVarTy fresh_ec_name) inferred_name
index 1be55d7..a7cfd5a 100644 (file)
@@ -25,7 +25,7 @@ module TypeRep (
 
        -- Kinds
        liftedTypeKind, unliftedTypeKind, openTypeKind,
-        argTypeKind, ubxTupleKind,
+        argTypeKind, ubxTupleKind, ecKind,
        isLiftedTypeKindCon, isLiftedTypeKind,
        mkArrowKind, mkArrowKinds, isCoercionKind,
        coVarPred,
@@ -343,13 +343,16 @@ kindTyConType :: TyCon -> Type
 kindTyConType kind = TyConApp kind []
 
 -- | See "Type#kind_subtyping" for details of the distinction between these 'Kind's
-liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind :: Kind
+liftedTypeKind, unliftedTypeKind, openTypeKind, argTypeKind, ubxTupleKind, ecKind :: Kind
 
 liftedTypeKind   = kindTyConType liftedTypeKindTyCon
 unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
 openTypeKind     = kindTyConType openTypeKindTyCon
 argTypeKind      = kindTyConType argTypeKindTyCon
 ubxTupleKind    = kindTyConType ubxTupleKindTyCon
+ecKind           = liftedTypeKind `mkArrowKind` (liftedTypeKind `mkArrowKind` liftedTypeKind)
+-- NOTE: if you change ecKind, you must also change the explicit kind signatures
+-- on hetmet_{brak,esc,csp} in GHC.Hetmet.CodeTypes
 
 -- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@
 mkArrowKind :: Kind -> Kind -> Kind
index e1f4f45..5fb5033 160000 (submodule)
@@ -1 +1 @@
-Subproject commit e1f4f4560778857133cd778b5bc66c1074add312
+Subproject commit 5fb503378b4f2110ef044404092fdf21be48117e