;
; define-opaque.scm
; 0.3
;
; SPDX-FileCopyrightText: In 2023, Chris Pressey, the original author of this work, placed it into the public domain.
; SPDX-License-Identifier: Unlicense
; For more information, please refer to <https://unlicense.org/>
;

; ------ Helper Macros ------

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

(define-syntax opaque-ops
  (syntax-rules ()
    ((opaque-ops target args ())
      (error "Undefined operation:" target))
    ((opaque-ops target args (op rest ...))
      (if (equal? (car 'op) target) (opaque-op op args) (opaque-ops target args (rest ...))))))

; ------ Method 1 from article: ADT ------

(define-syntax define-opaque-adt
  (syntax-rules ()
    ((define-opaque-adt name make-name open-name priv priv-default ops)
      (define name
        (let* ((secret-token (list 1)))
          (letrec
            (
              (make-name (lambda (priv)
                (lambda (target . args)
                  (if (and (eq? target secret-token) (null? args))
                    priv
                    (opaque-ops target args ops)))))
              (open-name (lambda (instance)
                (instance secret-token)))
            )
            (make-name priv-default)))))))

; ------ Method 3 from article: Immutable Object ------

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

; ------ compatibility with older versions ------

(define-syntax define-opaque
  (syntax-rules ()
    ((define-opaque name make-name privs priv-defaults ops)
      (define-opaque-object name make-name privs priv-defaults ops))))