Schemeで複合データを扱うには多値を用いるのが良い

2年ほど前に俺は『schemeで複合データを扱うには配列のパターンマッチングを用いるのが良い』というタイトルの記事を投稿した。

https://qiita.com/ossan-buhibuhi/items/a7633094b7b592408a75

パターンマッチによって複合データを楽に扱える旨を論じ、「俺的にschemeは極めて望ましい動的型付けの関数型言語となった」とまでのたまったのだが、実際にやってみるとかなりめんどいということが先日判明したw

要素の数が5個くらいまではいいのだが、それ以上になると正直やってられんくらいめんどい。どうしたもんかと悩んだ時に思い出したのが、この記事に触発されてどなたかが投稿されていた多値を用いる方法である。

	(let ((p '(point-2d 1 2)))
	  (call-with-values (lambda ()
	                      (apply values (cdr p)))
	    (lambda (p.x p.y)
	      (+ p.x p.y))))
	-> 3

たしかこんな感じで複合データの各要素をローカル変数にバインドするマクロを紹介されていたと思うのだが、読み返そうとしても記事が見つからない。で、多分こんな感じだったというおぼろげな記憶を頼りに再現してみたのが以下のソースである。chickenとs7で動いたから他の環境でも大丈夫なはずだ。

	; composite.scm

	(define make-symbol
	  (lambda args
	    (string->symbol
	      (apply string-append
	        (map (lambda (arg)
	               (if (symbol? arg)
	                 (symbol->string arg)
	                 arg))
	          args)))))

	(define-macro (mimic type var . binds)
	  (let ((call (make-symbol type "=")))
	    `(and (eq? (quote ,type) (car ,var))
	       (,call ,var ,@binds))))

	(define (composite? one)
	  (and (pair? one)
	    (pair? (cdr one))
	    (symbol? (car one))))

	(define (do-define-composite name vars)
	  (let ((is-name (make-symbol name "?"))
	        (as-name (make-symbol name "*"))
	        (mimic-name (make-symbol name "=")))
	    `(begin
	       (define-macro (,mimic-name sym . binds)
	         (let ((args (map (lambda (var)
	                            (let ((bind (assq var binds)))
	                              (if bind
	                                (cadr bind)
	                                (make-symbol sym "." var))))
	                       (quote ,vars))))
	           (append (list (quote ,name)) args)))
	       (define-macro (,as-name var . body)
	         (let ((body (cons 'begin body))
	               (vars (map (lambda (sym)
	                            (make-symbol var "." sym))
	                       (quote ,vars))))
	           (list 'call-with-values (list 'lambda '() (list 'apply 'values (list 'cdr var)))
	             (list 'lambda vars body))))
	       (define (,is-name one)
	         (and (composite? one)
	           (eq? (car one) (quote ,name))))
	       (define (,name ,@vars)
	         (list (quote ,name) ,@vars)))))

	(define-macro (define-composite name vars)
	  (do-define-composite name vars))

	(define (do-as var type body)
	  (let ((call (make-symbol type "*")))
	    `(if (eq? (quote ,type) (car ,var))
	       (,call ,var ,@body)
	       #f)))

	(define (do-ases--let-binds ases)
	  (let loop ((ases ases)
	             (ret '()))
	    (if (null? ases)
	      (reverse ret)
	      (let ((as (car ases)))
	        (let ((var (cadr as))
	              (type (car as)))
	          (loop (cdr ases)
	            (cond
	              ((pair? var)
	               (let ((var (car var))
	                     (args (cdr var)))
	                 (cons `(,var (,type ,@args)) ret)))
	              ((not (null? (cddr as)))
	               (let ((val (caddr as)))
	                 (cons `(,var ,val) ret)))
	              (else ret))))))))

	(define (do-ases--as ases body)
	  (if (null? ases)
	    body
	    (let ((as (car ases)))
	      (let ((var (let ((var (cadr as)))
	                   (if (pair? var)
	                     (car var)
	                     var)))
	            (type (car as)))
	        (let ((body (do-ases--as (cdr ases) body)))
	          (list (do-as var type body)))))))

	(define (do-ases ases body)
	  (if (null? ases)
	    `(begin ,@body)
	    (let ((binds (do-ases--let-binds ases))
	          (as (car (do-ases--as ases body))))
	      (if (null? binds)
	        as
	        `(let ,binds ,as)))))

	(define-macro (as ases . body)
	  (do-ases ases body))

マクロの中でマクロを定義するのが俺的にはすごーく大変だった。使い方は、

	; 型定義
	(define-composite 型名 (要素名 ...))

	; 構築
	(型名 要素名 ...)

	; composite型か調べる
	(composite? 値)

	; 特定のcomposite型か調べる
	(型名? 値)

	; composite変数の各要素をローカル変数にバインドする
	(as ((型名 変数名) または (型名 (変数名 引数 ...)) または　(型名 変数名 値)
	     ...)
	  [手続き ...]
	  戻り値)

	; composite変数の一部要素を改変した新しいcompositeを作成する。
	(mimic 型名 変数名
	  (要素名 値)
	  ...)

compositeとかasとかいった名前は全て俺が適当に考えた。例は、

	(define-composite point-2d (x y))
	(define-composite line-2d (x1 y1 x2 y2))

	(let ((p1 (point-2d 1 2)))
	  (as ((point-2d p1) ; (型名 変数名)
	       (point-2d (p2 3 4))) ; (型名 (変数名 引数 ...))
	    (as ((line-2d l (line-2d p1.x p1.y p2.x p2.y))) ; (型名 変数名 値)
	      (mimic line-2d l
	        (x2 5)
	        (y2 6)))))
	-> (line-2d 1 2 5 6)

composite型はただのリストだから、equal?で比較したりwrite/readで書き出しや読み込みができる。ちょっと使ってみたけど、便利だった。

元となる記事を書いてくださった方、今となってはお名前も何も思い出せませんが、この場を借りてお礼申し上げます。ありがとね〜w

いじょう