Hask-- I mean, psilo with zero real typeclasses and one virtual typeclass

psilo-typeclass.sl

;; Hask-- I mean, psilo with no real typeclasses and one virtual typeclass.
;  Inspired by [1], this is an exploration of representing all typeclasses
;  through one distinguished class.
;
;  This version of psilo does not have "real" typeclasses. However faking them
;  with explicit dictionary passing does seem to correctly infer and check the
;  constraints.
;
;  The goal then is to figure out how best to represent "real" typeclasses as a
;  distinguished feature in the language implementation given that we are
;  already capable of performing all the necessary logic.

; [1]: https://mail.haskell.org/pipermail/haskell/2007-March/019181.html

;; Utility functions
(= id (x) x)
(= bottom bottom)

;; A phantom type to declare typeclasses. Usage near the end.
(:: Class (a))

;; Our pseudo-typeclass, C.
;  `l` is a label type instantiated with bottom.
;  `t` is the type of the method we are associating with the constraint.
(:: C (l t)
  (forall (r)
  (->
    (->
      (-> l t)
      r)
    r)))

; C instance constructor
(: c (-> (-> l t) (C l t)))
(= c (lt) (C (\ (k) (k lt))))

; C instance destructor. Gets the method associated with the constraint.
(: ac (-> (C l t) t))
(= ac (c) (((~C c) id) bottom))

;; The Num typeclass

; Method representations as phantom types.
(:: Add (a))
(: add-method (-> (C (Add a) (-> a a a)) (-> a a a)))
(= add-method ac)

(:: Mul (a))
(: mul-method (-> (C (Mul a) (-> a a a)) (-> a a a)))
(= mul-method ac)

(:: FromInt (a))
(: from-int-method (-> (C (FromInt a) (-> Int a)) (-> Int a)))
(= from-int-method ac)

(:: Num (n)
  (forall (r)
    (->
      (->
        (-> n n n) ; +
        (-> n n n) ; *
        (-> Int n) ; from-int
        r)
      r)))

; Num instance constructor.
(: num-instance (-> (C (Add a) (-> a a a))
                    (C (Mul a) (-> a a a))
                    (C (FromInt a) (-> Int a))
                    (C (Class (Num a)) (Num a))))
(= num-instance (add-impl mul-impl fromint-impl)
  (c (\ (ignore) (Num (\ (k)
    (k (add-method add-impl)
       (mul-method mul-impl)
       (from-int-method fromint-impl)))))))

;; The actual, honest-to-goodness method functions

(: + (-> (C (Class (Num a)) (Num a)) (-> a a a)))
(= + (num-impl)
  ((~Num (ac num-impl))
   (\ (_1 _2 _3) _1)))

(: * (-> (C (Class (Num a)) (Num a)) (-> a a a)))
(= * (num-impl)
  ((~Num (ac num-impl))
   (\ (_1 _2 _3) _2)))

(: from-int (-> (C (Class (Num a)) (Num a)) (-> Int a)))
(= from-int (num-impl)
  ((~Num (ac num-impl))
   (\ (_1 _2 _3) _3)))

;; Num instances
(: c-float-add (C (Add Float) (-> Float Float Float)))
(= c-float-add (c (\ (ignore) float-add)))

(: c-float-mul (C (Mul Float) (-> Float Float Float)))
(= c-float-mul (c (\ (ignore) float-mul)))

(: c-float-fromint (C (FromInt Float) (-> Int Float)))
(= c-float-fromint (c (\ (ignore) float-fromint)))

(: num-float (C (Class (Num Float)) (Num Float)))
(= num-float (num-instance c-float-add c-float-mul c-float-fromint))

(: c-int-add (C (Add Int) (-> Int Int Int)))
(= c-int-add (c (\ (ignore) int-add)))

(: c-int-mul (C (Mul Int) (-> Int Int Int)))
(= c-int-mul (c (\ (ignore) int-mul)))

(: c-int-fromint (C (FromInt Int) (-> Int Int)))
(= c-int-fromint (c (\ (ignore) id)))

(: num-int (C (Class (Num Int)) (Num Int)))
(= num-int (num-instance c-int-add c-int-mul c-int-fromint))

;; Drumroll please ...

(: square (-> (C (Class (Num a)) (Num a)) (-> a a)))
(= square (num-impl) (\ (x) ((* num-impl) x x)))

;; And now the Functor typeclass.

; It looks like the explicit instance is necessary in general.
(:: Map (f))
(: map-method
  (-> (C (Map f) (-> (-> a b) (f a) (f b)))
      (-> (-> a b) (f a) (f b))))
(= map-method ac)

(:: Functor (f)
  (forall (r)
  (->
   (->
      (forall (a b) (-> (-> a b) (f a) (f b))) ; map
      r)
    r)))

(: functor-instance (-> (C (Map f) (-> (-> a b) (f a) (f b)))
                        (C (Class (Functor f)) (Functor f))))
(= functor-instance (map-impl)
  (c (\ (ignore) (Functor (\ (k)
    (k (map-method map-impl)))))))

(: map (-> (C (Class (Functor f)) (Functor f))
           (-> (-> a b)
               (f a)
               (f b))))
(= map (functor-impl)
  ((~Functor (ac functor-impl))
   (\ (map-method) map-method)))

; An example thing that could be a functor
(:: Box (a) (forall (r) (-> (-> a r) r)))
(: box (-> a (Box a)))
(= box (x) (Box (\ (k) (k x))))
(: unbox (-> (Box a) a))
(= unbox (bx) ((~Box bx) id))

(: box-map (C (Map Box) (-> (-> a b) (Box a) (Box b))))
(= box-map (c (\ (ignore) (\ (f bx) (box (f (unbox bx)))))))

(: box-functor (C (Class (Functor Box)) (Functor Box)))
(= box-functor (functor-instance box-map))

(: is-even? (-> Float Boolean))
(= is-even? (n) (not (float=? 0.0 (float-modulo n 2.0))))

(: box-1 (Box Float))
(= box 3.0)

(: box-2 (Box Boolean))
(= box-2 ((map box-functor) is-even? box-1))

; correctly infers "Boolean"
(= map-result (unbox box-2))