diff --git a/Data/Class1.hs b/Data/Class1.hs new file mode 100644 --- /dev/null +++ b/Data/Class1.hs @@ -0,0 +1,212 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE EmptyDataDecls, ScopedTypeVariables, KindSignatures #-} + +-- | Haskell with only one typeclass +-- +-- +-- +-- +-- +-- How to make ad hoc overloading less ad hoc while defining no +-- type classes. +-- For clarity, we call as Haskell1 the language Haskell98 +-- with no typeclass declarations but with a single, pre-defined 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 plus multi-parameter type classes +-- and even some (most useful?) functional dependencies. +-- +-- Haskell1 is not a new language and requires no new compilers; +-- rather, it is a subset of the current Haskell. The `removal' of typeclass +-- declarations is merely the matter of discipline. +-- +-- +-- + +module Data.Class1 where + +-- | The one and only type class present in Haskell1 +class C l t | l -> t where + ac :: l -> t + +__ = __ -- short synonym for undefined + +-- ---------------------------------------------------------------------- +-- | Example 1: Building overloaded numeric functions, the analogue of Num. +-- The following defines overloaded numeric functions `a la carte'. We +-- shall see how to bundle such methods into what Haskell98 calls `classes' +-- +data Add a -- auxiliary labels +data Mul a +data FromInteger a + +instance C (Add Int) (Int->Int->Int) where + ac _ x y = x + y + +-- | We can now define the generic addition. We use the operation +$ +-- to avoid the confusion with Prelude.(+) +infixl 6 +$ + +-- | In H98, the overloaded addition was a method. In Haskell1, it is an +-- ordinary (bounded polymorphic) function +-- The signature looks a bit ugly; we'll see how to simplify it a bit +(+$) :: forall a. C (Add a) (a->a->a) => a -> a -> a +(+$) = ac (__:: Add a) + +ta1 = (1::Int) +$ 2 +$ 3 +-- 6 + +-- | Let's define the addition for floats +instance C (Add Float) (Float->Float->Float) where + ac _ x y = x + y + +-- | We now illustrate overloading over datatypes other than basic ones. +-- We define dual numbers (see Wikipedia) +data Dual a = Dual a a deriving Show + +-- | We define the addition of Duals inductively, with the addition over +-- base types as the base case. +-- We could have eliminated the mentioning (a->a->a) and replaced with some +-- type t. But then we would need the undecidable instance extension... +-- +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 following test uses the previously defined +$ operation, which +-- now accounts for duals automatically. +-- As in Haskell98, our overloaded functions are extensible. +ta2 = let x = Dual (1::Int) 2 in x +$ x +-- Dual 2 4 + +-- | Likewise define the overloaded multiplication +infixl 7 *$ + +instance C (Mul Int) (Int->Int->Int) where + ac _ x y = x * y +instance C (Mul Float) (Float->Float->Float) where + ac _ x y = x * y +instance (C (Add a) (a->a->a), C (Mul a) (a->a->a)) + => C (Mul (Dual a)) (Dual a->Dual a->Dual a) where + ac _ (Dual x1 y1) (Dual x2 y2) = Dual (x1 *$ x2) (x1 *$ y2 +$ y1 *$ x2) + + +-- | Here is a different, perhaps simpler, way of defining signatures of +-- overloaded functions. The constraint C is inferred and no longer has +-- to be mentioned explicitly +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 + +-- | fromInteger conversion +-- This numeric operation is different from the previous in that +-- the overloading is resolved on the result type only. The function +-- `read' is another example of such a `producer' + +instance C (FromInteger Int) (Integer->Int) where + ac _ = fromInteger +instance C (FromInteger Float) (Integer->Float) where + ac _ = fromInteger +instance (C (FromInteger a) (Integer->a)) + => C (FromInteger (Dual a)) (Integer->Dual a) where + ac _ x = Dual (frmInteger x) (frmInteger 0) + +-- | and the corresponding overloaded function (which in Haskell98 was a method) +-- Again, we chose a slightly different name to avoid the confusion with +-- the Prelude +frmInteger :: forall a. C (FromInteger a) (Integer->a) => Integer -> a +frmInteger = ac (__::FromInteger a) + +-- | We can define generic function at will, using already defined overloaded +-- functions. For example, +genf x = x *$ x *$ (frmInteger 2) + +tm1 = genf (Dual (1::Float) 2) +$ (frmInteger 3) +-- Dual 5.0 8.0 + +-- For completeness, we implement the quintessential Haskell98 function, Show. + +data SHOW a +instance C (SHOW Int) (Int->String) where + ac _ = show +instance C (SHOW Float) (Float->String) where + ac _ = show +instance (C (SHOW a) (a->String)) + => C (SHOW (Dual a)) (Dual a -> String) where + ac _ (Dual x y) = "(|" ++ shw x ++ "," ++ shw y ++ "|)" + +shw :: forall a. C (SHOW a) (a->String) => a->String +shw = ac (__::SHOW a) + +ts1 = shw tm1 +-- "(|5.0,8.0|)" + + +-- | Finally, we demonstrate overloading of non-functional values, such as +-- minBound and maxBound. These are not `methods' in the classical sense. +-- +data MinBound a +instance C (MinBound Int) Int where + ac _ = minBound +instance C (MinBound Bool) Bool where + ac _ = False + +mnBound :: forall a. C (MinBound a) a => a +mnBound = ac (__::MinBound a) + +tmb = mnBound::Int +-- -2147483648 + + +-- ---------------------------------------------------------------------- +-- Constructor classes and Monads + +-- | We are defining a super-set of monads, so called `restricted monads'. +-- Restricted monads include all ordinary monads; in addition, we can +-- define a SET monad. See +-- +-- +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) + + +-- | Define two sample monads +-- +instance C (RET Maybe a) (a -> Maybe a) where + ac _ = Just +instance C (BIND Maybe a b) (Maybe a -> (a->Maybe b) -> Maybe b) where + ac _ Nothing f = Nothing + ac _ (Just x) f = f x + +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 + + +-- | An example of using monads and other overloaded functions +tmo = (tmo' True, tmo' False) + where + tmo' x = let t = if x then Nothing else ret (1::Int) + v = t `bind` (\x -> ret (x +$ (frmInteger 1))) + in shw v +-- ("Nothing","Just 2") + +instance C (SHOW a) (a->String) => C (SHOW (Maybe a)) (Maybe a->String) where + ac _ Nothing = "Nothing" + ac _ (Just x) = "Just " ++ shw x + + diff --git a/Data/Class2.hs b/Data/Class2.hs new file mode 100644 --- /dev/null +++ b/Data/Class2.hs @@ -0,0 +1,277 @@ +{-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies #-} +{-# LANGUAGE FlexibleInstances, FlexibleContexts #-} +{-# LANGUAGE EmptyDataDecls, ScopedTypeVariables, KindSignatures #-} +{-# LANGUAGE UndecidableInstances, ExistentialQuantification #-} + +-- | Haskell with only one typeclass +-- +-- +-- +-- +-- +-- How to make ad hoc overloading less ad hoc while defining no +-- type classes. +-- Haskell1' -- the extension of Haskell1 with functional dependencies, +-- and bounded-polymorphic higher-rank types + +module Data.Class2 where + +import Data.Class1 + +-- ---------------------------------------------------------------------- +-- | Some functional dependencies: implementing Monad Error +-- As it turns out, some functional dependencies are expressible already +-- in Haskell1. The example is MonadError, which in Haskell' has the form + +-- 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 + +-- The C (RET m a) t1 and C (BIND m a b) t2 constraints are not +-- called for, but we specified them anyway. That is, we require that +-- `m' be an instance of a Monad. This extra constraints are Haskell1 +-- analogue of Haskell's `class constraints' +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) + +data CatchError (m :: * -> *) a +catchError :: forall e m a. C (CatchError m a) (m a -> (e -> m a) -> m a) => + m a -> (e -> m a) -> m a +catchError = ac (__::CatchError m a) + + +-- define one particular Error Monad, Either e +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) +-- (Right "er",Right "4") + + +-- ---------------------------------------------------------------------- +-- Functional dependencies + +-- The first example has no functional dependencies. In Haskell: +-- class FC1 a b c where fc1 :: a -> b -> c +-- instance FC1 Bool Char Int + +-- In Haskell1: + +data FC1 a b c +instance C (FC1 Bool Char Int) (Bool->Char->Int) where + ac _ x y = 1 + +fc1 :: forall a b c. C (FC1 a b c) (a->b->c) => a->b->c +fc1 = ac (__::FC1 a b c) + +-- The definition tfc1 below is rejected because of the unresolved +-- overloading on the return type of fc1. If we specify the return +-- type explicitly, the definition is accepted. +-- To eliminate such explicit type annotations, functional dependencies +-- are introduced. + +-- tfc1 = fc1 True 'a' +tfc12 = (fc1 True 'a') :: Int -- OK +-- 1 + +-- If our function fc is such that the type of its two arguments determines +-- the result type, we can write, in Haskell +-- class FC2 a b c | a b -> c where fc2 :: a -> b -> c +-- instance FC2 Bool Char Int + +-- In Haskell1' +data FC2 a b c +instance TypeCast c Int => C (FC2 Bool Char c) (Bool->Char->Int) where + ac _ x y = 1 + +fc2 :: forall a b c. C (FC2 a b c) (a->b->c) => a->b->c +fc2 = ac (__::FC2 a b c) + +-- Now, tfc2 is accepted without the additional annotations. +-- The argument types still have to be explicitly specified: +-- The definition tfc21 is rejected because of the unresolved overloading +-- over the second argument +tfc2 = fc2 True 'a' -- This is now OK with no type annotations +-- tfc21 = fc2 True undefined -- here, the second arg type is needed + +-- If fc is overloaded over the type of the first argument only, we +-- can write +-- class FC3 a b c | a -> b c where fc3 :: a -> b -> c +-- instance FC3 Bool Char Int + +-- Or, in Haskell1: +data 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 + +fc3 :: forall a b c. C (FC3 a b c) (a->b->c) => a->b->c +fc3 = ac (__::FC3 a b c) + +-- In this case, no more type annotations are needed. Both +-- of the following definitions are accepted as they are. +tfc3 = fc3 True 'a' +tfc31 = fc3 True undefined + + +-- We do not distinguish between a b -> c and a->b, a->c +-- The argument has been made for the distinction (Stuckey, Sulzmann: +-- A theory of overloading) +-- Hereby we make an argument for not having this distinction. We offer +-- a different model: when an instance is selected, its dependent +-- argument are improved (`typecast'). If an instance is not selected, +-- no type improvement is applied. + + +-- Associated Datatypes +-- The implementation of arrays, whose concrete representation depends on the +-- data type of their elements. This is the first example from +-- the paper Manuel M. T. Chakravarty, Gabriele Keller, Simon Peyton Jones +-- and Simon Marlow, `Associated Types with Class', POPL2005. +-- For simplicity, we limit ourselves to two methods: fromList +-- (which creates an array) and index. Again for simplicity, our +-- arrays are one-dimensional and indexed from 0. +-- As in the paper, the overloading is over the element type only. +-- Although for the function indexA, it would make more sense to overload +-- over the array type (and so the type of the result, that is, of the +-- extracted element, will be inferred). + +data FromList e +fromList :: forall e array. C (FromList e) (Int -> [e] -> array) => + Int -> [e] -> array +fromList = ac (__::FromList e) + +data Index e +indexA :: forall e array. C (Index e) (array -> Int -> e) => + (array -> Int -> e) +indexA = ac (__::Index e) + +instance C (FromList Bool) (Int -> [Bool] -> (Int,Integer)) where + ac _ dim lst = (dim,foldr (\e a -> 2*a + fromIntegral (fromEnum e)) 0 + (take dim lst)) +instance C (FromList Char) (Int -> [Char] -> String) where + ac _ dim lst = take dim lst + +-- Represent the array of pairs as a pair of arrays (example from the paper) +instance (C (FromList a) (Int -> [a] -> ara), + C (FromList b) (Int -> [b] -> arb)) + => C (FromList (a,b)) (Int -> [(a,b)] -> (ara,arb)) where + ac _ dim lst = (fromList dim (map fst lst), + fromList dim (map snd lst)) + +instance C (Index Bool) ((Int,Integer) -> Int -> Bool) where + ac _ (dim,num) i = if i >= dim then error "range check" + else (num `div` (2^i)) `mod` 2 == 1 + +instance C (Index Char) (String -> Int -> Char) where + ac _ s i = s !! i + +instance (C (Index a) (ara -> Int -> a), + C (Index b) (arb -> Int -> b)) + => C (Index (a,b)) ((ara,arb) -> Int -> (a,b)) where + ac _ (ara,arb) i = (indexA ara i, indexA arb i) + +-- The `asTypeOf` annotation below could be avoided if we overloaded +-- indexA differently, as mentioned above. We preferred to literally follow +-- the paper though... +testar lst = let arr = fromList (length lst) lst + in [(indexA arr 0) `asTypeOf` (head lst), + indexA arr (pred (length lst))] + +testarr = (testar [True,True,False], testar "abc", + testar [('x',True),('y',True),('z',False)]) +-- ([True,False],"ac",[('x',True),('z',False)]) + + +-- ---------------------------------------------------------------------- +-- Haskell98 classes (method bundles) and bounded existentials + +-- But what if we really need classes, as bundles of methods? +-- The compelling application is higher-ranked types: 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 + +(*$$) :: forall a. C (CLS (NUM a)) (NUM a) => a -> a -> a +(*$$) x y = nm_mul (ac (__:: CLS (NUM a))) x y + +nshw :: forall a. C (CLS (NUM a)) (NUM a) => a -> String +nshw x = nm_show (ac (__:: CLS (NUM a))) x + +nfromI :: forall a. C (CLS (NUM a)) (NUM a) => Integer -> a +nfromI x = nm_fromInteger (ac (__:: CLS (NUM a))) x + +-- 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)) +--"(|4.0,6.0|)" + + +-- This typeclass assumed pre-defined; it is not user-extensible. +-- It is best viewed as a ``built-in constraint'' +class TypeCast a b | a -> b, b->a where typeCast :: a -> b +class TypeCast' t a b | t a -> b, t b -> a where typeCast' :: t->a->b +class TypeCast'' t a b | t a -> b, t b -> a where typeCast'' :: t->a->b +instance TypeCast' () a b => TypeCast a b where typeCast x = typeCast' () x +instance TypeCast'' t a b => TypeCast' t a b where typeCast' = typeCast'' +instance TypeCast'' () a a where typeCast'' _ x = x diff --git a/liboleg.cabal b/liboleg.cabal --- a/liboleg.cabal +++ b/liboleg.cabal @@ -1,5 +1,5 @@ name: liboleg -version: 0.2 +version: 2009.8.1 license: BSD3 license-file: LICENSE author: Oleg Kiselyov @@ -22,6 +22,8 @@ exposed-modules: Data.FDList + Data.Class1 + Data.Class2 Control.CaughtMonadIO