Instantly share code, notes, and snippets.

Embed
What would you like to do?
Hask-- I mean, psilo with zero real typeclasses and one virtual typeclass
;; 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 (-> (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))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment