健全なマクロ展開 - dotted-list の展開

ここまで書いてきた展開器は、 λ構文の仮引数が正規リストに限っていました。 Scheme のλ構文の仮引数部はドッテッド・リストであっても良く、 束縛変数を可変長の実引数のリストに束縛できるようになっています。

((lambda x (apply + x)) 2 3 4 5) ;=> 14

Hanson-Bawden 展開器を、 ドッテッド・リストの仮引数を扱えるように修正するやりかたを考えてみます。 expand-lambda で、 仮引数部を正規リストに作り直して構文環境を置換規則で拡張し、 拡張した構文環境下で、 元のドッテッド・リストを作ったばかりの置換規則で置き換えるように変更します。

(define (sc-expand-lambda form env)
 (match form
  ((_ vars body ...)
   (sc-syntactic-env-subst (dotted-list->proper-list vars) env (lambda (env1)
    `(lambda
      ,(dotted-map (lambda (x) (sc-subst-name (sc-lookup x env1))) vars)
      ,@(sc-expand-list body env1)))))))

ついでに、 テンプレート等をマクロ展開できるように、 expand-list も正規リストでなくても展開できるようにしておきます。

(define (sc-expand-list form* env)
 (dotted-map (lambda (form) (sc-expand form env)) form*))

syntactic-env-subst は以前と同じですが、 継続に 拡張した構文環境だけを渡すように変更します。

(define (sc-syntactic-env-subst idents env kont)
 (let* ((uid (sc-generate-uid))
        (vars (map (lambda (x) (sc-gen-var (sc-unwrap x) uid)) idents))
        (frame (map (lambda (x x.i) (cons x (make-sc-subst x.i))) idents vars)))
  (kont (cons frame env))))

ドッテッド・リストから正規リストを作ります。 末尾のドット対の cdr を正規リストにしてリストをコピーします。

; x   => (x), (x . y) => (x y), (x y . z) => (x y z)
; (x) => (x), (x y)   => (x y), (x y z)   => (x y z)
(define (dotted-list->proper-list e)
 (cond
  ((pair? e) (cons (car e) (dotted-list->proper-list (cdr e))))
  ((null? e) '())
  (else (list e))))

ドッテッド・リスト版の map では、 元のドット対の構造のまま、 末尾のドット対の cdr 部も手続きで変換したリストを作ります。

(define (dotted-map f e)
 (cond
  ((pair? e) (cons (f (car e)) (dotted-map f (cdr e))))
  ((null? e) '())
  (else (f e))))

2018 年 2 月 17 日追記
Gauchemap* 手続きを使って書き直すことにしました。 次のような意味をもっており、 リストのペアを map していき、 ペアでない部分を tail-proc に渡します。

(define (map* proc tail-proc . args)
 (if (every pair? args)
  (cons (apply proc (map car args)) (apply map* proc tail-proc (map cdr args)))
  (apply tail-proc args)))

さらに、 構文チェック用に map* のようなドッテッド・リスト用の every* を作ります。 こちらは、 リスト 1 本用です。

(define (sc-every* proc tail-proc x)
 (if (pair? x)
  (and (proc (car x)) (sc-every* proc tail-proc (cdr x)))
  (tail-proc x)))

Hanson-Bawden λ構文の展開部を map* と every* で書き直します。 every* で仮引数が識別子の正規リストかドッテッド・リストかどうかをチェックします。 今度は、 ドッテッド・リストのままで、 新しく生成した変数に置き換えてから、 2 つのドッテッド・リストの要素同士をつないで連想リストを作ります。

(define sc-map* map*)

(define (sc-expand-lambda form env)
 (match form
  ((_ idents body ..1)
   (unless (sc-every* sc-identifier? (lambda (x) (or (null? x) (sc-identifier? x))) idents)
    (error "sc-expand invalid lambda form"))
   (let* ((uid (sc-generate-uid))
          (gen-var (lambda (x) (if (sc-identifier? x) (sc-gen-var (sc-strip x) uid) '())))
          (bind (lambda (x x.i) (cons x (make-sc-subst x.i))))
          (tail-bind (lambda (x x.i) (if (null? x) '() (list (bind x x.i)))))
          (vars (sc-map* gen-var gen-var idents))
          (frame (sc-map* bind tail-bind idents vars)))
    `(lambda ,vars ,@(sc-expand-list body (cons frame env)))))))