2021年10月16日: Scheme、ドット記法

2021-10-16: Scheme、ドット記法

2021年10月16日 15時53分

Scheme でユーザー定義の構造的なデータを使う時にドット記法のアクセッサーを使いたい場合がある。どんな構造データでもだいたい同じようなマクロになるから一例をテンプレートとしてメモ。

;; emplyoee 型の定義

(define (employee name email section)
  (list 'employee name email section))

;; employee 型データのドット記法のアクセッサー・マクロ

(define-syntax with-employees
  (lambda (so)
    (syntax-case so ()
      ((_ () %code)
        (syntax %code))

      ((_ () %code %codes ...)
        (syntax (begin %code %codes ...)))

      ((_ (%employee %employees ...) %code %codes ...)
        (identifier? (syntax %employee))
        (let
          ((dot (lambda (var suffix)
            (datum->syntax var (string->symbol
              (string-append
                (symbol->string (syntax->datum var))
                suffix))))))

          (with-syntax
            (
            (%.name     (dot (syntax %employee) ".name"   ))
            (%.email    (dot (syntax %employee) ".email"  ))
            (%.section  (dot (syntax %employee) ".section"))
            )
            (syntax
              (let-syntax
                (
                (%.name
                  (identifier-syntax
                    (_ (cadr %employee))
                    ((set! _ new-name) (set-car! (cdr %employee) new-name))))

                (%.email
                  (identifier-syntax
                    (_ (caddr %employee))
                    ((set! _ new-email) (set-car! (cddr %employee) new-email))))

                (%.section
                  (identifier-syntax
                    (_ (cadddr %employee))
                    ((set! _ new-section) (set-car! (cdddr %employee) new-section))))
                )
                (with-employees (%employees ...)
                  %code %codes ...)))))))))

(define jg (employee "Jameel Green" "[e-mail]" "Sales"  ))
(define rs (employee "Roza Scott"   "[e-mail]" "Finance"))

(with-employees (jg rs)
  (display "Before: ") (display jg.section) (newline)
  (write jg) (newline)
  (newline)

  (set! jg.section "Marketing")

  (display "After: ") (display jg.section) (newline)
  (write jg) (newline))

Before: Sales
(employee "Jameel Green" "[e-mail]" "Sales")

After: Marketing
(employee "Jameel Green" "[e-mail]" "Marketing")