Trait

A trait/typeclass system for Chicken Scheme, inspired by Type Classes Without Types. But currently my implementation is in a very early stage, so it's much more simpler and inferior than the one described in the paper.

I prefer the name typeclass, but there has been an egg named typeclass already. So I borrowed the word trait from Rust.

Code is hosted on SourceHut.

API

define-trait

(define-trait <name>
  (<func-name> [default-implementation])
  ...)

Define a trait. Default implementation is optional. When defined in a module, you need to export <name> and every <func-name> to use the trait.

define-trait-impl

(define-trait-impl (<trait> <type-pred>)
  (<func-name> <function-impl>)
  ...)

Define the implementation of a trait for objects satisfying <type-pred>. Unimplemented functions in trait will fallback to default implementation.

When calling <func-name>, implementations will be selected by the first argument of the function call.

with-type-of

(with-type-of <object> <trait> <func-name>)

Sometimes the implementation of a function cannot be decided though the arguments, in such case, with-type-of can give you the implementation through specifying the object.

define-overload

(define-overload (<func-name> (<param> <pred>)|<param> ...))

Overload a function by type predicates to make it generic.

Examples

Eq

(import trait)

(define-record point x y)

(define-trait Eq
  (==)
  ;; with a default implementation
  (/= (lambda (a b) (not (== a b)))))

(define-trait-impl (Eq number?)
  (== =))

(define-trait-impl (Eq symbol?)
  (== eq?))

(define-trait-impl (Eq list?)
  (== equal?))

(define-trait-impl (Eq point?)
  (== (lambda (a b) (and (point? b)
                         (= (point-x a) (point-x b))
                         (= (point-y a) (point-y b))))))

(display (list (== 'a 'a)
               (/= 'a 'a)

               (== 1 1)
               (/= 1 1)

               (== 1 2)
               (/= 1 2)

               (== (list 1 2) (list 1 2))
               (/= (list 1 2) (list 1 2))

               (== (make-point 3 4) (make-point 3 4))
               (/= (make-point 3 4) (make-point 3 4))))

Monad

(import trait)

(define-trait Monad
  (>>=)
  (return))

(define-record nullable is-null value)
(define (make-some value)
  (make-nullable #f value))
(define (make-null)
  (make-nullable #t '()))
(define (nullable-type x)
  (if (nullable-is-null x)
      'null
      'some))

(define-trait-impl (Monad nullable?)
  (>>= (lambda (m f)
         (let ((type (nullable-type m)))
           (cond ((eq? type 'null)
                  (make-null))
                 ((eq? type 'some)
                  (f (nullable-value m)))))))
  (return make-some))

(define (*2 a)
  (make-some (* 2 a)))

(display (nullable-value (>>= (make-some 3) *2)))
(newline)

;; For a function in trait, the implementation is selected by
;; applying the predicates to the first argument.
;; When the varaible of related type is the return value or
;; the 2nd/3rd/... argument, use (with-type-of var trait function)
;; to get the right function.
(define x (make-some 42))
(let ((return (with-type-of x Monad return)))
  (display (nullable-value (return 99))))

With Multiple Modules

(module define-macro (define-macro)
  ;; import
  (import scheme
  	  (chicken syntax))
  ;; body
  (define-syntax define-macro
    (er-macro-transformer
     (lambda (exp r c)
       (let ((def (cadr exp))
  	   (body (cddr exp)))
         `(define-syntax ,(car def)
  	  (er-macro-transformer
  	   (lambda (e2 r2 c2)
  	     (define (transform-func ,@(cdr def))
  	       ,@body)
  	     (apply transform-func (cdr e2)))))))))
)

(module Eq (Eq == /=)
  (import scheme
          (chicken base)
          trait)

  (define-trait Eq
    (==)
    (/= (lambda (a b)
          (display ==) (newline)
          (not (== a b)))))
)

(module point (point?
               make-point
               point==?
               impl-point-traits)
  (import scheme
          (chicken base)
          Eq
          trait
          define-macro)

  (define-record point x y)

  (define (point==? a b)
    (and (point? a)
         (point? b)
         (= (point-x a) (point-x b))
         (= (point-y a) (point-y b))))
  
  ;; trait implementations should be defined as macros
  ;; to export to other modules
  (define-macro (impl-point-traits)
    '(define-trait-impl (Eq point?)
       (== point==?)))
)

(module mymodule ()
  (import scheme
          (chicken base)
          trait
          Eq
          point)
  
  ;; import trait implementation
  (impl-point-traits)

  (display (== (make-point 1 2) (make-point 1 2)))
  (newline)
  (display (/= (make-point 1 2) (make-point 1 2)))
  (newline)
)

Multiparam

(import trait)
(import (chicken condition))

(define-record point x y)

(define (multiply a b)
  (abort "`multiply` not implemented."))

(define-overload (multiply (a number?) (b point?))
  (make-point (* a (point-x b)) (* a (point-y b))))

(define-overload (multiply (a point?) (b number?))
  (multiply b a))

(define-overload (multiply (a number?) (b number?))
  (* a b))

(define-overload (multiply (a point?) (b point?))
  (+ (* (point-x a) (point-x b))
     (* (point-y a) (point-y b))))

(display (list (multiply 1 2)
               (multiply 1 (make-point 3 4))
               (multiply (make-point 5 6) 7)
               (multiply (make-point 8 9) (make-point 10 11))))
(newline)

License

This library is BSD licensed, see LICENSE for details.