leque はレキとかレクとか読むらしい。愛知県在住。最近はぶらぶらしてます。
あとは http://www.katch.ne.jp/~leque/software/ にも色々と
Gauche:LibraryWishList みたいなものがあったら、ネタに困ったときや、必要なライブラリの拡充に便利かもしれないとふと思った。→作ってみた
平日の夜ということだったのに盛況だった。メモとかはとっていなかったので簡単な感想を。
未完成。 lalr.scm
勉強がてら LALR(1) 構文解析器を書いてみました。
bigloo の LALR Parser と同じような構文で使えるつもり。 最初に LR(1) 構文解析表をつくってから LALR(1) 構文解析表をつくるので実用的な速度は出ません （PowerPC G4 800 MHz、メモリ 640 MB で、下記の四則演算の場合で 1 秒程度、 c-wrapper クラスのものになると 10 分弱）。
例:
(use util.lalr)
(define *tokens*
; (2 + 3) * 4 / 2 - 1 * 7 => 3
'(lp (i . 2) op-plus (i . 3) rp op-mult (i . 4) op-div (i . 2) op-minus (i . 1) op-mult (i . 7))
)
(define lexer
(let1 tokens *tokens*
(lambda ()
(let1 v (or (null? tokens) (pop! tokens))
(if (pair? v)
v
(cons v v))))))
(define parser
(lalr-grammar
((left op-mult op-div)
(left op-plus op-minus)
lp rp i)
(expr
((lp expr rp) expr)
((op-plus expr) expr)
((op-minus expr) (- expr))
((expr@a op-mult expr@b) (* a b))
((expr@a op-div expr@b) (/ a b))
((expr@a op-plus expr@b) (+ a b))
((expr@a op-minus expr@b) (- a b))
((i) i))))
(define (main args)
(print (lr-parse parser lexer))) ; => 3
で動くはずなんだけれど、lr1-parser->lalr1-parser のなかで
*** ERROR: hash table doesn't have an entry for key #<set equal?(45)> Stack Trace: _______________________________________ 0 (ref lr1->lalr1-table state)
と言われる。debug-print を仕込んでみると
#?=(and (member state (hash-table-keys lr1->lalr1-table)) #t) #?- #t #?=(hash-table-exists? lr1->lalr1-table state) #?- #f
うーん…。
ときどき UTF-8 なテキストを編集しなくてはいけないことがあって nvi だといろいろ不便なので これを機に Emacs に乗り換えた（vim も候補にあがったけれど、vim script があまり好きになれそうにないのと、:set lisp しても ( や ) が S式単位でうごいてくれなかったので×）。
とりあえず viper-mode で :set lisp できるようにして (, ), {, }, [[, ]] の挙動をそれらしくした。
Scheme プログラムの編集は Gauche:EditingWithEmacs を参考に inferior-gacuhe-mode と koguro さんの gca を使わせていただくことにした。
ついでに EmacsLisp の練習にカーソル位置のシンボルを export する関数を書いてみた （gca に依存しています）。
(defun gca-export-current-sym ()
(interactive)
(let ((word (gca-current-word)))
(save-excursion
(unless (re-search-backward "^\\s *(export\\Sw+" nil t)
(error "No export clause found."))
(let ((bp (match-beginning 0)))
(unless (re-search-forward "\\s)" nil t)
(error "Unclosed export clause."))
(let ((ep (match-beginning 0)))
(goto-char bp)
(if (re-search-forward
(concat "\\s " (regexp-quote word) "[ \t\n\f\v\)]") (1+ ep) t)
(message "%s is already exported." word)
(goto-char ep)
(insert " " word)
(lisp-indent-line)
(message "Exported %s." word)))))))
c-wrapper を使って SS Tagger を Gauche から使えるようにしてみました（libsstagger.tar.gz）。 mecab と同じ方式で C++ で書かれた元プログラムを一旦 C で wrap してから c-wrapper を使っています。
これで Scheme 側から finalizer を追加できたら C で拡張ライブラリを書くのとほとんど遜色がなさそう。
使い方:
% tar xzf postagger-1.0.tar.gz % cd postagger-1.0 % tar xzf ../libsstagger.tar.gz % ./configure # 注: オリジナルの Makefile を上書きします % make % make install % cp sstagger.scm `gauche-config --sitelibdir`/lingua/en % gosh gosh> (use lingua.en.sstagger) #<undef> gosh> (define tagger (make-sstagger "/path/to/postagger-1.0/models")) tagger gosh> (sstagger-do-tagging tagger "He opened the window.") "He/PRP opened/VBD the/DT window/NN ./." gosh> (tagger "He opened the window.") "He/PRP opened/VBD the/DT window/NN ./." gosh> (sstagger-destroy tagger) #<undef> gosh> ^D
今日の一行 木の復元。先行順の場合だけ。
(use srfi-11)
(use srfi-42)
(use util.match)
(define (enum from to step)
(unfold (cut > <> to) values (cut + <> step) from (lambda _ '())))
(define make-tree
(case-lambda
((val) (list val))
((val left right)
(list val left right))))
(define (list->tree/preorder xs)
(match xs
(() xs)
((val) (list (make-tree val)))
(_
(let* ((x (car xs))
(ys (cdr xs))
(left&rights (map (lambda (i)
(call-with-values (cut split-at ys i) cons))
(enum 1 (- (length ys) 1) 2))))
(append-map (lambda (left&right)
(receive (left right) (car+cdr left&right)
(list-ec (: l (list->tree/preorder left))
(: r (list->tree/preorder right))
(make-tree x l r))))
left&rights)))))
続 AA 折れ線グラフ
hanatani さんの解答を 見て map-accum の存在に気づいた。
(use srfi-1)
(use srfi-11)
(use util.match)
(use gauche.collection)
(define (main args)
(graph (second args)))
(define (graph spec)
(let*-values (((xs _)
(map-accum (lambda (ch y)
(case ch
((#?C) (values (cons #?_ y) y))
((#?R) (values (cons #?/ y) (+ y 1)))
((#?F) (values (cons #?? (- y 1)) (- y 1)))))
0 spec))
((bottom top) (apply min&max (map cdr xs))))
(apply for-each
(cut print <...>)
(map (match-lambda
((c . pos)
(map (lambda (i) (if (= i pos) c #?space))
(iota (+ (- top bottom) 1) top -1))))
xs))))
今日の一行(2006-03-14) AA 折れ線グラフ をやってみた。
(use srfi-1)
(use util.match)
(define (main args)
(graph (second args)))
(define (graph spec)
(for-each
print
(let loop ((cs (string->list spec))
(top 0)
(bottom 0)
(y 0)
(rs '()))
(if (null? cs)
(let1 height (+ (- top bottom) 1)
(apply map string
(map (match-lambda
((c . pos)
(list-tabulate height
(lambda (i)
(if (= i (- height (- pos bottom) 1))
c
#?space)))))
(reverse! rs))))
(match (car cs)
(#?C
(loop (cdr cs) top bottom y (alist-cons #?_ y rs)))
(#?R
(let1 ny (+ y 1)
(loop (cdr cs) (max top ny) bottom ny (alist-cons #?/ y rs))))
(#?F
(let1 ny (- y 1)
(loop (cdr cs) top (min ny bottom) ny (alist-cons #?? ny rs)))))))))