読者です 読者をやめる 読者になる 読者になる

debianでncurses6をインストール

2015年に新しいバージョンのncurses 6.0が出てた

Announcing ncurses 6.0 - GNU Project - Free Software Foundation (FSF)

バージョン5では背景色と前景色の色の組み合わせが256通りしか使えなかったのが32768通り使えるようになったらしい(それでも256色の前景色と背景色の組み合わせは256*256で65536通りなので半分の組合せしか使えない)

debianではaptではまだ入れられないのでソースからビルドする

$ wget ftp://ftp.gnu.org/gnu/ncurses/ncurses-6.0.tar.gz
$ tar zxf ncurses-6.0.tar.gz
$ cd ncurses-6.0
$ export CPPFLAGS="-P"
$ ./configure --prefix=/usr \
--mandir=/usr/share/man \
 --with-shared \
 --without-debug \
 --without-normal \
 --enable-pc-files \
 --enable-widec
$ make
$ sudo make install

参考にしたページ

6.20. Ncurses-6.0

c++ - How to enable 32k color pairs in ncurses? - Stack Overflow

clozure clがおかしい

lemをcclで動かしてみたらどうにもsbclとは違うらしくうまく動かなかった

sbclとcclで違う結果になる小さなコードがこれ

;; example.lisp
(ql:quickload :lem-base :silent t)
(in-package :lem-base)

(let ((b (get-buffer-create "temp")))
  (insert-string (buffer-point b) "one")
  (insert-character (buffer-point b) #\newline)
  (insert-string (buffer-point b) "two")
  (uiop:println (line-string-at (buffers-end b))))

これは"temp"というバッファを作り、そのバッファに"one", 改行, “two” という順に挿入していき、バッファの末尾の行の文字列を表示します

sbclの場合

$ ros -L sbcl -l example.lisp -q
two

と正しい結果になる

一方cclでは

$ ros -L ccl-bin -l example.lisp -q
one

となぜか違う結果になってしまう

lemも一般的なエディタと同様、バッファに文字を挿入するときにemacsatomでいうマーカと同じ動作をするポイントがある
これはlispworksと全く一緒になってしまったので一応ドキュメントを貼っておく

6.3.4 Points

改行を挿入したときに、バッファ末尾を表すポイントが一行ずれないのが駄目なようなので それを行う関数にprintデバッグを加えてみる

;; src/base/buffer-insert.lisp
(defun shift-sticky-objects-newline (line charpos)
  (line-property-insert-newline line (line-next line) charpos)
  (format t "length: ~A~%" (length (line-points line))) ;test
  (let ((count 0))
    (dolist (p (line-points line))
      (format t "count: ~D~%" (incf count)) ;test
      (when (etypecase (point-kind p)
              ((eql :left-inserting)
               (<= charpos (point-charpos p)))
              ((eql :right-inserting)
               (< charpos (point-charpos p))))
        (point-change-line p (line-next line))
        (decf (point-charpos p) charpos)))))
$ ros -L sbcl -l example.lisp -q
WARNING: redefining LEM-BASE::SHIFT-STICKY-OBJECTS-NEWLINE in DEFUN
length: 3
count: 1
count: 2
count: 3
two
$ ros -L ccl-bin -l example.lisp -q
length: 3
count: 1
one

なぜかcclではリストの長さが3なのにdolistが1回のループで終わってしまった

dolistをloopマクロにしてみるとうまくいく

;; src/base/buffer-insert.lisp
(defun shift-sticky-objects-newline (line charpos)
  (line-property-insert-newline line (line-next line) charpos)
  (format t "length: ~A~%" (length (line-points line))) ;test
  (let ((count 0))
    (loop for p in (line-points line) do
      (format t "count: ~D~%" (incf count)) ;test
      (when (etypecase (point-kind p)
              ((eql :left-inserting)
               (<= charpos (point-charpos p)))
              ((eql :right-inserting)
               (< charpos (point-charpos p))))
        (point-change-line p (line-next line))
        (decf (point-charpos p) charpos)))))
$ ros -L ccl-bin -l example.lisp -q
length: 3
count: 1
count: 2
count: 3
two

clozure clのバージョン

? (lisp-implementation-version)
"Version 1.11-r16635  (LinuxX8664)"

orelangを***で実装してみたをcommon lispで

プログラミング言語を作る。1時間で。 - Qiita

common lispでというよりはリードマクロを使ってcommon lispをorelang化していく

;;; orelang.lisp
(defpackage :orelang (:import-from :cl :+ :* :=))

(defvar *ore-readtable*
  (let ((*readtable* (copy-readtable nil)))
(set-macro-character #\] (get-macro-character #\)))
(set-macro-character #\[ (lambda (stream char)
               (declare (ignore char))
               (mapcar (lambda (x) (if (stringp x) (intern x :orelang) x))
                   (read-delimited-list #\] stream t))))
(set-macro-character #\, #'read)
*readtable*))

(defmacro orelang::|set| (var form) `(defparameter ,var ,form))
(defmacro orelang::|get| (var) var)
(defmacro orelang::|until| (test &body body)
  `(do ((#1=#:result nil (progn ,@body)))
   (,test #1#)))
(defmacro orelang::|step| (&body forms) `(progn ,@forms))

(defun orelang-run (&optional (stream *standard-input*))
  (let ((*readtable* *ore-readtable*))
(eval (read stream))))

CLIから使う

$ ros -l orelang.lisp -e '(print (orelang-run))'
["step",
  ["set", "i", 10],
  ["set", "sum", 0],
  ["until", ["=", ["get", "i"], 0], [
"step",
["set", "sum", ["+", ["get", "sum"], ["get", "i"]]],
["set", "i", ["+", ["get", "i"], -1]]
  ]],
  ["get", "sum"]
]

; => 55

emacsのslimeとddskkとの衝突を回避する設定が機能しなくなってた

slimeにはスペースを挿入して関数のパラメータをミニバッファに表示するslime-spaceという機能がスペースキーに割り当てられてるけど
これがddskkのskk-insertと被っていてddskkが使えなくなる問題がある

その回避方法は調べたらいくつか出てくるけど、それがいつ頃からかslimeの変更で使えなくなってることに気付いて困ってた

ソースを辿って見てみるとslime-autodoc-mode-mapというマイナーモードの
slime-autodoc-spaceというコマンドが使われるようになってたので
このモードのキーマップのスペースの割り当てを変更したら解決した

(defun slime-autodoc-space-or-skk-insert (n)
  (interactive "p")
  (if (and (boundp 'skk-henkan-mode) skk-henkan-mode)
      (skk-insert n)
    (if nil
        (slime-autodoc-space n)
      ;; 上の関数はなぜかミニバッファへの表示が細切れになるので
      ;; 下のslime-autodoc-spaceの中身を少し変更して誤魔化す
      (self-insert-command n)
      (let ((doc (slime-autodoc)))
        (when doc
          (message "%s" doc)       ; 元は(eldoc-message "%s" doc) 
          )))))

(add-hook 'slime-autodoc-mode-hook
          (lambda ()
            (define-key slime-autodoc-mode-map " "
              'slime-autodoc-space-or-skk-insert)))

環境はubuntu 16.04でemacs25.1.1とslime 2.18

追記:

defadviceを使うともっとうまくいった

(defadvice slime-autodoc-space (around slime-autodoc-space-or-skk-insert (n))
  (if (and (boundp 'skk-henkan-mode) skk-henkan-mode)
      (skk-insert n)
    ad-do-it))
(ad-activate 'slime-autodoc-space 'slime-autodoc-space-or-skk-insert)

sbclのバグ

* (lisp-implementation-type)

"SBCL"
* (lisp-implementation-version)

"1.3.2"
* (software-type)

"Linux"
* (software-version)

"3.16.0-4-amd64"
* 
(defun fib (&optional n)
  (if (< n 2)
      n
      (+ (multiple-value-call #'fib (- n 2))
         (multiple-value-call #'fib (- n 1)))))

debugger invoked on a SB-INT:BUG in thread
#<THREAD "main thread" RUNNING {1002A251C3}>:
    failed AVER:
      (OR (NOT SB-C::ENTRY) (EQ (SB-C::FUNCTIONAL-KIND SB-C::ENTRY) :DELETED))
  This is probably a bug in SBCL itself. (Alternatively, SBCL might have been
  corrupted by bad user code, e.g. by an undefined Lisp operation like
  (FMAKUNBOUND 'COMPILE), or by stray pointers from alien code or from unsafe
  Lisp code; or there might be a bug in the OS or hardware that SBCL is running
  on.) If it seems to be a bug in SBCL itself, the maintainers would like to
  know about it. Bug reports are welcome on the SBCL mailing lists, which you
  can find at <http://sbcl.sourceforge.net/>.

Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.

restarts (invokable by number or by possibly-abbreviated name):
  0: [ABORT] Exit debugger, returning to top level.

(SB-INT:BUG "~@<failed AVER: ~2I~_~S~:>" (OR (NOT SB-C::ENTRY) (EQ (SB-C::FUNCTIONAL-KIND SB-C::ENTRY) :DELETED)))
0] 

Common Lispで重複するコードを一つにまとめる

こういう重複したコードを一つにまとめたい

(defun hoge (line fn)
  (do ((line line (line-next line)))
      ((null line))
    (funcall fn line)))

(defun piyo (line fn)
  (do ((line line (line-prev line)))
      ((null line))
    (funcall fn line)))

二つのS式を渡して共通部分を変数に置き換えたS式と変数のバインディングを返す

* (defun diff-tree (x y)
    (let ((vars)
          (*gensym-counter* 1))
      (labels ((mkvar (x y)
                      (let ((var (gensym "$")))
                        (push (list var x y) vars)
                        var))
               (recur (x y)
                      (cond ((and (atom x) (atom y))
                             (if (eql x y)
                                 x
                                 (mkvar x y)))
                            ((atom x)
                             (mkvar x y))
                            ((atom y)
                             (mkvar x y))
                            (t
                             (cons (recur (car x) (car y))
                                   (recur (cdr x) (cdr y)))))))
        (let ((tree (recur x y)))
          (values tree vars)))))

* (diff-tree '(defun hoge (line fn)
                (do ((line line (line-next line)))
                    ((null line))
                  (funcall fn line)))
             '(defun piyo (line fn)
                (do ((line line (line-prev line)))
                    ((null line))
                  (funcall fn line))))

(defun #:$1 (line fn)
  (do ((line line (#:$2 line)))
      ((null line))
    (funcall fn line)))

((#:$2 line-next line-prev)
 (#:$1 hoge piyo))

変数のバインディングと共通部分を変数に置き換えた式を渡してコードを生成するマクロを書く

(defmacro with-copy-code (vars &body body)
  `(progn
     ,@(loop :for alist :in
         (loop :for i :from 1 :to (1- (apply #'min (mapcar #'length vars)))
           :collect (mapcar #'(lambda (v)
                                (cons (car v)
                                      (nth i v)))
                            vars))
         :collect (sublis alist `(progn ,@body)))))

* (macroexpand-1 '(with-copy-code ((#1=#:$1 f g)
                                   (#2=#:$2 line-next line-prev))
                    (defun #1# (line fn)
                      (do ((line line (#2# line)))
                          ((null line))
                        (funcall fn line)))))

(PROGN
 (PROGN
  (DEFUN F (LINE FN)
    (DO ((LINE LINE (LINE-NEXT LINE)))
        ((NULL LINE))
      (FUNCALL FN LINE))))
 (PROGN
  (DEFUN G (LINE FN)
    (DO ((LINE LINE (LINE-PREV LINE)))
        ((NULL LINE))
      (FUNCALL FN LINE)))))

一連の操作をする関数を書く

* (defun gen-code (x y)
    (multiple-value-bind (code vars) (diff-tree x y)
      `(with-copy-code ,vars ,code)))

* (gen-code '(defun hoge (line fn)
               (do ((line line (line-next line)))
                   ((null line))
                 (funcall fn line)))

            '(defun piyo (line fn)
               (do ((line line (line-prev line)))
                   ((null line))
                 (funcall fn line))))

(WITH-COPY-CODE ((#:$2 LINE-NEXT LINE-PREV) (#:$1 HOGE PIYO))
  (DEFUN #:$1 (LINE FN)
    (DO ((LINE LINE (#:$2 LINE))) ((NULL LINE)) (FUNCALL FN LINE))))

完成

もっとよく出来たものが既にありそう

Common Lispのreplとstumpwmを同じプロセスで動かす

処理系はsbcl

;; run-stumpwm.lisp
(ql:quickload :stumpwm)

(defun run-stumpwm ()
  (sb-thread:make-thread
   #'(lambda ()
       (sb-thread:with-new-session ()
         (stumpwm:stumpwm)))))

(run-stumpwm)

xterm -e sbcl --load run-stumpwm.lisp で起動する

これでxterm上のsbclからstumpwmとやり取りできるようになった

参考ページ

http://www.geocities.co.jp/SiliconValley-SanJose/7474/cmuclMemo.html#0018

http://www.sbcl.org/1.0/manual/Sessions_002fDebugging.html