Repository : ssh://darcs.haskell.org//srv/darcs/packages/base

On branch  : imp-param-class

http://hackage.haskell.org/trac/ghc/changeset/f84970684b8502fa6df07c6be41d85e918741415

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

commit f84970684b8502fa6df07c6be41d85e918741415
Author: Iavor S. Diatchki <[email protected]>
Date:   Sun May 27 20:34:38 2012 -0700

    Remove 'ipDef', we just insert the newtype coercion manually.
    
    This gives a much better error message.

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

 GHC/IP.hs |    6 +-----
 1 files changed, 1 insertions(+), 5 deletions(-)

diff --git a/GHC/IP.hs b/GHC/IP.hs
index 26fee1a..dd75d07 100644
--- a/GHC/IP.hs
+++ b/GHC/IP.hs
@@ -3,7 +3,7 @@
 {-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE DataKinds #-}
 {-# OPTIONS_GHC -XNoImplicitPrelude #-}
-module GHC.IP (IP, IPName(..), ipUse, ipDef) where
+module GHC.IP (IP, IPName(..), ipUse) where
 
 import GHC.TypeLits
 
@@ -22,10 +22,6 @@ ipUse x = case val x of
   where val :: IP x a => IPName x -> IPValue x a
         val _ = ip
 
--- Used internally by the compiler to create `IP` dictionaries.
-ipDef :: a -> IPValue x a
-ipDef = IPValue
-
 -- | The syntax @?x :: a@ is desugared into @IP "x" a@
 class IP x a | x -> a where
   ip :: IPValue x a



_______________________________________________
Cvs-libraries mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/cvs-libraries

Reply via email to