(自分でも使い方忘れてて、ドキュメントを探したのは内緒だ)
;; 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