Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/8c3bc838c508600a5abe7ab8975ab630ca4a4faf >--------------------------------------------------------------- commit 8c3bc838c508600a5abe7ab8975ab630ca4a4faf Author: Iavor S. Diatchki <[email protected]> Date: Thu Dec 29 17:49:53 2011 -0800 Add the wired-in names for manipulating type-level nats. >--------------------------------------------------------------- compiler/prelude/PrelNames.lhs | 35 ++++++++++++++++++++++++++++++++++- compiler/prelude/TysPrim.lhs | 3 +-- 2 files changed, 35 insertions(+), 3 deletions(-) diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs index f95b21d..c8a3a2f 100644 --- a/compiler/prelude/PrelNames.lhs +++ b/compiler/prelude/PrelNames.lhs @@ -269,6 +269,14 @@ basicKnownKeyNames -- Other classes randomClassName, randomGenClassName, monadPlusClassName, + -- Type-level naturals + typeNatKindConName, + typeNatClassName, + typeNatLeqClassName, + typeNatAddTyFamName, + typeNatMulTyFamName, + typeNatExpTyFamName, + -- Annotation type checking toAnnotationWrapperName @@ -329,7 +337,7 @@ gHC_PRIM, gHC_TYPES, gHC_GENERICS, gHC_FLOAT, gHC_TOP_HANDLER, sYSTEM_IO, dYNAMIC, tYPEABLE, tYPEABLE_INTERNAL, gENERICS, dOTNET, rEAD_PREC, lEX, gHC_INT, gHC_WORD, mONAD, mONAD_FIX, mONAD_ZIP, aRROW, cONTROL_APPLICATIVE, gHC_DESUGAR, rANDOM, gHC_EXTS, - cONTROL_EXCEPTION_BASE :: Module + cONTROL_EXCEPTION_BASE, gHC_TYPENATS :: Module gHC_PRIM = mkPrimModule (fsLit "GHC.Prim") -- Primitive types and values gHC_TYPES = mkPrimModule (fsLit "GHC.Types") @@ -381,6 +389,7 @@ gHC_DESUGAR = mkBaseModule (fsLit "GHC.Desugar") rANDOM = mkBaseModule (fsLit "System.Random") gHC_EXTS = mkBaseModule (fsLit "GHC.Exts") cONTROL_EXCEPTION_BASE = mkBaseModule (fsLit "Control.Exception.Base") +gHC_TYPENATS = mkBaseModule (fsLit "GHC.TypeNats") gHC_PARR' :: Module gHC_PARR' = mkBaseModule (fsLit "GHC.PArr") @@ -1023,6 +1032,17 @@ randomClassName = clsQual rANDOM (fsLit "Random") randomClassKey randomGenClassName = clsQual rANDOM (fsLit "RandomGen") randomGenClassKey isStringClassName = clsQual dATA_STRING (fsLit "IsString") isStringClassKey +-- Type-level naturals +typeNatKindConName, + typeNatClassName, typeNatLeqClassName, + typeNatAddTyFamName, typeNatMulTyFamName, typeNatExpTyFamName :: Name +typeNatKindConName = tcQual gHC_TYPENATS (fsLit "Nat") typeNatKindConNameKey +typeNatClassName = clsQual gHC_TYPENATS (fsLit "NatI") typeNatClassNameKey +typeNatLeqClassName = clsQual gHC_TYPENATS (fsLit ":<=") typeNatLeqClassNameKey +typeNatAddTyFamName = tcQual gHC_TYPENATS (fsLit ":+") typeNatAddTyFamNameKey +typeNatMulTyFamName = tcQual gHC_TYPENATS (fsLit ":*") typeNatMulTyFamNameKey +typeNatExpTyFamName = tcQual gHC_TYPENATS (fsLit ":^") typeNatExpTyFamNameKey + -- dotnet interop objectTyConName :: Name objectTyConName = tcQual dOTNET (fsLit "Object") objectTyConKey @@ -1136,6 +1156,10 @@ gen1ClassKey = mkPreludeClassUnique 38 datatypeClassKey = mkPreludeClassUnique 39 constructorClassKey = mkPreludeClassUnique 40 selectorClassKey = mkPreludeClassUnique 41 + +typeNatClassNameKey, typeNatLeqClassNameKey :: Unique +typeNatClassNameKey = mkPreludeClassUnique 42 +typeNatLeqClassNameKey = mkPreludeClassUnique 43 \end{code} %************************************************************************ @@ -1318,6 +1342,15 @@ noSelTyConKey = mkPreludeTyConUnique 154 repTyConKey = mkPreludeTyConUnique 155 rep1TyConKey = mkPreludeTyConUnique 156 +-- Type-level naturals +typeNatKindConNameKey, + typeNatAddTyFamNameKey, typeNatMulTyFamNameKey, typeNatExpTyFamNameKey + :: Unique +typeNatKindConNameKey = mkPreludeTyConUnique 160 +typeNatAddTyFamNameKey = mkPreludeTyConUnique 161 +typeNatMulTyFamNameKey = mkPreludeTyConUnique 162 +typeNatExpTyFamNameKey = mkPreludeTyConUnique 163 + ---------------- Template Haskell ------------------- -- USES TyConUniques 200-299 ----------------------------------------------------- diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 911402c..60fad55 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -342,9 +342,8 @@ argTypeKind = kindTyConType argTypeKindTyCon ubxTupleKind = kindTyConType ubxTupleKindTyCon constraintKind = kindTyConType constraintKindTyCon - -- XXX: we should probably be using a different type than Word here... typeNatKind :: Kind -typeNatKind = kindTyConType (mkKindTyCon wordTyConName tySuperKind) +typeNatKind = kindTyConType (mkKindTyCon typeNatKindConName tySuperKind) -- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@ _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
