Let's start Scheme

2012-08-27

SRFI-105を試してみる。

リーダをいじる系のSRFIを割りと簡単に試すことが出来るのもSagittariusの特徴の一つだと信じているので、早速新SRFIを試してみる。
(自分でも使い方忘れてて、ドキュメントを探したのは内緒だ)
;; 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