The worst piece of syntax in Haskell
kahl at cas.mcmaster.ca
kahl at cas.mcmaster.ca
Wed Feb 22 09:17:16 EST 2006
Ashley Yakeley <ashley at semantic.org> wrote:
>
> Josef Svenningsson wrote:
>
> > This is one of the things that the Clean people got right. In Clean, my
> > examples from above would look like:
> >
> > > class MonadPlus m | Monad m where ...
> > >
> > > class Ix a | Ord a where ..
> > >
> > > instance Eq (Ratio a) | Integral a where ...
>
> Not quite the same complaint, but I've always been bothered by the
> inconsistent use of "=>". I would prefer "A => B" to mean "if A, then
> B". Accordingly:
>
> class Monad m <= MonadPlus m
> class Ord a <= Ix a
> instance Integral a => Eq (Ratio a)
> foo :: (Monad m) => [m a] -> m [a]
It may be useful to keep in mind how this would translate into the module
language of OCaml
(remember that in *ML, type application is written argument-first):
module type MonadPlus =
functor (M: Monad) ->
sig
type m 'a = 'a M.m
val mzero : 'a m
val mplus : 'a m -> 'a m -> 'a m
end;;
module type Eq =
sig
type t
val (==) : t -> t -> bool
val (/=) : t -> t -> bool
end;;
module IntegralRatioEq :: Eq
functor (I: Integral) ->
struct
type t = I.t ratio
let (==) = ...
end;
I am not claiming that all aspects of the syntax are more elegant,
but I think it makes the semantics clearer.
(Of course, OCaml does not have implicit module arguments,
so ``foo :: (Monad m) => [m a] -> m [a]'' has no direct translation.)
<plug>See also ``Named Instances for Haskell Type Classes'':
http://www.cas.mcmaster.ca/~kahl/Publications/Conf/Kahl-Scheffczyk-2001.html
</plug>
> > > instance Eq (Ratio a) | Integral a
Those who think of type classes as a medium for logic programming
might indeed prefer
instance Eq (Ratio a) :- Integral a
;-)
Wolfram
More information about the Haskell-prime
mailing list