(自分でも使い方忘れてて、ドキュメントを探したのは内緒だ)
;; From reference implementation ;; Return true if lyst has an even # of parameters, and the (alternating) ;; first parameters are "op". Used to determine if a longer lyst is infix. ;; If passed empty list, returns true (so recursion works correctly). (define (even-and-op-prefix? op lyst) (cond ((null? lyst) #t) ((not (pair? lyst)) #f) ((not (eq? op (car lyst))) #f) ; fail - operators not the same ((not (pair? (cdr lyst))) #f) ; Wrong # of parameters or improper (else (even-and-op-prefix? op (cddr lyst))))) ; recurse. ;; Return true if the lyst is in simple infix format ;; (and thus should be reordered at read time). (define (simple-infix-list? lyst) (and (pair? lyst) ; Must have list; '() doesn't count. (pair? (cdr lyst)) ; Must have a second argument. (pair? (cddr lyst)) ; Must have a third argument (we check it ; this way for performance) (symbol? (cadr lyst)) ; 2nd parameter must be a symbol. (even-and-op-prefix? (cadr lyst) (cdr lyst)))) ; true if rest is simple ;; Return alternating parameters in a list (1st, 3rd, 5th, etc.) (define (alternating-parameters lyst) (if (or (null? lyst) (null? (cdr lyst))) lyst (cons (car lyst) (alternating-parameters (cddr lyst))))) ;; Not a simple infix list - transform it. Written as a separate procedure ;; so that future experiments or SRFIs can easily replace just this piece. (define (transform-mixed-infix lyst) (cons 'nfx lyst)) ;; Given curly-infix lyst, map it to its final internal format. (define (process-curly lyst) (cond ((not (pair? lyst)) lyst) ; E.G., map {} to (). ((null? (cdr lyst)) ; Map {a} to a. (car lyst)) ((and (pair? (cdr lyst)) (null? (cddr lyst))) ; Map {a b} to (a b). lyst) ((simple-infix-list? lyst) ; Map {a OP b [OP c...]} to (OP a b [c...]) (cons (cadr lyst) (alternating-parameters lyst))) (else (transform-mixed-infix lyst)))) ;; set macro characters (set-macro-character #\{ (lambda (p c) (process-curly (read-delimited-list #\} p)))) (set-macro-character #\} (lambda (p c) (error '|}-reader| "unexpected #\\}"))) ;; test (print '{a + b}) (print '{a * {b + c}}) #| ;; output (+ a b) (* a (+ b c)) |#なんとお手軽。
ポイントは、閉じ括弧もリードマクロとしてマークすること。じゃないとread-delimited-listがnon-termな文字として識別しちゃうので、意味不明のエラーが出て悩む。(ってか、3分くらい悩んだ・・・orz)
これくらいお手軽に試せるからいいけど、そうじゃない処理系はこれを入れる気になるんだろうか?そこまで中置記法にこだわる理由が(もはや)分からない。
No comments:
Post a Comment