Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : imp-param-class
http://hackage.haskell.org/trac/ghc/changeset/632c5beaf015c29c54b174f7ac809c19b89b0f8d >--------------------------------------------------------------- commit 632c5beaf015c29c54b174f7ac809c19b89b0f8d Author: Iavor S. Diatchki <[email protected]> Date: Sat May 26 16:57:20 2012 -0700 Change the `IP` class to avoid the ambiguity of the method. We use a phantom type to link an implicit parameter name to its value. This is nice because now `?x` in the source code is simply syntactic sugar for `ipUse (IPName :: "x")`, and we type check it in exactly that way. `ipDef` is used when we process implicit parameter bindings---it's only there to add the newtype constructor. >--------------------------------------------------------------- GHC/IP.hs | 29 +++++++++++++++++++++++++---- 1 files changed, 25 insertions(+), 4 deletions(-) diff --git a/GHC/IP.hs b/GHC/IP.hs index 7cb3209..b433276 100644 --- a/GHC/IP.hs +++ b/GHC/IP.hs @@ -3,12 +3,33 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE DataKinds #-} {-# OPTIONS_GHC -XNoImplicitPrelude #-} -module GHC.IP where +module GHC.IP (IP, IPName(..), IPValue, ipUse, ipDef) where import GHC.TypeLits --- | This class is used to implement implicit parameters. -class IP (name :: Symbol) t | name -> t where - ipValue :: t +-- | A singleton type used to name implicit parameters. +data IPName (name :: Symbol) = IPName + +-- | A type used to give values to implicit parameters. +-- The name is a phantom parameter because it needs no run-time representation. +newtype IPValue (name :: Symbol) a = IPValue a + + +-- | The syntax @?x@ is desuagred into @ipUse (IPName :: "x")@ +ipUse :: IP x a => IPName x -> a +ipUse x = case val x of + IPValue a -> a + where val :: IP x a => IPName x -> IPValue x a + val _ = ip + +-- | This is used when we construct evidence for the 'IP' class. +-- @let ?x = e in ...@ uses @ipDef (IPName :: "x") e@ to cinstruct +-- a new implict parameter. +ipDef :: IPName x -> a -> IPValue x a +ipDef _ a = IPValue a + +-- | 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
