typeclasses considered unnecessary/the power of the @

Haskell 98/2010 keeps a strict distinction between term-level syntax and tokens vs type-level. With ExplicitTypeApplications that's being eased: there's a lightweight way to sneak a type expression into a term. And ghc's internal term language 'core' has had explicit type applications for many years. Then consider a lightweight syntax using type applications in patterns to define typeclass instances by (pattern) 'matching' on types:
(==) @Int x y = primEqInt x y -- or eta-reduced (==) @Int = primEqInt -- shorthand for
instance Eq Int where (==) = primEqInt
Given that many typeclasses have a single method (or one base method with others defined in terms of it) [Note **], having to invent a typeclass name is a bit of a pain. Here's a lighweight method decl:
meth :: @a @b. => a -> b -> Bool -- typevar binding to left of => (there might also be superclass constraints) -- shorthand for
class Classfor_meth a b where -- generated class name meth :: a -> b -> Bool
Do we need class names at all? We could sneak term-level names into types. Just use the method name in constraints (with some handy syntactic marking -- what could be better than prefix @):
meth2 :: (@meth a b, @show b) => a -> b -> String meth2 x y = if (meth x y) then show y else "blah"
Of course we can infer the constraints on `meth2`, given its equation. Note **: for some of the Prelude's classes with many methods, like Num, there's long-standing complaints that the methods are too much tangled up and should be refactored into a hierarchy with a single method in each class: Additive, Multiplicative, Divisive, etc. With type families we can tackle the classic collections class (with methods empty, insert) as a superclass constraint , er, supermethod method:
type family Elem c :: * insert @c. => c -> Elem c -> c
empty :: @c. (@insert c) => c -- entangle empty with insert
Likewise for Monad:
(>>=) :: @m. => (m a) -> (a -> m b) -> (m b)
return :: @m. (@>>= m) => a -> m a
The soon-to-arrive Quantified Constraints extension will provide further ways to entangle methods/constraints. That might be an alternative way to express collections:
insert @c @e. (e ~ Elem c) => c -> e -> c
empty @c. (forall e. @insert c e => @empty c) => c
Of course all the above syntax is speculative/bikesheddable. The syntax needs to differentiate tyvars that are parameters/overloadable to the class/method vs parametric free tyvars. With explicit forall:
(>>=) :: forall m a b. @m. => (m a) -> (a -> m b) -> (m b)
return :: forall m a. @m. (@>>= m) => a -> m a
Or perhaps method signatures should look more like methods-as-constraints -- at cost of a bit of repetition
(>>=) :: forall m a b. (@>>= m) => (m a) -> (a -> m b) -> (m b)
return :: forall m a. (@return m, @>>= m) => a -> m a
AntC

On 2018-05-16 04:09, Anthony Clayden wrote:
Haskell 98/2010 keeps a strict distinction between term-level syntax and tokens vs type-level.
With ExplicitTypeApplications that's being eased: there's a lightweight way to sneak a type expression into a term. And ghc's internal term language 'core' has had explicit type applications for many years.
Then consider a lightweight syntax using type applications in patterns to define typeclass instances by (pattern) 'matching' on types: [--snip--]
An interesting post, but I don't see any mention of laws. This seems like it could be an... issue. (Not that we specify laws in the code anyway right now, but at least there's some idea of a "thing" we can attach the laws to and where we can document them.) Regards,

On 2018-05-16 04:09, Anthony Clayden wrote:
Haskell 98/2010 keeps a strict distinction between term-level syntax and tokens vs type-level.
With ExplicitTypeApplications that's being eased: there's a lightweight way to sneak a type expression into a term. And ghc's internal term language 'core' has had explicit type applications for many years.
Then consider a lightweight syntax using type applications in patterns to define typeclass instances by (pattern) 'matching' on types:
(==) @Int x y = primEqInt x y -- or eta-reduced (==) @Int = primEqInt -- shorthand for
instance Eq Int where (==) = primEqInt
Given that many typeclasses have a single method (or one base method with others defined in terms of it) [Note **], having to invent a typeclass name is a bit of a pain. Here's a lighweight method decl:
meth :: @a @b. => a -> b -> Bool -- typevar binding to left of => (there might also be superclass constraints) -- shorthand for
class Classfor_meth a b where -- generated class name meth :: a -> b -> Bool
As Oleg Kiselyov pointed out over a decade ago, all typeclasses can be reduced to just one, namely [1] class C l t | l -> t where ac :: l -> t Which in turn is basically an untagged version of the HasField typeclass that's being used to create overloaded records. [2] class HasField (x :: k)r a | x r -> a where getField :: r -> a (Not very surprising, because classes are basically compile-time records) In other words 1. You only have one class to replace (left as an exercise to the reader) 2. I don't think you need any fancy new tricks or syntax for multi-function classes 3. You might be able to also implement records with just type application and type families Cheers, MarLinn [1] http://okmij.org/ftp/Haskell/Haskell1/Haskell1.txt [2] https://github.com/adamgundry/ghc-proposals/blob/overloaded-record-fields/pr...

On 2018-05-16 04:24:15 UTC 2018, Bardur Arantsson wrote:
An interesting post, but I don't see any mention of laws. This seems like it could be an... issue.
(Not that we specify laws in the code anyway right now, but at least there's some idea of a "thing" we can attach the laws to and where we can document them.)
Thanks Bardur, I don't see an issue. Currently the laws are specified in terms of equivalences between method calls, not in terms of classes. Furthermore the laws might involve methods from many different classes. So we can attach the laws to the methods. For example, the Monad laws mention not only `return` and (>>=) but also `fmap`, `pure`, (*>), etc. Note that the classes in the Prelude are all single parameter, in compliance with H98; so it's unambiguous which type instantiation the laws are talking about. That can all be handled I think through the 'supermethod methods' I talked about (which play the role of superclass constraints). For example in making the Num class redundant, we require (+) to be a supermethod of (*); and (*) to be a supermethod of (/). AntC
participants (3)
-
Anthony Clayden
-
Bardur Arantsson
-
MarLinn