From oleg at okmij.org Wed Feb 28 23:56:47 2007 To: haskell@haskell.org Subject: Haskell with only one typeclass Message-ID: <20070301075647.3CCFAAD34@Adric.metnet.fnmoc.navy.mil> Date: Wed, 28 Feb 2007 23:56:47 -0800 (PST) Status: RO Defining new typeclasses is regarded as an important part of Haskell programming, as the normal way of introducing overloaded functions. This message shows that if the ability to define typeclasses is removed, no expressivity is lost. If Haskell had only one, pre-defined typeclass with only one method, we could still do normal Haskell programming with standard and user-defined overloaded numerical functions, monads, monad transformers, etc. Haskell with only one typeclass can express all of Haskell98 typeclass programming idioms including constructor classes, plus multi-parameter type classes and some functional dependencies. If we additionally admit TypeCast as a pre-defined constraint, the rest of functional dependencies are expressible. Besides clarifying the role of typeclasses in Haskell as method bundles, this message proposes a model of overloading resolution that is simpler than that of Hall et al. Perhaps this model might be of interest to Haskell' committee. The present approach is inspired by HList's class Apply, which seems to be, after a small adjustment, the universal class. For clarity of terminology, we call as Haskell1 the language Haskell98 with no typeclass declarations but with a single, already declared typeclass C (which has two parameters related by a functional dependency). The programmers may not declare any typeclasses; but they may add instances to C and use them. We show on a series of examples that despite the lack of typeclass declarations, Haskell1 can express all the typeclass code of Haskell98 and then multi-parameter type classes and some (most useful?) functional dependencies. Haskell98 methods are defined as ordinary functions in Haskell1. To represent the rest of functional dependencies, we later define Haskell1' as an extension of Haskell1 with a pre-defined constraint TypeCast (which is not user-extensible and can be considered built-in). Finally we introduce the analogue of Haskell98 classes -- method bundles -- and use them for defining bounded existentials. Obviously Haskell1 is merely a subset of Haskell rather than a new language; the removal of typeclass declarations is a matter of discipline rather than that of syntax. We offer a model of overloading resolution that is a bit different from that of Stuckey and Sulzmann's `A theory of overloading.' When an instance is selected, its dependent arguments are improved (`typecast'). If an instance is not selected, no type improvement is applied. Granted, this model is not formalized. But then, this message is not an ICFP paper. The complete code described in this message is available at http://okmij.org/ftp/Haskell/TypeClass.html#Haskell1 We first disclose our one and only type class: > class C l t | l -> t where ac :: l -> t The constraint C is pervasive, which makes some signatures in want of syntax sugar, which we purposely avoid for clarity. We start by building overloaded numeric functions, the analogue of Num. The following defines the functions `a la carte'. Later we shall see how to bundle them into what Haskell98 calls `classes'. We begin with addition, to be denoted (+$) to avoid the confusion with the Prelude. > data Add a > infixl 6 +$ > (+$) :: forall a. C (Add a) (a->a->a) => a -> a -> a > (+$) = ac (__:: Add a) Whereas (+) in Haskell was a method, here the overloaded addition is a regular function, albeit bounded polymorphic. As we shall see, the constraints of such functions are analogues of Haskell98 class constraints. The above signature, sans the constraint, is the same as that of Prelude.(+). We will see later a way to avoid writing the C constraint explicitly. Let's define the instances of the generic addition for Ints and Floats > instance C (Add Int) (Int->Int->Int) where ac _ x y = x + y > instance C (Add Float) (Float->Float->Float) where ac _ x y = x + y as well over Dual numbers > data Dual a = Dual a a deriving Show > instance C (Add a) (a->a->a)=>C (Add (Dual a)) (Dual a->Dual a->Dual a) where > ac _ (Dual x1 y1) (Dual x2 y2) = Dual (x1 +$ x2) (y1 +$ y2) The latter is defined inductively, with the addition over base types being the base case. > ta2 = let x = Dual (1::Int) 2 in x +$ x -- sample test Likewise, we define the overloaded multiplication. This time, we use partial signatures to avoid writing the C constraint: > infixl 7 *$ > mul_sig :: a -> a -> a; mul_sig = undefined > mul_as :: a -> Mul a; mul_as = undefined > x *$ y | False = mul_sig x y > x *$ y = ac (mul_as x) x y Functions frmInteger and shw are analogous. As in Haskell98, we use the available overloaded functions to define new generic functions. For example, > genf x = x *$ x *$ (frmInteger 2) > tm1 = genf (Dual (1::Float) 2) +$ (frmInteger 3) The complete code demonstrates the overloading of not only functions but also of plain values: minBound. Next we turn to constructor classes and Monads, which can be easily restricted as frequently desired. > data RET (m :: * -> *) a > data BIND (m :: * -> *) a b > ret :: forall m a. C (RET m a) (a->m a) => a -> m a > ret = ac (__::RET m a) > bind :: forall m a b. C (BIND m a b) (m a->(a -> m b)->m b) => > (m a->(a -> m b)->m b) > bind = ac (__::BIND m a b) We show one particular monad: Either e > instance C (RET (Either e) a) (a -> Either e a) where ac _ = Right > instance C (BIND (Either e) a b) > (Either e a -> (a->Either e b) -> Either e b) where > ac _ (Right x) f = f x > ac _ (Left x) f = Left x with the goal to demonstrate MonadError, which is defined in Haskell's monad transformer library as follows -- class Error a where -- strMsg :: String -> a -- class Monad m => MonadError e m | m -> e where -- throwError :: e -> m a -- catchError :: m a -> (e -> m a) -> m a In Haskell1, the above code becomes > data ERROR a > strMsg :: forall a. C (ERROR a) (String->a) => String -> a > strMsg = ac (__::ERROR a) > instance C (ERROR String) (String->String) where ac _ = id > data ThrowError (m :: * -> *) a > throwError :: forall e m a b t1 t2. > (C (ThrowError m a) (e -> m a), C (RET m a) t1, C (BIND m a b) t2) => > e -> m a > throwError = ac (__::ThrowError m a) Here the constraints C (RET m a) t1 and C (BIND m a b) t2 are not called for, but we specified them anyway. That is, we require that `m' be an instance of a Monad. These extra constraints are Haskell1 analogue of Haskell's `class constraints'. The definition of catchError is similar. The Either e monad is an instance of MonadError > instance C (ThrowError (Either e) a) (e -> Either e a) where ac _ = Left > instance C (CatchError (Either e) a) > (Either e a -> (e -> Either e a) -> Either e a) where > ac _ (Left x) f = f x; ac _ x _ = x so we can write a test > te1 x = runEither $ catchError ac (\e -> ret e) > where > ac = (if x then throwError "er" else ret (2::Int)) `bind` > (\x -> ret (x *$ x)) `bind` (ret.shw) > runEither :: Either a b -> Either a b; runEither = id > te1r = (te1 True, te1 False) The MonadError example demonstrated that we already have some functional dependencies. To get them in full, we extend Haskell1 with the ``pre-defined'' constraint TypeCast. For example, to express the following Haskell method of two arguments with the type of the first argument determining the types of the result and of the second argument -- class FC3 a b c | a -> b c where fc3 :: a -> b -> c -- instance FC3 Bool Char Int we write in Haskell1' > data FC3 a b c > fc3 :: forall a b c. C (FC3 a b c) (a->b->c) => a->b->c > fc3 = ac (__::FC3 a b c) > instance TypeCast (FC3 Bool b c) (FC3 Bool Char Int) > => C (FC3 Bool b c) (Bool->Char->Int) where ac _ x y = 1 > tfc3 = fc3 True 'a' > tfc31 = fc3 True undefined The latter two sample definitions are accepted as they are. Without the functional dependencies, however, we would have needed type annotations. The accompanying complete code has the expanded example. Finally, we introduce the analogue of Haskell98 `classes' -- bundles of methods -- whose compelling application is bounded existentials. Let's define the Num bundle and numeric functions that are truly NUM-overloaded > data NUM a = NUM{nm_add,nm_mul :: a->a->a, > nm_fromInteger :: Integer->a, nm_show :: a->String} > data CLS a > instance (C (Add a) (a->a->a), C (Mul a) (a->a->a), > C (FromInteger a) (Integer->a), > C (SHOW a) (a->String)) > => C (CLS (NUM a)) (NUM a) where ac _ = NUM (+$) (*$) frmInteger shw We re-visit the overloaded addition, multiplication, show and fromInteger functions, defining them now in terms of the just introduced `class' NUM. We should point out the uniformity of the declarations below, ripe for syntactic sugar. For example, one may introduce NUM a => ... to mean C (CLS (NUM a)) (NUM a) => ... > infixl 6 +$$; infixl 7 *$$ > (+$$) :: forall a. C (CLS (NUM a)) (NUM a) => a -> a -> a > (+$$) x y = nm_add (ac (__:: CLS (NUM a))) x y and similarly for the other operations. We are in a position to define a bounded existential, whose quantified type variable 'a' is restricted to members of NUM. The latter lets us use the overloaded numerical functions after opening the existential envelope. > data PACK = forall a. C (CLS (NUM a)) (NUM a) => PACK a > t1d = let x = PACK (Dual (1.0::Float) 2) in > case x of PACK y -> nshw (y *$$ y +$$ y +$$ (nfromI 2))