PostScriptもどき言語

Gauche

昔書いた逆ポーランド記法で動くPostScriptもどき言語を掘り起こしてみた。
未来の自分のために（そんなときがくるのか？）コメントをつけておく。
ついでに、当時の自分が知らなかったmatch-lambda*とlet1を使うように書き換え。

インタプリタ本体

引数は3つ。(ps プログラムソース 実行スタック ワード定義辞書)のように呼び出す。
辞書にないものはとりあえずスタックにプッシュしてるが、本当はエラー判定必要。

(use util.match)

(define ps (match-lambda*
 ((() stk _) stk)   ;プログラムソースを読み切ったら実行スタックを返して終了
 (((wd . src) stk dic)
  (let1 v (getval wd dic) ;ソースの頭のワードを辞書から検索
   (cond ((procedure? v) (v src stk dic)) ;組み込みワードならそのまま実行
         (v (ps (add v src) stk dic)) ;ユーザ定義ワードならその内容でソースを置き換え
         (else (ps src (cons (unq wd) stk) dic))))))) ;辞書にないものはスタックにプッシュ

雑用ユーティリティ群

psilが通常実行用の入り口。PostScript Imitation Languageのつもり。
addは実行可能配列をソースに挿入するもの。何も実行しない{}(実は())のときにappendを使いたいのでpair?ではなくlist?で判定してる。

(define (getval k dic) (let1 v (assoc k dic) (and v (cdr v))))
(define (add x xs) ((if (list? x) append cons) x xs))
(define (unq x) (if (and (pair? x) (eq? (car x) 'quote)) (cadr x) x))
(define (op f) (match-lambda* ((src (b a . stk) dic) (ps src (add (f a b) stk) dic))))
(define-syntax psil (syntax-rules () ((_ . src) (ps 'src () dictionary))))

ワード定義辞書

ここでだらだら書くのもなんなのでサンプルに使っている最低限のみ。
スタックから2つの引数を消費するものを登録するときは上記のopが使える。

(define dictionary `(
 (add . ,(op +))
 (mul . ,(op *))
 (gt . ,(op >))
 (= . ,(match-lambda* ((src (a . stk) dic) (print a) (ps src stk dic))))
 (dup . ,(lambda (src stk dic) (ps src (cons (car stk) stk) dic)))
 (def . ,(match-lambda* ((src (b a . stk) dic) (ps src stk (acons a b dic)))))
 (ifelse . ,(match-lambda* ((src (c b a . stk) dic) (ps (add (if a b c) src) stk dic))))))

実行サンプル

本物のPostScriptではシンボルは/nameと書くが、ここでは'nameと書く。
実行可能配列は内部的には単なるリストだが、気分を出すために{}で書いてる。

(psil
'n 5 def               ;nを5と定義
n =                    ;nを表示

'sub {-1 mul add} def  ;引き算とは-1をかけて足すものと定義
n 3 sub =              ;nから3を引いて表示

'if {{} ifelse} def    ;ifを定義(else時に何もしないもの)

'fact {                ;階乗を定義
  dup 1 gt {dup 1 sub fact mul} if
} def
n fact =               ;階乗のテスト
)

上級者編

書いた後でこんなものを発見してしまった…。これはすごい。

PostScriptでつくったLispインタプリタを用い、PostScriptインタプリタをつくりました。

http://blog.bugyo.tk/lyrical/2008/01/postscriptlisppostscript.html

シンボルを/nameと書く版

unqを以下に置き換え

(define (unq x) (if (eq? (ref (x->string x) 0) #\/) (string->symbol (string-copy (x->string x) 1)) x))