git @ Cat's Eye Technologies define-opaque / master src / define-opaque-0.1.scm
master

Tree @master (Download .tar.gz)

define-opaque-0.1.scm @masterraw · history · blame

(define-syntax opaque-op
  (syntax-rules ()
    ((opaque-op (name body) args)
      (apply body args))))

(define-syntax opaque-ops
  (syntax-rules ()
    ((opaque-ops target args ())
      (begin
        (display "Undefined operation ") (display target) (newline) #f))
    ((opaque-ops target args (op rest ...))
      (if (equal? (car 'op) target) (opaque-op op args) (opaque-ops target args (rest ...))))))

(define-syntax define-opaque
  (syntax-rules ()
    ((define-opaque name make-name privs ops)
      (define name
        (letrec
          (
            (make-name (lambda privs
              (lambda (target . args)
                (opaque-ops target args ops))))
          )
          (make-name '()))))))