Repository : ssh://darcs.haskell.org//srv/darcs/ghc On branch : type-nats
http://hackage.haskell.org/trac/ghc/changeset/44e504e6ed0176d39790ec4dc9e7cbf481ac5428 >--------------------------------------------------------------- commit 44e504e6ed0176d39790ec4dc9e7cbf481ac5428 Author: Iavor S. Diatchki <[email protected]> Date: Mon Jul 9 10:17:31 2012 -0700 Move type-nat functions into TysWiredIn (instead of TysPrim) >--------------------------------------------------------------- compiler/prelude/TysPrim.lhs | 33 ------------------------ compiler/prelude/TysWiredIn.lhs | 45 +++++++++++++++++++++++++++++++++ compiler/typecheck/TcTypeNats.hs | 8 +++--- compiler/typecheck/TcTypeNatsRules.hs | 10 ++++--- 4 files changed, 55 insertions(+), 41 deletions(-) diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs index 2ddb12d..3543f65 100644 --- a/compiler/prelude/TysPrim.lhs +++ b/compiler/prelude/TysPrim.lhs @@ -75,10 +75,6 @@ module TysPrim( -- * Any anyTy, anyTyCon, anyTypeOfKind, - - -- * Type families used to compute at the type level. - typeNatLeqTyCon, typeNatAddTyCon, typeNatMulTyCon, typeNatExpTyCon - ) where #include "HsVersions.h" @@ -729,32 +725,3 @@ anyTypeOfKind kind = mkNakedTyConApp anyTyCon [kind] \end{code} -Type functions related to type-nats. - -\begin{code} - --- XXX: THIS IS WRONG. IT SHOULD RETURN A PROMOTED BOOL. -typeNatLeqTyCon :: TyCon -typeNatLeqTyCon = mkSynTyCon typeNatLeqTyFamName - (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind) - (take 2 $ tyVarList typeNatKind) - SynFamilyTyCon - NoParentTyCon - -mkTypeNatFunTyCon :: Name -> TyCon -mkTypeNatFunTyCon op = mkSynTyCon op - (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind) - (take 2 $ tyVarList typeNatKind) - SynFamilyTyCon - NoParentTyCon - -typeNatAddTyCon :: TyCon -typeNatAddTyCon = mkTypeNatFunTyCon typeNatAddTyFamName - -typeNatMulTyCon :: TyCon -typeNatMulTyCon = mkTypeNatFunTyCon typeNatMulTyFamName - -typeNatExpTyCon :: TyCon -typeNatExpTyCon = mkTypeNatFunTyCon typeNatExpTyFamName -\end{code} - diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs index 78e1f74..515e311 100644 --- a/compiler/prelude/TysWiredIn.lhs +++ b/compiler/prelude/TysWiredIn.lhs @@ -72,6 +72,9 @@ module TysWiredIn ( -- * Equality predicates eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon, + -- * Type families used to compute at the type level. + typeNatLeqTyCon, typeNatAddTyCon, typeNatMulTyCon, typeNatExpTyCon + ) where #include "HsVersions.h" @@ -751,3 +754,45 @@ mkPArrFakeCon arity = data_con isPArrFakeCon :: DataCon -> Bool isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon) \end{code} + + +%******************************************************************* +%* +\subsection[TysWiredIn-TypeNat]{Type-level Numbers} +%* +%******************************************************************* + + +Type functions related to type-nats. + +\begin{code} + +-- XXX: THIS IS WRONG. IT SHOULD RETURN A PROMOTED BOOL. +typeNatLeqTyCon :: TyCon +typeNatLeqTyCon = mkSynTyCon typeNatLeqTyFamName + (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind) + (take 2 $ tyVarList typeNatKind) + SynFamilyTyCon + NoParentTyCon + +mkTypeNatFunTyCon :: Name -> TyCon +mkTypeNatFunTyCon op = mkSynTyCon op + (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind) + (take 2 $ tyVarList typeNatKind) + SynFamilyTyCon + NoParentTyCon + +typeNatAddTyCon :: TyCon +typeNatAddTyCon = mkTypeNatFunTyCon typeNatAddTyFamName + +typeNatMulTyCon :: TyCon +typeNatMulTyCon = mkTypeNatFunTyCon typeNatMulTyFamName + +typeNatExpTyCon :: TyCon +typeNatExpTyCon = mkTypeNatFunTyCon typeNatExpTyFamName +\end{code} + + + + + diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs index d012a55..7d8f3b7 100644 --- a/compiler/typecheck/TcTypeNats.hs +++ b/compiler/typecheck/TcTypeNats.hs @@ -19,10 +19,10 @@ import Type ( Type, isNumLitTy, getTyVar_maybe, mkNumLitTy , splitTyConApp_maybe , eqType ) -import TysPrim ( typeNatAddTyCon - , typeNatMulTyCon - , typeNatExpTyCon - ) +import TysWiredIn ( typeNatAddTyCon + , typeNatMulTyCon + , typeNatExpTyCon + ) import Bag ( bagToList ) import DynFlags ( DynFlags ) diff --git a/compiler/typecheck/TcTypeNatsRules.hs b/compiler/typecheck/TcTypeNatsRules.hs index e808fef..935a152 100644 --- a/compiler/typecheck/TcTypeNatsRules.hs +++ b/compiler/typecheck/TcTypeNatsRules.hs @@ -5,12 +5,14 @@ import Var ( TyVar ) import Coercion ( CoAxiomRule(..) ) import Type ( Type, mkTyVarTy, mkNumLitTy, mkTyConApp ) import PrelNames( unboundKey ) -import TysPrim ( typeNatAddTyCon - , typeNatMulTyCon - , typeNatExpTyCon - , tyVarList +import TysPrim ( tyVarList , typeNatKind ) +import TysWiredIn ( typeNatAddTyCon + , typeNatMulTyCon + , typeNatExpTyCon + ) + import Name ( mkSystemName ) import OccName ( mkOccName, tcName ) _______________________________________________ Cvs-ghc mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-ghc
