LISPUSER

中置記法については Functional Programming in Qi にサンプルがあるので、前置記法でやってみる。

まずは型とか考えずに作る。

(define evaluate
  [** X Y] -> (expt (evaluate X) (evaluate Y))
  [Op X Y] -> (Op (evaluate X) (evaluate Y)) where (element? Op [+ - * /])
  X -> X)

これでおっけー。

(29-) (evaluate [+ 1 2])
3
(30-) (evaluate [+ [** 2 10] [+ 10000 1]])
11025

カンタン。

演算子順位法で解析する。

(define precedence
  ** -> 3
  Op -> 2 where (element? Op [* /])
  Op -> 1 where (element? Op [+ -])
  _ -> 0)

(define parse
  X -> X where (or (number? X) (symbol? X))
  [X] -> (parse X)
  [X Op Y] -> [Op (parse X) (parse Y)]
  [X Op Y Op2 | Rest] -> (let N1 (precedence Op)
                              N2 (precedence Op2)
                           (if (> N2 N1)
                               [Op (parse X) (parse [Y Op2 | Rest])]
                               (parse [[X Op Y] Op2 | Rest])))
  _ -> (error "parse: type error"))

パーサは precedence の値に応じて処理していく。 結果は以下の通り。

(31-) (parse [10 + 8 / 2 * 7 - 4])
[+ 10 [- [* [/ 8 2] 7] 4]]

(32-) (evaluate (parse [10 + 8 / 2 * 7 - 4]))
34

しかし、これは Haskell とちがって実行時に解釈するため、 誤った式を入力されてもエラーが発生するのは実行時。 不正な式を書いてもコンパイルが通ってしまう。

(38-) (define f X -> (evaluate (parse X)))
f

(39-) (f [10 + +])
+: + is not a number

というわけで挑戦は続く。

実行時解釈では題意からちょっとずれるので、マクロ相当の登場。 Qi では従来のマクロも利用可能だが、 sugar function という仕組みが導入されている。 これは、システムに構文糖衣に使う関数（シュガーファンクション）を登録しておいて、 Qi が式の入出力を行うときにその関数を実行してくれる。

ちょっと形式が異なるので、パーサにも手を入れる。（※：これが正しいかは自信なし）

(define parse*
  X -> X where (or (number? X) (symbol? X))
  [X] -> (parse* X)
  [X Op Y] -> [cons Op [cons (parse* X) [cons (parse* Y) []]]]
  [X Op Y Op2 | Rest] -> (let N1 (precedence Op)
                            N2 (precedence Op2)
                         (if (> N2 N1)
                             [cons Op [cons (parse* X) [cons (parse* [Y Op2 | Rest]) []]]]
                             (parse* [[X Op Y] Op2 | Rest])))
  _ -> (error "parse*: type error"))

シュガーファンクションを使うには次のようにする。

(define infix
  [infix X] -> (parse* (eval X))
  X -> X)

(sugar in infix 0)

これにより、 (infix [1 + 2]) という式が [+ 1 2] という記述に変換される。

では、型チェックを有効にしよう。

(42-) (tc +)
true

以降は型チェックが有効になる。 前につかった式を打ち込むと、型チェックでエラーとなる。

(43+) [+ 1 2]
type error

というわけで、式を表わす型 expr を定義する。

(datatype expr
  ______________________________________
  (number? X) : verified >> X : number;   \ (1) number? で検証されたら、型は number \

  X : number;   \ (2) 数値は式 \
  ____________
  X : expr;

  if (element? Op [+ - * /])  \ (3) [オペレータ 式 式] ならば式  \
  X : expr; Y : expr;
  ==========================  \ (3') 式ならば [オペレータ 式 式] \
  [Op X Y] : expr;)

この式を評価した後に再度式を打ち込むと、型が正しく照合される。

(47+) 1 : expr
1 : expr              \ (2) より、数値は式 \
(48+) [+ 1 2]
[+ 1 2] : expr        \ (3) より、[オペレータ 式 式] ならば 式 \
(49+) [+ 1 [* 2 3]]
[+ 1 [* 2 3]] : expr

早速、型有りの evaluate を評価してみる。

(define evaluate
  { expr --> number }
  [+ X Y] -> (+ (evaluate X) (evaluate Y)) \ (3') より、式ならば [オペレータ 式 式] でパターンマッチ可能  \
  [- X Y] -> (- (evaluate X) (evaluate Y))
  [* X Y] -> (* (evaluate X) (evaluate Y))
  [/ X Y] -> (/ (evaluate X) (evaluate Y))
  X -> X where (number? X))  \ (1) number? で検証されているので、型は number \

できたら、評価を試す。

(12+) (infix [10 + 8 / 2 * 7 - 4])
[+ 10 [- [* [/ 8 2] 7] 4]] : expr

(13+) (evaluate (infix [10 + 8 / 2 * 7 - 4]))
34 : number

できました。 verified な定義により、最終的なタイプ数なら Haskell に迫れる勢いです。 パーサを用意したり、シンタックスシュガーを作ったりといった準備から目をそむければ……。

そして infix 見た目上やや嬉しくないですが、これにはメリットもあります。 そう、infix 以外も使えるのです。

(tc -) を評価して型チェックを OFF にし、次のコードを評価します。

(define parse3
  X -> (parse3* X []))

(define parse3*
  [X | XS] Stack -> (parse3* XS [X | Stack]) where (number? X)
  [X | XS] [A B | Stack] -> (parse3* XS [[cons X [cons A [cons B []]]] | Stack]) where (symbol? X)
  [] [Result | _] -> Result
  _ _ -> (error "type error"))
  

(define postfix
  [postfix X] -> (parse3 (eval X))
  X -> X)
  
(sugar in postfix 1)

この後、再度 (tc +) で型チェックを有効化します。

(30+) (postfix [10 8 2 / 7 * 4 - +])
[+ 10 [- [* [/ 8 2] 7] 4]] : expr

(31+) (evaluate (postfix [10 8 2 / 7 * 4 - +]))
34 : number

このように、ユーザーが自由に構文を拡張可能です。

(55+) (define f1 { X --> number }
         X -> (evaluate (infix [10 + 8 / 2 * 7 - 4])))
f1 : (A --> number)

(56+) (define f2 { X --> number }
         X -> (evaluate (postfix [10 8 2 / 7 * 4 - +])))
f2 : (A --> number)


(57+) (f1 [])
34 : number

(58+) (f2 [])
34 : number

(59+) (ps f1)

(DEFUN f1 (V384)
 (evaluate
  (CONS '+
   (CONS 10
    (CONS
     (CONS '-
      (CONS (CONS '* (CONS (CONS '/ (CONS 8 (CONS 2 NIL))) (CONS 7 NIL)))
       (CONS 4 NIL)))
     NIL)))))[] : (list A)

(60+) (ps f2)

(DEFUN f2 (V387)
 (evaluate
  (CONS '+
   (CONS 10
    (CONS
     (CONS '-
      (CONS (CONS '* (CONS (CONS '/ (CONS 8 (CONS 2 NIL))) (CONS 7 NIL)))
       (CONS 4 NIL)))
     NIL)))))[] : (list A)

生成されるLISPコードは等価になっています。