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