正規表現に慣れすぎていて、構文解析とかやったことない。しかし避けても通れそうにないので、「10分で書ける、お手軽パーザー」というサイトを参考に四則演算のパーズに挑戦してみることにした。目標は1時間（つまり昼休み）。

10分で書ける、お手軽パーザー
http://fxp.hp.infoseek.co.jp/arti/parser.html

ところで、このサイトの構文定義っておかしくない？　左から解析することを前提にすると、オペレータの右側は必ず Expr のはず。

Expr = Term { (+|-) Term }
Term = Fact { (*|/) Fact }
Fact = ( Expr ) | number
↓
Expr = Term { (+|-) Expr }
Term = Fact { (*|/) Expr }
Fact = ( Expr ) | number

とにかくやってみる。計算の優先順位を示すカッコのパーズは省略。

;; 10minutes-parser.scm
;; 2006/2/1
;; k16.shikano
;; inspired from http://fxp.hp.infoseek.co.jp/arti/parser.html

; Expr = Term { (+|-) Expr }
; Term = Fact { (*|/) Expr }
; Fact = Expr | number

(define left car)
(define op cadr)
(define right caddr)

(define-syntax or-match
  (syntax-rules ()
    ((_ e0 e1 e2 ...)
     (call-with-values
      (lambda ()
        (let R ((ls e0))
          (cond ((null? ls)
                 (values '() '() '()))
                ((or (char=? (car ls) e1)
                     (char=? (car ls) e2)
                     ...)
                 (values '() (car ls) (cdr ls)))
                (else 
                 (call-with-values
                     (lambda () (R (cdr ls)))
                   (lambda (l o r) (values (cons (car ls) l) o r)))))))
      list))))

(define (expr ls)
  (let ((parsed (or-match ls #\+ #\-)))
    (let ((l (left parsed))
          (r (right parsed))
          (o (op parsed)))
      (cond ((null? o)
             (term l))
            ((char=? o #\+)
             (+ (term l) (expr r)))
            ((char=? o #\-)
             (- (term l) (expr r)))
            (else 
             (error "unrecognize expr"))))))

(define (term ls)
  (let ((parsed (or-match ls #\* #\/)))
    (let ((l (left parsed))
          (r (right parsed))
          (o (op parsed)))
      (cond ((null? o)
             (fact l))
            ((char=? o #\*)
             (* (fact l) (expr r)))
            ((char=? o #\/)
             (/ (fact l) (expr r)))
            (else 
             (error "unrecognize term"))))))

(define (fact ls)
  (define (list->integer ls)
    (let F ((ls ls) (added 0))
      (let ((car-int (digit->integer (car ls))))
        (if (null? (cdr ls))
            (+ car-int added)
            (F (cdr ls) (* (+ car-int added) 10))))))
  (if (not (char-numeric? (car ls)))
      (error "unrecognize fact")
      (list->integer ls)))

実行結果

gosh> (expr (string->list "1+3*2"))
7

なんとか昼休みで終わらせたので、不都合があるかもしれない。
もちろん、今日の昼休みだけで全部作れたわけはなく、昨晩から or-match の部分は考えていた。この方法を Scheme で書くには、こんなふうに多値を使わざるをえないように思える（この使い方が洗練されているかどうかはおいといて）。それが面倒。