Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/215cf423abed67a2827e0ee1ec95e8fcdfe0c8df

>---------------------------------------------------------------

commit 215cf423abed67a2827e0ee1ec95e8fcdfe0c8df
Author: Simon Peyton Jones <simo...@microsoft.com>
Date:   Tue Jan 1 23:13:20 2013 +0000

    Make the comments about SingI and EvLit match current reality
    
    See Note [SingI and EvLit] in TcEvidence.

>---------------------------------------------------------------

 compiler/prelude/PrelNames.lhs    |    1 +
 compiler/typecheck/TcEvidence.lhs |   29 ++++++++++++++---------------
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 5d8dc3c..4bb0e54 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -1216,6 +1216,7 @@ datatypeClassKey    = mkPreludeClassUnique 39
 constructorClassKey = mkPreludeClassUnique 40
 selectorClassKey    = mkPreludeClassUnique 41
 
+-- SingI: see Note [SingI and EvLit] in TcEvidence
 singIClassNameKey, typeNatLeqClassNameKey :: Unique
 singIClassNameKey       = mkPreludeClassUnique 42
 typeNatLeqClassNameKey  = mkPreludeClassUnique 43
diff --git a/compiler/typecheck/TcEvidence.lhs 
b/compiler/typecheck/TcEvidence.lhs
index fe38a07..452a769 100644
--- a/compiler/typecheck/TcEvidence.lhs
+++ b/compiler/typecheck/TcEvidence.lhs
@@ -496,7 +496,7 @@ data EvTerm
                                  -- selector Id.  We count up from _0_
 
   | EvLit EvLit                  -- Dictionary for class "SingI" for type lits.
-                                 -- Note [EvLit]
+                                 -- Note [SingI and EvLit]
 
   deriving( Data.Data, Data.Typeable)
 
@@ -550,27 +550,26 @@ Conclusion: a new wanted coercion variable should be made 
mutable.
  from super classes will be "given" and hence rigid]
 
 
-Note [EvLit]
-~~~~~~~~~~~~
+Note [SingI and EvLit]
+~~~~~~~~~~~~~~~~~~~~~~
 A part of the type-level literals implementation is the class "SingI",
 which provides a "smart" constructor for defining singleton values.
+Here is the key stuff from GHC.TypeLits
 
-newtype Sing n = Sing (SingRep n)
+  class SingI n where
+    sing :: Sing n
 
-class SingI n where
-  sing :: Sing n
-
-type family SingRep a
-type instance SingRep (a :: Nat)    = Integer
-type instance SingRep (a :: Symbol) = String
+  data family Sing (n::k)
+  newtype instance Sing (n :: Nat)    = SNat Integer
+  newtype instance Sing (s :: Symbol) = SSym String
 
 Conceptually, this class has infinitely many instances:
 
-instance Sing 0       where sing = Sing 0
-instance Sing 1       where sing = Sing 1
-instance Sing 2       where sing = Sing 2
-instance Sing "hello" where sing = Sing "hello"
-...
+  instance Sing 0       where sing = SNat 0
+  instance Sing 1       where sing = SNat 1
+  instance Sing 2       where sing = SNat 2
+  instance Sing "hello" where sing = SSym "hello"
+  ...
 
 In practice, we solve "SingI" predicates in the type-checker because we can't
 have infinately many instances.  The evidence (aka "dictionary")



_______________________________________________
Cvs-ghc mailing list
Cvs-ghc@haskell.org
http://www.haskell.org/mailman/listinfo/cvs-ghc

Reply via email to