#:g1

CLでsrfi-18

Posted 2012-03-29 08:34:00 GMT

CLでsrfi、今回は、srfi-18の「Multithreading support」です。
マルチスレッド関係を規定するsrfiです。

動作

(defun make-empty-mailbox ()
  (let ((mutex (make-mutex))
        (put-condvar (make-condition-variable))
        (get-condvar (make-condition-variable))
        (full? nil)
        (cell nil) )
    (labels ((put! (obj)
               (mutex-lock! mutex)
               (if full?
                   (progn
                     (mutex-unlock! mutex put-condvar)
                     (put! obj) )
                   (progn
                     (setq cell obj)
                     (setq full? 'T)
                     (condition-variable-signal! get-condvar)
                     (mutex-unlock! mutex) )))
             (get! ()
               (mutex-lock! mutex)
               (if (not full?)
                   (progn
                     (mutex-unlock! mutex get-condvar)
                     (get!) )
                   (let ((result cell))
                     (setq cell nil) ; avoid space leaks
                     (setq full? nil)
                     (condition-variable-signal! put-condvar)
                     (mutex-unlock! mutex) ))))
      (lambda (msg)
        (case msg
          ((put!) #'put!)
          ((get!) #'get!)
          (otherwise (error "unknown message")) )))))

(defun mailbox-put! (m obj) (funcall (funcall m 'put!) obj)) (defun mailbox-get! (m) (funcall (funcall m 'get!)))

;;; test (let ((th (make-thread (lambda () (handler-case (sb-ext:with-timeout 2 (let ((mb (make-empty-mailbox))) (mailbox-put! mb 'foo) (mailbox-get! mb) (mailbox-put! mb 'bar) t )) (sb-ext:timeout () nil) )) "mailbox" ))) (thread-start! th) (thread-join! th) ) ;=> T

移植について

結構低レイヤーなので厳しいです。
適当にSBCLで該当する機能がある範囲で似せる、という感じでお茶を濁しています。 ■

CLでsrfi-19

Posted 2012-03-27 05:45:00 GMT

CLでsrfi、今回は、srfi-19の「Time Data Types and Procedures」です。
日時関係のライブラリです。今回触ってみるまで知りませんでしたが、結構便利に使えるように思いました。

動作

(time-utc->time-monotonic (make-time 'time-utc 704228000 1332823993))
;=>  #<TIME-MONOTONIC 1332824027.704228000>

(time-type (time-utc->time-monotonic (make-time 'time-utc 704228000 1332823993)))

(time-utc->time-monotonic (make-time 'time-utc 704228000 1332823993)) ;=> #<TIME-MONOTONIC 1332824027.704228000> (time-difference (current-time) (current-time)) ;=> #<TIME-DURATION 0.000030000> (let (t1 t2) (setq t1 (current-time)) (sleep 1/3) (setq t2 (current-time)) (time-difference t2 t1)) ;=> #<TIME-DURATION 3.334500000> (current-date) ;=> #<DATE 2012/03/27 14:20:48.6136890000 (32400)> (date->string (current-date)) ;=> "Tue Mar 27 14:23:11+0900 2012" (string->date "Tue Mar 27 14:23:11+0900 2012" "~a ~b ~d ~H:~M:~S~z ~Y")

(string->date "Tue Mar 27 14:23:11+0900 2012" "~a ~b ~d ~H:~M:~S~z ~Y") ;=> #<DATE 2012/03/27 14:23:11.000000000 (32400)>

移植について

gaucheを参考にprint-opjectを設定してみました。 ■

LISPで中置記法

Posted 2012-03-21 00:27:00 GMT

LISPで中置記法云々の話は良く話題になりますが、1960年代に存在したLISP 2が、中置で書いたものをS式に変換するというものだったようなので、かなり昔からあるようです。
ソースコードを変換する以外にもLOOPのようにDSL的に実現してみたりもありますが、CADRを始めとするMIT Lispマシンでは、リーダーマクロで中置を混在させることができたようで、マニュアルにも載っています。(24. Expression Input and Output)
導入されたのは、1983年の9月のSystem 97からのようで、LMIや、Symbolicsはこれらの成果を取り込んでいるので、MIT系のLispマシンは標準で中置記法もサポートしていたということになります。 (ちなみにSystem 97のリリースのアナウンスはRMS担当)
CADRや、LMI Lamabdaのソースを眺めるとinfix.lispがありますが、面白そうなのでCLで動くようにしてみました。

使い方としては、#◊から◊までを中置記法で書きます。
(defun fib (n &optional (a1 1) (a2 0))
  #◊
  if n = 1 then
    a1
  else if zerop(n) then
         a2
       else
         fib(n - 1, a1 + a2, a1)
  ◊)

(fib 10) ;=> 55

という感じ。(詳しくは、README参照)
シンボルのプロパティリストを大活用しているので、thenや、elseを始めとして、|,|諸々も、定義されたシンボルでないと上手く動かないというのがちょっと面倒です。
TAOでも、中置記法で書けたりしますが、Lispマシンでは、中置記法をサポートするというのは結構普通のことだったのかもしれません。■

一度きりしか起動しないbefore

Posted 2012-03-16 14:57:59 GMT

liquid clのマニュアルを眺めていて、スタートアップの関数の定義で、adviceを使っているのをみつけました。

一度目の起動で自分を削除しているのが肝で良くある例なのかもしれないですがこのadviceをメソッドで再現してみました。 Emacsのdefadviceなどでも使える手法なのかもしれません

(defmethod foo ()
  (write-line "foo")
  (values))

(defmethod foo :before (&aux (me #'foo)) (write-line "only once") (remove-method me (find-method me '(:before) '() )))

(foo) ;>> only once ;>> foo ;>> ;=> <no values> (foo) ;>> foo ;>> ;=> <no values> (foo) ;>> foo ;>> ;=> <no values>


HTML generated by 3bmd in LispWorks 7.0.0

Dartに負けられないので Hello,World! を出力する1行の定義が14143行に展開されるマクロを書きました

Posted 2012-03-15 16:00:00 GMT

(コンパイルは、メモリが4G位ないとPCがフリーズするかもしれません…)

(defmacro defdart (name mesg)
  (flet ((compile-string (str)
           (mapcar #'char-name (coerce str 'list)))
         (make-charname (str)
           `(coerce (mapcar #'name-char
                            (list ,@(mapcar (lambda (x)
                                              (let* ((out (gensym))
                                                     (name (coerce x 'list))
                                                     (gs (mapcar (lambda (x)
                                                                   (declare (ignore x)) (gensym)) name)))
                                                `(with-output-to-string (,out)
                                            (flet (,@(mapcar (lambda (x g)
                                                               `(,g () (princ ,x ,out) ))
                                                       (coerce x 'list)
                                                       gs))
                                              ,@(mapcar #'list gs)))))
                                     (compile-string str) )))
                    'string )))
    `(progn
       (defun ,name ()
         (write-line
          (coerce
           (mapcar #'name-char
                   (list ,@(mapcar #'make-charname (compile-string mesg))) )
           'string ))))))

;;; 実行 (defdart hello-world "Hello, World!") ;; 展開 => ;;; (PROGN (DEFUN HELLO-WORLD () (WRITE-LINE (COERCE (MAPCAR #'NAME-CHAR (LIST (COERCE (MAPCAR #'NAME-CHAR (LIST (WITH-OUTPUT-TO-STRING (#:G95808) (FLET ((#:G95809 () (PRINC #\L #:G95808)) (#:G95810 () (PRINC #\A #:G95808)) (#:G95811 () (PRINC #\T #:G95808)) (#:G95812 () (PRINC #\I #:G95808)) (#:G95813 () (PRINC #\N #:G95808)) (#:G95814 () (PRINC #\_ #:G95808)) (#:G95815 () (PRINC #\C #:G95808)) (#:G95816 () (PRINC #\A #:G95808)) (#:G95817 () (PRINC #\P #:G95808)) (#:G95818 () (PRINC #\I #:G95808)) (#:G95819 () (PRINC #\T #:G95808)) (#:G95820 () (PRINC #\A #:G95808)) (#:G95821 () (PRINC #\L #:G95808)) (#:G95822 () (PRINC #\_ #:G95808)) (#:G95823 () (PRINC #\L #:G95808)) (#:G95824 () (PRINC #\E #:G95808)) (#:G95825 () (PRINC #\T #:G95808)) (#:G95826 () (PRINC #\T #:G95808)) (#:G95827 () (PRINC #\E #:G95808)) (#:G95828 () (PRINC #\R #:G95808)) (#:G95829 () (PRINC #\_ #:G95808)) (#:G95830 () (PRINC #\L #:G95808))) (#:G95809) (#:G95810) (#:G95811) (#:G95812) (#:G95813) (#:G95814) (#:G95815) (#:G95816) (#:G95817) (#:G95818) (#:G95819) (#:G95820) (#:G95821) (#:G95822) (#:G95823) (#:G95824) (#:G95825) (#:G95826) (#:G95827) (#:G95828) (#:G95829) (#:G95830))) (WITH-OUTPUT-TO-STRING (#:G95831) (FLET ((#:G95832 () (PRINC #\L #:G95831)) (#:G95833 () (PRINC #\A #:G95831)) (#:G95834 () (PRINC #\T #:G95831)) (#:G95835 () (PRINC #\I #:G95831)) (#:G95836 () (PRINC #\N #:G95831)) (#:G95837 () (PRINC #\_ #:G95831)) (#:G95838 () (PRINC #\C #:G95831)) (#:G95839 () (PRINC #\A #:G95831)) (#:G95840 () (PRINC #\P #:G95831)) (#:G95841 () (PRINC #\I #:G95831)) (#:G95842 () (PRINC #\T #:G95831)) (#:G95843 () .... ;;; SBCLだと14143 (hello-world) ;>> Hello, World! ;>> ;=> "Hello, World!"


HTML generated by 3bmd in LispWorks 7.0.0

CLでsrfi-96

Posted 2012-03-15 15:30:00 GMT

CLでsrfi、今回は、srfi-96の「SLIB Prerequisites」です。
Schemeの世界では、srfiが生まれる前からSLIBというユーティリティ集が良く使われていて、この中からsrfiになったものなどもあります。
srfi-96は、このSLIBを設置するのに必要な条件を規定したsrfiのようです。

動作

(srfi-96:scheme-implementation-type)
;=>  "SBCL"

(srfi-96:scheme-implementation-version)
;=>  "1.0.55"

(srfi-96:scheme-implementation-home-page)
;=>  "http://www.sbcl.org/"

(srfi-96::tmpnam)
;=>  "slib_101"

(srfi-96:file-exists? "/etc/passwd")
;=>  #P"/etc/passwd"

srfi-96:t
;=>  T

移植について

CLにsrfi-96を移植したとしても、SLIBを読み込むための礎にはなりそうもないので、適当に処置しました。
処理系のホームページが取得できるというのは面白いですね。 ■

ちょっとしたパズル: ACM SIGPLAN Lisp Pointers Volume 1 Issue 6 にのっていた問題

Posted 2012-03-15 15:00:00 GMT

エコール・ポリテクニークでこの問題を出したところ7種類位のバリエーションが得られたらしい

(xpl '(a b c d))
;=>  ((A) (A B) (A B C) (A B C D))


HTML generated by 3bmd in LispWorks 7.0.0

Arcのcompose(:)を再現してみよう

Posted 2012-03-15 14:58:00 GMT

自分のバージョンだと(mapcar #‘car:cdr ’(a b c d))のようなものはできないですね。

(defun |[-reader| (delim-char)
  (lambda (srm char)
    (declare (ignore char))
    (let* ((fns (loop :for c := (read-char srm T nil T)
                      :until (member c '(#\Space #\Newline #\Tab #\Return #\())
                      :collect c :into cs
                      :finally (progn
                                 (unread-char c srm)
                                 (return (mapcar #'read-from-string
                                                 (ppcre:split #\: (coerce cs 'string)) ))))))
      `(funcall
        ;; COMPOSE
        (kmrcl:compose ,@(mapcar (lambda (x) `(function ,x)) fns))
        ,@(read-delimited-list delim-char srm T) ))))

;⸨ U+2E28 ;⸩ U+2E29 (set-syntax-from-char #\⸩ #\)) (set-macro-character #\⸨ (|[-reader| #\⸩) T )

(progn ⸨list:string:car:cdr:cdr (cl::list 'cl:setq 'cl:setf 'cl:set 'cl:list)) ;=> ("SET")


HTML generated by 3bmd in LispWorks 7.0.0

&bodyと&restの違い

Posted 2012-03-15 14:57:59 GMT

違いがあるらしいということは知識としてあるのですが、&bodyはボディらしくインデントしてくれるらしい程度で、具体的にどう違うのか自分も分からないできました。 Symbolicsのマニュアルを読でいたところ詳しい解説があり、&bodyで宣言した引数は、インデント幅が1になるとのことです。また、&restは特にそのような設定はしません。なるほど。 確認したところSBCLでもデフォルトでそういう風になっているようです。 他の処理系でもpprintの設定をすればそういう風に表示してくれるのではないかと思います。

(defmacro macro-with-body-arg (a b &body body)
  `(list ,a ,b ,@body))

(pprint '(macro-with-body-arg 1 2 3 4)) ;;; SBCL ;>> ;>> (MACRO-WITH-BODY-ARG 1 ;>> 2 ;>> 3 ;>> 4) ;=> <no values> ;;; Symbolics ;>> ;>> (MACRO-WITH-BODY-ARG 1 ;>> 2 ;>> 3 ;>> 4) ;=> <no values> (defmacro macro-with-rest-arg (a b &rest body) `(list ,a ,b ,@body))

(pprint '(macro-with-rest-arg 1 2 3 4)) ;>> ;>> (MACRO-WITH-REST-ARG 1 2 3 4) ;=> <no values>


HTML generated by 3bmd in LispWorks 7.0.0

CLでsrfi-64

Posted 2012-03-13 16:08:00 GMT

CLでsrfi、今回は、srfi-64の「A Scheme API for test suites」です。
ユニットテストはsrfi-78でも提供されていますが、srfi-78はsrfi-64に比べて軽量とのことで、棲み分けがあるような、ないような。

動作

(progn
  (test-runner-reset (test-runner-current))
  (test-begin "foo")
  (test-equal 1 1)
  (test-equal 1 1)
  (test-error T (eval '(car 8)))
  (test-assert t)
  (test-end))
;>>  %%%% Starting test foo
;>>  # of expected passes      5
;>>
;=>  NIL

移植について

期待したエラーかどうかをテストするtest-errorですが、srfi-34/35あたりと組み合わさると、どういう感じになるのか良く分からなかったので使いながら修正していこうかなと思っています。
…というか仕上げる根気がなかったので放置という感じです。 ■

Older entries (1467 remaining)