type-class.scm

(import (picrin base))


(define-class <bool>
  boolean?)

(define-class <value>
  (lambda (x) #t))


; SHOW

(define-type-class (SHOW t)
  (show t))

(define-instance (SHOW <bool>)
  (lambda (x)
    (if x "true" "false")))

(define-instance (SHOW <list>)
  show-list)

(define (show-list x)
  (if (null? x)
      "()"
      (string-append "(" (show (car x)) " . " (show (cdr x)) ")")))


; APPEND

(define-type-class (APPEND t)
  (append t t))

(define-instance (APPEND <list>)
  list-append)

(define-instance (APPEND <string>)
  string-append)

(define-instance (APPEND <vector>)
  vector-append)


; ADD

(define-type-class (ADD t u)
  (add t u))

(define-instance (ADD <number> <number>)
  +)

(define-instance (ADD <vector> <vector>)
  (cut vector-map add <> <>))


(show #true) ;=> "true"
(show #false) ;=> "false"
(show '(true false false)) ;=> "(true . (false . (false . ())))"
(show '(true 1)) ;=> error: no instance definition for (SHOW 1)