#lang scheme
;;; Some syntactic sugar over units to make using them as typeclasses easier.
(provide define-constrained define-instance)

;; Helper for building symbol syntax objects.
(define-for-syntax (string->syntax stx str)
  (datum->syntax stx (string->symbol str)))

;; Macro for defining type class-constrained functions.
(define-syntax (define-constrained stx)
  (syntax-case stx (=>)
    [(_ (name constraints => . args) . exprs) 
     (let ((impls (build-list (length (syntax->list #'constraints))
                              (λ(i) (string->syntax #'name (format "i~a" i))))))
       #`(define (name #,@impls)
           #,@(for/list ([impl (in-list impls)]
                         [constraint (in-list (syntax->list #'constraints))])
                        #`(define-values/invoke-unit #,impl 
                            (import)
                            (export #,constraint)))
           (λ args 
             #,@#'exprs)))]))

;; Macro for defining type class instances.
(define-syntax define-instance
  (syntax-rules ()
    [(_ (typeclasses ...) name exprs ...) (define-unit name
                                            (import)
                                            (export typeclasses ...)
                                            exprs ...)]
    [(_ typeclass name exprs ...) (define-unit name
                                    (import)
                                    (export typeclass)
                                    exprs ...)]))