closette
#1 (defun (setf <access-fn>) ...) - 日々ごちゃごちゃと考える
defunはclosette付属のnewcl.lispの定義をそのまま使って、あとxyzzyにないtypecase, ecase, print-unreadable-object等を適当に書き、んでstd-instanceの定義のprint-functionで引っかかってたのを誤魔化したらとりあえずeval-bufferとbyte-compileは通るように。
しかしコンパイルしたのをロードしたら落ちた。
めんどそうなのでそこはとりあえず無視してclosette-test.lispを走らせてみたのだけれど、構造体に循環参照があるせいでpprint等でスタックオーバーフローに。
その辺を(write ... :circle t)などとまた誤魔化してみたら、むっちゃ重かったけどなんとか通った。
テストログ
*standard-output*
*trace-output*
print-functionが全く働いてなくて悲惨なログになってるけど(修正済み)、ざっと見まともに動いてる??
(defmacro typecase (var &rest clauses) (let ((type-of-var (gensym))) `(let ((,type-of-var (type-of ,var))) (case ,type-of-var ,@clauses)))) (defmacro ecase (var &rest clauses) (let ((wanted (mapcar #'car clauses))) `(case ,var ,@clauses (t (type-error ,var ',wanted))))) (defun pprint (object &optional (os *standard-output*)) (write object :stream os :circle t :escape t :pretty t)) (defmacro print-unreadable-object ((object stream &key type identity) &body body) (with-gensyms (gs gobj) `(let ((,gs ,stream) (,gobj ,object)) (format ,gs "#<") ,(when type `(format ,gs "~S" (type-of ,gobj))) ,(when (and type (or body identity)) `(format ,gs " ")) ,@body ,(when (and identity body) `(format ,gs " ")) ,(when identity `(format ,gs "~X" (si:address-of ,gobj))) (format ,gs ">") nil))) ;;テスト (time (w/infile (is "~/site-lisp/cl/closette-tests.l") (w/outfile (os "~/site-lisp/cl/closette-test_log.txt") (w/outfile (*trace-output* "~/site-lisp/cl/closette-test_trace.txt") (w/outfile (*standard-output* "~/site-lisp/cl/closette-test_stdout.txt") (whilet sexp (read is nil nil t) (format os "~&~A~% ; => ~A~%~%" sexp (eval sexp)) (fresh-line))))))) 16813 msec
正しくコンパイルされるように直すのは色々しんどそうだなぁ。