CLでSRFI-46 — #:g1

Posted 2012-05-26 07:49:00 GMT

CLでSRFI、今回は、SRFI-46の「Basic Syntax-rules Extensions」です。
syntax-rulesのellipsisの拡張で、繰り返しの記法が拡張されているのと、ユーザー定義のものが利用できるようになっています。

動作

(define-syntax fake-begin
  (syntax-rules ()
    ((fake-begin ?body *** ?tail)
     (srfi-46.internal::let* ((ignored ?body) ***) ?tail))))

(fake-begin (princ "hello,") (write-char #\space) (princ "world!") (terpri))

;==> (FUNCALL (LAMBDA (#:_IGNORED_48) (FUNCALL (LAMBDA (#:_IGNORED_49) (FUNCALL (LAMBDA (#:_IGNORED_50) (FUNCALL (LAMBDA () (TERPRI)))) (PRINC "world!"))) (WRITE-CHAR #\ ))) (PRINC "hello,")) ;>> hello, world! ;>> ;=> NIL

;;; Examples of the user-specified ellipsis token extension

;;; Utility macro for CPS macros (define-syntax apply-syntactic-continuation (syntax-rules () ((apply-syntactic-continuation (?k ?env ***) . ?args) (?k ?env *** . ?args))))

;;; Generates a list of temporaries, for example to implement LETREC ;;; (see below), and 'returns' it by CPS. (define-syntax generate-temporaries (syntax-rules () ((generate-temporaries ?origs ?k) (letrec-syntax ((aux (syntax-rules %%% () ;; We use a trick here: pass the continuation again ;; to AUX in case it contains ellipsis. If we stuck ;; it right into AUX's template, AUX would process the ;; ellipsis in ?K as ellipsis for something in the AUX ;; macro. ((aux ?temps () ?k*) (apply-syntactic-continuation ?k* ?temps)) ;; Be careful about the ellipsis! ((aux (?temp %%%) (?x ?more %%%) ?k*) (aux (?temp %%% new-temp) (?more %%%) ?k*))))) (aux () ?origs ?k)))))

(define-syntax test-letrec (syntax-rules () ((letrec ((?var ?init) ***) ?body1 ?body2 ***) (let-syntax ((k (syntax-rules %%% () ;; Use the same trick as with the continuations in ;; GENERATE-TEMPORARIES. Be careful about the ellipsis! ((k ((?var* ?init*) %%%) (?body1* ?body2* %%%) ;; Here are the actual arguments to the continuation ;; -- the previous bits of the pattern were just the ;; 'environment' of the continuation --: (?temp %%%)) (rnrs:let ((?var* '#:|unspecific|) ; Get an 'unspecific' value. %%%) (rnrs:let ((?temp ?init*) %%%) (rnrs:set! ?var* ?temp) %%% (rnrs:let () ?body1* ?body2* %%%))))))) (generate-temporaries (?var ***) ;; Pass K the environment. GENERATE-TEMPORARIES will add the ;; temporary variable list argument. (k ((?var ?init) ***) (?body1 ?body2 ***)))))))

(test-letrec ((fib (lambda (n) (if (< n 2) (funcall fib1 n) (+ (funcall fib (- n 1)) (funcall fib (- n 2)) )))) (fib1 (lambda (x) x)) ) (funcall fib 10) ) ;==> (FUNCALL (LAMBDA (#:_FIB_50 #:_FIB1_51) (FUNCALL (LAMBDA (#:_NEW-TEMP_52 #:_NEW-TEMP_53) (PROGN (SETQ #:_FIB_50 #:_NEW-TEMP_52) (SETQ #:_FIB1_51 #:_NEW-TEMP_53) (FUNCALL (LAMBDA () (FUNCALL #:_FIB_50 10))))) (LAMBDA (N) (IF (< N 2) (FUNCALL #:_FIB1_51 N) (+ (FUNCALL #:_FIB_50 (- N 1)) (FUNCALL #:_FIB_50 (- N 2))))) (LAMBDA (X) X))) '#:|unspecific| '#:|unspecific|) ;=> 55

(let-syntax ((foo (syntax-rules %%%0 () ((_ a %%%0) (let-syntax ((bar (syntax-rules %%%1 () ((_ b %%%1) (list :bar-expanded b %%%1 a %%%0))))) (bar :b1 :b2)))))) (foo 1 2 3)) ;=> (:BAR-EXPANDED :B1 :B2 1 2 3)

;;; This example demonstrates the hygienic renaming of the ellipsis ;;; identifiers.

(let-syntax ((f (syntax-rules () ((f ?e) (let-syntax ((g (syntax-rules %%% () ((g (??x ?e) (??y %%%)) '((??x) ?e (??y) %%%) )))) (g (1 2) (3 4)) ))))) (f %%%) ) ;=> ((1) 2 (3) (4))

移植について

ややこしそうなので移植は無理かなと思っていましたが、思いの外すんなり移植できました。
ただCLで動かす場合、展開されるシンボルがどのパッケージに属しているかで動きが変ってくるので、この辺りを調整する必要がありそうです。

comments powered by Disqus