bowbow99

*.lc
\#*\#

bowbow99

;;; -*- mode: lisp; package: debuggable-eval -*-
;;;
;;; debuggable-eval.l

#|
eval-region からデバッガ、のようなもの（作りかけ放置版）。
色々とアレなので使うのはおすすめしないけど参考になればと貼っておくことにした。

condition-restart の頃に作ったので何もなしに restart-case が使われてる。
ansify なら ansify::install しとけばたぶん動く。restart 使わんなら tagbody

bowbow99

#|
ちょっちわかりにくいけど、thunk の関数をタイマーで繰り返し呼び出してる。
thunk は3回目で自分のタイマーを止めて finish をセットして終了する。
元のスレッドは、`(start-timer 1 thunk)` した後、`(while ...)` の中で
`(sleep-for 1)` してタイマーで呼び出される thunk が終わるのを待ってる。
終わったら msgbox 出して完了。

普通に（メインスレッドで）実行すると完了まで進むんだけど、`timer-test`
をタイマーで（バックグラウンドから）実行するとタイムアウトしてしまう。

bowbow99

;;; -*- mode: lisp; package: user -*-

#|
使い方（暫定）:
1. どこかへ framework.l と nanri-master-change-tests.l をダウンロード
2. M-x load-file
   load file: path/to/framework.l
3. M-x load-test-file
   test file: path/to/nanri-master-change-tests.l
4. M-x change-tests

bowbow99

diff --git src/hash.cc src/hash.cc
index 3b8c55b..ad81b50 100644
--- src/hash.cc
+++ src/hash.cc
@@ -528,9 +528,13 @@ equalp (lhash_table *x, lhash_table *y)
       {
         lisp t = Fgethash (entry->key, y, Qnil);
         if (Fequalp (entry->value, t) == Qnil)
-          return 0;
+          {

bowbow99

;; Clozure CL
CL-USER> (let ((x #\a)) `#(,x))
#(#\a)

;; xyzzy
(let ((x #\a)) `#(,x))
=> #((#:|| x))

bowbow99

;;; 式の位置を記録しながら読み込む

(require "cmu_loop")

(defun read-forms-with-code-position (buffer &optional print-debug-info)
  (with-input-from-buffer (buffer (point-min))
    (let ((*readtable* (copy-readtable *readtable*))
          (positions (make-hash-table))
          (*read-depth* 0))
      (declare (special *read-depth*))

bowbow99

;; labels の lambda-list 内の init-form で同じ labels 式で定義したローカル
;; 関数を呼び出してると、コンパイルで挙動が変わる

(defun x () :global)
=> x

(defun test ()
  (labels ((x () :local)
           (test-1 (&optional (val (x))) val))
    (test-1)))

bowbow99

;;; require で読み込まれたのに provide してない奴を探す
;;; .xyzzy の先頭に書いといて起動すると、provide しなかった奴が記録されるので
;;; *scratch* で (print-required-but-not-provided) するとてきとーに表示
(defconstant +original-require+ #'require)

(defparameter *required-but-not-provided* nil)

(defun require (&rest args)
  (let ((modules-prev (copy-list *modules*))
        (module-name (car args)))

bowbow99

(defun autoload-symbol-p (symbol)
  (and (symbolp symbol)
       (fboundp symbol)
       (autoload-function-p symbol)))

(defun autoload-module (symbol)
  (unless (autoload-symbol-p symbol)
    (error "autoload 指定されたシンボルじゃないです: ~S" symbol))
  (let* ((def (or (macro-function symbol)
                  (si:closure-body (symbol-function symbol))))