[commit: ghc] type-nats-simple: Move declarations for type-nat TyCons to TcTypeNat (e742f24)
git at git.haskell.org
git at git.haskell.org
Wed Sep 4 18:22:24 CEST 2013
Repository : ssh://git@git.haskell.org/ghc
On branch : type-nats-simple
Link : http://ghc.haskell.org/trac/ghc/changeset/e742f24c5c0ec19639a7dde10fad3e1cd25535b8/ghc
>---------------------------------------------------------------
commit e742f24c5c0ec19639a7dde10fad3e1cd25535b8
Author: Iavor S. Diatchki <iavor.diatchki at gmail.com>
Date: Wed Sep 4 07:41:17 2013 -0700
Move declarations for type-nat TyCons to TcTypeNat
>---------------------------------------------------------------
e742f24c5c0ec19639a7dde10fad3e1cd25535b8
compiler/prelude/PrelInfo.lhs | 4 ++
compiler/prelude/TysWiredIn.lhs | 36 ------------------
compiler/typecheck/TcTypeNats.hs | 67 +++++++++++++++++++++++++++++++--
compiler/typecheck/TcTypeNats.hs-boot | 5 +++
4 files changed, 72 insertions(+), 40 deletions(-)
diff --git a/compiler/prelude/PrelInfo.lhs b/compiler/prelude/PrelInfo.lhs
index bb3e54a..542525c 100644
--- a/compiler/prelude/PrelInfo.lhs
+++ b/compiler/prelude/PrelInfo.lhs
@@ -42,6 +42,7 @@ import HscTypes
import Class
import TyCon
import Util
+import {-# SOURCE #-} TcTypeNats ( typeNatTyThings )
import Data.Array
\end{code}
@@ -87,6 +88,9 @@ wiredInThings
-- PrimOps
, map (AnId . primOpId) allThePrimOps
+
+ -- TyCons and axioms for type-nats
+ , typeNatTyThings
]
where
tycon_things = map ATyCon ([funTyCon] ++ primTyCons ++ wiredInTyCons)
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index e996617..5ec290a 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -68,9 +68,6 @@ module TysWiredIn (
-- * Equality predicates
eqTyCon_RDR, eqTyCon, eqTyConName, eqBoxDataCon,
- -- * Type-level naturals
- typeNatAddTyCon, typeNatMulTyCon, typeNatExpTyCon
-
) where
#include "HsVersions.h"
@@ -788,36 +785,3 @@ isPArrFakeCon dcon = dcon == parrFakeCon (dataConSourceArity dcon)
-
-%*******************************************************************
-%*
-\subsection[TysWiredIn-TypeNat]{Type-level Numbers}
-%*
-%*******************************************************************
-
-
-Type functions related to type-nats.
-
-\begin{code}
-
--- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
-mkTypeNatFunTyCon2 :: Name -> TyCon
-mkTypeNatFunTyCon2 op =
- mkSynTyCon op
- (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind)
- (take 2 $ tyVarList typeNatKind)
- [Nominal,Nominal]
- OpenSynFamilyTyCon -- XXX: BuiltIn
- NoParentTyCon
-
-typeNatAddTyCon :: TyCon
-typeNatAddTyCon = mkTypeNatFunTyCon2 typeNatAddTyFamName
-
-typeNatMulTyCon :: TyCon
-typeNatMulTyCon = mkTypeNatFunTyCon2 typeNatMulTyFamName
-
-typeNatExpTyCon :: TyCon
-typeNatExpTyCon = mkTypeNatFunTyCon2 typeNatExpTyFamName
-
-\end{code}
-
diff --git a/compiler/typecheck/TcTypeNats.hs b/compiler/typecheck/TcTypeNats.hs
index e5880b4..a8138f5 100644
--- a/compiler/typecheck/TcTypeNats.hs
+++ b/compiler/typecheck/TcTypeNats.hs
@@ -1,16 +1,57 @@
-module TcTypeNats (tnMatchFam, tnInteractTop) where
+module TcTypeNats (tnMatchFam, tnInteractTop, typeNatTyThings) where
import Type
import Pair
-import TyCon ( TyCon )
+import TyCon ( TyCon, SynTyConRhs(..), mkSynTyCon, TyConParent(..) )
+import Coercion ( Role(..) )
import TcRnTypes ( Xi )
import TcEvidence ( mkTcAxiomRuleCo, TcCoercion )
import CoAxiom ( CoAxiomRule(..) )
import Name ( Name, mkWiredInName, BuiltInSyntax(..) )
import OccName ( mkOccName, tcName )
import Unique ( mkAxiomRuleUnique )
-import PrelNames ( gHC_PRIM )
-import TysWiredIn ( typeNatAddTyCon, typeNatMulTyCon, typeNatExpTyCon )
+import TysWiredIn ( typeNatKind )
+import TysPrim ( tyVarList, mkArrowKinds )
+import PrelNames ( gHC_PRIM
+ , typeNatAddTyFamName
+ , typeNatMulTyFamName
+ , typeNatExpTyFamName
+ )
+
+typeNatTyThings :: [TyThing]
+typeNatTyThings = typeNatTyCons ++ typeNatAxioms
+
+
+{-------------------------------------------------------------------------------
+Built-in type constructors for functions on type-lelve nats
+-}
+
+typeNatTyCons :: [TyThing]
+typeNatTyCons = map ATyCon
+ [ typeNatAddTyCon
+ , typeNatMulTyCon
+ , typeNatExpTyCon
+ ]
+
+typeNatAddTyCon :: TyCon
+typeNatAddTyCon = mkTypeNatFunTyCon2 typeNatAddTyFamName
+
+typeNatMulTyCon :: TyCon
+typeNatMulTyCon = mkTypeNatFunTyCon2 typeNatMulTyFamName
+
+typeNatExpTyCon :: TyCon
+typeNatExpTyCon = mkTypeNatFunTyCon2 typeNatExpTyFamName
+
+-- Make a binary built-in constructor of kind: Nat -> Nat -> Nat
+mkTypeNatFunTyCon2 :: Name -> TyCon
+mkTypeNatFunTyCon2 op =
+ mkSynTyCon op
+ (mkArrowKinds [ typeNatKind, typeNatKind ] typeNatKind)
+ (take 2 $ tyVarList typeNatKind)
+ [Nominal,Nominal]
+ OpenSynFamilyTyCon -- XXX: BuiltIn
+ NoParentTyCon
+
@@ -73,6 +114,24 @@ axExp1L = mkAxiom1 axExp1LKey "Exp1L" $ \t -> (num 1 .^. t) === num 1
axExp0R = mkAxiom1 axExp0RKey "Exp0R" $ \t -> (t .^. num 0) === num 1
axExp1R = mkAxiom1 axExp1RKey "Exp1R" $ \t -> (t .^. num 1) === t
+typeNatAxioms :: [TyThing]
+typeNatAxioms = map ACoAxiomRule
+ [ axAddDef
+ , axMulDef
+ , axExpDef
+ , axAdd0L
+ , axAdd0R
+ , axMul0L
+ , axMul0R
+ , axMul1L
+ , axMul1R
+ , axExp1L
+ , axExp0R
+ , axExp1R
+ ]
+
+
+
{-------------------------------------------------------------------------------
Various utilities for making axioms and types
diff --git a/compiler/typecheck/TcTypeNats.hs-boot b/compiler/typecheck/TcTypeNats.hs-boot
new file mode 100644
index 0000000..7bb324b
--- /dev/null
+++ b/compiler/typecheck/TcTypeNats.hs-boot
@@ -0,0 +1,5 @@
+module TcTypeNats where
+
+import TypeRep(TyThing)
+
+typeNatTyThings :: [TyThing]
More information about the ghc-commits
mailing list