#:g1

Portable Utilities for Common Lisp: USER-MANUALの紹介

Posted 2014-09-14 01:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の257日目です。

Portable Utilities for Common Lisp: USER-MANUALとはなにか

 Portable Utilities for Common Lisp: USER-MANUALは、Mark Kantrowitz氏作のCommon Lispのコードからドキュメントを生成してくれるツールです。

パッケージ情報

パッケージ名Portable Utilities for Common Lisp: USER-MANUAL
Quicklisp×
配布サイトUser Manual: Automatical User Manual Creation

インストール方法

 配布サイトからダウンロードしてロードします。ANSI CLでも特に問題なく読み込めると思います。

試してみる

 Portable Utilities for Common Lisp: USER-MANUALは、Mark Kantrowitz氏が1990年頃に立ち上げていた、Portable Utilities for Common LispというCommon Lispのユーティリティを充実させようというプロジェクトの成果物です。
やっていることといえば、ソースファイルを読み込んでドキュメンテーション文字列を抽出してまとめる、というもの。
生成するドキュメントの形式は、テキスト、Subscribe、LaTeXとなっていますが、試してみた感じでは、Scribeはサポートしているツールがないので確認できないのと、LaTeXもどうも現在のlatexコマンドでは生成されたファイルが上手く処理できないようです。
とはいえ、出力でやっていることは単純なので直したり、新しい形式に対応させたりするのは簡単かなと思います。テキスト形式で出力するとこんな感じです。

(user-manual:create-user-manual "user-manual.lisp")
;>> ;;;
;>> ;;; *USERMAN-VERSION* ("2.0 20-oct-94")                             [PARAMETER]
;>> ;;;    Current verison number/date for User-Manual.
;>> ;;;
;>> ;;; USERMAN-COPYRIGHT (&optional (stream *standard-output*))         [FUNCTION]
;>> ;;;    Prints a User Manual copyright notice and header upon startup.
;>> ;;;
;>> ;;; EXTRACT-DOCUMENTATION (body)                                        [MACRO]
;>> ;;;
;>> ;;; ATOM-OR-CAR (list-or-atom)                                       [FUNCTION]
;>> ;;;
;>> ;;; *DOCUMENTATION-HANDLERS* ((make-hash-table :test #'equal))       [VARIABLE]
;>> ;;;    Hash table of entries of the form (handler description),
;>> ;;;    where definer is the car of the definition form handled (for
;>> ;;;    example, DEFUN or DEFMACRO), handler is a function which takes the
;>> ;;;    form as input and value-returns the name, argument-list and
;>> ;;;    documentation string, and description is a one-word equivalent of
;>> ;;;    definer (for example, FUNCTION or MACRO).
;>> ;;;
;>> ;;; DEFINE-DOC-HANDLER (definer arglist description &body body)         [MACRO]
;>> ;;;    Defines a new documentation handler. DEFINER is the car of the
;>> ;;;    definition form handled (e.g., defun), DESCRIPTION is a one-word
;>> ;;;    string equivalent of definer (e.g., "function"), and ARGLIST
;>> ;;;    and BODY together define a function that takes the form as input
;>> ;;;    and value-returns the name, argument-list, documentation string,
;>> ;;;    and a list of any qualifiers of the form.
;>> ;;;
;>> ;;; FIND-DOC-HANDLER (definer)                                       [FUNCTION]
;>> ;;;    Given the car of a form, finds the appropriate documentation
;>> ;;;    handler for the form if one exists.
;>> ;;;
;>> ;;; LISTIFY (x)                                                      [FUNCTION]
;>> ;;;
;>> ;;; NULL-OR-CDR (l)                                                  [FUNCTION]
;>> ;;;
;>> ;;; NULL-OR-CADR (l)                                                 [FUNCTION]
;>> ;;;
;>> ;;; *FAILED-DEFINITION-TYPES* (nil)                                  [VARIABLE]
;>> ;;;    List of definition types that create-user-manual couldn't handle.
;>> ;;;
;>> ;;; CREATE-USER-MANUAL (filename &key (output-format :text)          [FUNCTION]
;>> ;;;                     (output-stream *standard-output*)
;>> ;;;                     (purge-latex t))
;>> ;;;    Automatically creates a user manual for the functions in a file by 
;>> ;;;    collecting the documentation strings and argument lists of the
;>> ;;;    functions and formatting the output nicely. Returns a list of the
;>> ;;;    definition types of the forms it couldn't handle. Output-format
;>> ;;;    may be either 'TEXT, 'SCRIBE or 'LATEX. In this last case the extra
;>> ;;;    keyword 'purge-latex' may be specified: if non nil the latex
;>> ;;;    filter will try to substitute possible dangerous characters like '&',
;>> ;;;    '\' and '#'.
;>> ;;;
;>> ;;; HANDLE-FORM-OUTPUT (form &optional (output-format 'text)         [FUNCTION]
;>> ;;;                     (stream *standard-output*) (purge-latex t))
;>> ;;;    This function takes a form as input and outputs its documentation
;>> ;;;    segment to the output stream.
;>> ;;;
;>> ;;; FIND-KEYWORD (sym)                                               [FUNCTION]
;>> ;;;
;>> ;;; OUTPUT-FRAME-DOCUMENTATION (name type args documentation         [FUNCTION]
;>> ;;;                             &optional
;>> ;;;                             (stream *standard-output*))
;>> ;;;    Prints out the user guide entry for a form in FrameMaker(tm) mode.
;>> ;;;
;>> ;;; OUTPUT-TEXT-DOCUMENTATION (name type args documentation          [FUNCTION]
;>> ;;;                            args-tab-pos type-pos
;>> ;;;                            &optional (stream *standard-output*))
;>> ;;;    Prints out the user guide entry for a form in TEXT mode.
;>> ;;;
;>> ;;; OUTPUT-SCRIBE-DOCUMENTATION (name type args documentation        [FUNCTION]
;>> ;;;                              &optional
;>> ;;;                              (stream *standard-output*))
;>> ;;;    Prints out the user guide entry for a form in SCRIBE mode.
;>> ;;;
;>> ;;; OUTPUT-LATEX-DOCUMENTATION (name type args documentation         [FUNCTION]
;>> ;;;                             &optional (stream *standard-output*)
;>> ;;;                             (purge-documentation t))
;>> ;;;    Prints out the user guide entry for a form in LaTeX mode.
;>> ;;;
;>> ;;; PURGE-STRING-FOR-LATEX (a-string purge-doc)                      [FUNCTION]
;>> ;;;    Tries to purge a string from characters that are potentially
;>> ;;;    dangerous for LaTeX.
;>> ;;;
;>> ;;; PREPROCESS-LAMBDA-KEYWORDS (args)                                [FUNCTION]
;>> ;;;    Unused
;>> ;;;
;>> ;;; PREPROCESS-LISP-LATEX-CLASHES (args purge-doc)                   [FUNCTION]
;>> ;;;    This function is used to make the strings for the arguments of the
;>> ;;;    form digestible for LaTeX, e.g. by removing '#' and '&'.
;>> ;;;
;>> ;;; PREPROCESS-CHARACTER (c)                                         [FUNCTION]
;>> ;;;    Low level processing of single characters, when passed as defaults
;>> ;;;    to optional, key and aux parameters.
;>> ;;;
;>> ;;; PREPROCESS-SPECIALS (list-form purge-doc)                        [FUNCTION]
;>> ;;;    Processing of some 'special' forms. Only 'quote' and 'function' are
;>> ;;;    treated for the time being.
;>> ;;;
;>> ;;; SPLIT-STRING (string width &optional arglistp filled             [FUNCTION]
;>> ;;;               (trim-whitespace t))
;>> ;;;    Splits a string into a list of strings, each of which is shorter
;>> ;;;    than the specified width. Tries to be intelligent about where to
;>> ;;;    split the string if it is an argument list. If filled is T,
;>> ;;;    tries to fill out the strings as much as possible. This function
;>> ;;;    is used to break up long argument lists nicely, and to break up
;>> ;;;    wide lines of documentation nicely.
;>> ;;;
;>> ;;; SPLIT-POINT (string max-length &optional arglistp filled)        [FUNCTION]
;>> ;;;    Finds an appropriate point to break the string at given a target
;>> ;;;    length. If arglistp is T, tries to find an intelligent position to
;>> ;;;    break the string. If filled is T, tries to fill out the string as
;>> ;;;    much as possible. 
;>> ;;;
;>> ;;; LAMBDA-LIST-KEYWORD-POSITION (string                             [FUNCTION]
;>> ;;;                               &optional end trailer-only)
;>> ;;;    If the previous symbol is a lambda-list keyword, returns
;>> ;;;    its position. Otherwise returns end.
;>> ;;;
;>> ;;; BALANCED-PARENTHESIS-POSITION (string &optional end)             [FUNCTION]
;>> ;;;    Finds the position of the left parenthesis which is closest to END
;>> ;;;    but leaves the prefix of the string with balanced parentheses or
;>> ;;;    at most 1 unbalanced left parenthesis.
;>> ;;;
;>> ;;; UM-BUILD-SYMBOL (symbol &key (prefix nil prefix-p)               [FUNCTION]
;>> ;;;                  (suffix nil suffix-p) (package nil package-p))
;>> ;;;    Build a symbol concatenating prefix (if not null), symbol, and suffix
;>> ;;;    (if not null). The newly generated symbol is interned in package, if
;>> ;;;    not null, or in the SYMBOL-PACKAGE of symbol, otherwise. 
;>> ;;;
;>> ;;; CREATE-MANUALS (files &key (extension '.cl)                      [FUNCTION]
;>> ;;;                 (output-format 'text))
;>> ;;;
;>> ;;; PARSE-WITH-DELIMITER (line &optional (delim #\newline))          [FUNCTION]
;>> ;;;    Breaks LINE into a list of strings, using DELIM as a 
;>> ;;;    breaking point.
;>> ;;;
;=> (DEFINE-DOC-HANDLER WHEN USERMAN-COPYRIGHT IN-PACKAGE)
                    

まとめ

 今回は、Portable Utilities for Common Lisp: USER-MANUALを紹介してみました。
自分が知る限りでは、Portable Utilities for Common Lispは、オープンソースなユーティリティ共有のプロジェクトとしては、最初期のものですが、CMUのAIレポジトリもこのプロジェクトのLisp ユーティリティー置き場が発展してできたもののようです。

MIT Lisp Machine: Advising a Functionの紹介

Posted 2014-09-11 23:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の255日目です。

MIT Lisp Machine: Advising a Functionとはなにか

 MIT Lisp Machine: Advising a Functionは、MIT系Lispマシンが提供していたアドバイス機構です。
ZetalispとCommon Lispでコードはほぼ同一ですが、MIT CADR、LMI LambdaはZetalispで、TI Explorerは、Common Lispで書かれているようです。なお、Symbolicsにも存在しますが、Common LispかZetalispかは不明です。
また、Allegro CLが提供する旧アドバイス機構もほぼMIT LispMのインターフェイスをそのまま実現していたようです。

パッケージ情報

パッケージ名MIT Lisp Machine: Advising a Function
LispマシンマニュアルLisp Machine Manual: 31.10 Advising a Function
Allegro CLマニュアルAllegro CL: Advice

インストール方法

 Lispマシンでは、sysパッケージで定義されていて、userパッケージから使えるようになっています。
Allegro CLではexclで定義されています。

試してみる

 前回の紹介で、大抵の処理系では、adviceで、Clozure CLでは、adviseなのがややこしいと書きましたが、どうも伝統的には、adviseだったようです。
定義構文でdefadviceのような物を多く目にしていたので、こっちが標準的かと思っていました。しかし、adviseも大抵マクロで実装されているので、命令する関数というよりは、定義フォームという感じなのですが…。

 さて、MIT Lispマシンでは、アドバイス機構は、Encapsulationsというより汎用的な仕組みの上に構築されていて、この機能を利用するものには、Advice以外にも、Traceや、Breakon等々があるようです。

 書法と動作ですが、

(defun matu (x)
  (format t ">> ~A" x)
  (terpri))

(matu 42.) ;>> >> 52

こんな感じの関数があったとすれば、

(advise matu :before :b0 0
  (format t "..before0:~%"))

(advise matu :before :b1 1 (format t "..before1:~%"))

(advise matu :after :a0 0 (format t "..after0:~%"))

(advise matu :after :a1 1 (format t "..after1:~%"))

(advise matu :around :ar0 0 (format t "==>around0:~%") :do-it (format t ">==around0:~%"))

(advise matu :around :ar1 1 (format t "==>around1:~%") :do-it (format t ">==around1:~%"))

(matu 42.) ;>> ..before0: ;>> ..before1: ;>> ==>around0: ;>> ==>around1: ;>> >> 52 ;>> >==around1: ;>> >==around0: ;>> ..after0: ;>> ..after1: ;=> NIL

こんな感じに書けます。
引数は、左から

  1. 適用する関数名
  2. :before、:after、:aroundのクラスを指定
  3. アドバイスの名前
  4. 適用する順番を指定(数値の他シンボルも可)
  5. ボディ

というところで、:aroundの場合、ボディ内で:do-itを記述することで元の関数を呼び出します。元の引数リストはarglistで参照可能。
Allegro CLの場合は、excl:defadviceというadviseをもうちょっと定義構文っぽくしたものも提供されています。

within

 Allegro CLには存在せずオリジナルのLispマシン独自の機能がadvise-withinです。

(advise (:within foo matu) :before :w//foo//b nil
  (format t "in foo: args:(~S)~%" arglist))

(advise-within foo matu :before :w//foo//b nil (format t "in foo: args:(~S)~%" arglist))

のようにadvise-withinでもadviseでも書けるのですが、上記の場合、fooがmatuを呼び出した時だけ効くアドバイスになります。
実行するとこんな感じ。

(bar 42.)
..before0:
..before1:
==>around0:
==>around1:
>> 52
>==around1:
>==around0:
..after0:
..after1:

(foo 42.) in foo:(52) ..before0: ..before1: ==>around0: ==>around1: >> 52 >==around1: >==around0: ..after0: ..after1:

 fooの内側ならどんなに階層が深くてもいけたりするのか試してみましたが、直の呼び出しでないと駄目みたいです。
withinを利用すれば、特定の関数から呼ばれた場合のみbreakするとか色々応用はできそうですが、実際のところ便利なのかどうか。
なお、マクロでも試してみましたが、定義してもエラーにはならないものの、誰から呼び出されることになるのかいまいち不明のため結果がどうなるか不明でした。

まとめ

 今回は、MIT Lisp Machine: Advising a Functionを紹介してみました。
MIT LispマシンのEncapsulations機構と、Advice機構のコードは、眺めて感じではRMSが書いてるような気がするのですが、実際のところどうなのか確かめてみたいところです。
なんとなくRMSの書法っぽいのと、妙なアイデア(:withinとか)が盛り込まれているところがRMSっぽいです。

Clozure CL: Advisingの紹介

Posted 2014-09-11 01:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の254日目です。

Clozure CL: Advisingとはなにか

 Clozure CL: Advisingは、Clozure CLが提供するアドバイス機構です。

パッケージ情報

パッケージ名Clozure CL: Advising
ドキュメントClozure CL Documentation: Advising

インストール方法

Clozure CLの標準で利用可能で、CCLパッケージで定義されていますが、cl-userでも最初から利用できるようになっています。

試してみる

 用意されているのは、

  • advise
  • unadvise
  • advisep

です。大抵は、advi*c*eですが、Clozure CLでは、advi*s*eというところが注意点です。ややこしい。
adviseはマクロで、ボディの中では、arglistで元の関数の引数リストが参照可能。また、returnでボディから抜けることも可能です。

(advise foo (if (some #'(lambda (n) (not (numberp n))) arglist)
	      (return 0))
	:when :before :name :zero-if-not-nums)

 こんな関数があったとすれば、

(defun matu (x)
  (princ x)
  (terpri))

(matu 8) ;>> 8 ;=> NIL

こんな感じで使えます。

(advise matu
        (prog2 (write-line "around0 ==>")
               (:do-it)
               (write-line "around0 <=="))
        :when :around
        :name around0)

(advise matu (prog2 (write-line "around1 ==>") (:do-it) (write-line "around1 <==")) :when :around :name around1)

(advise matu (write-line "before0:") :name before0 :when :before)

(advise matu (write-line "before1:") :when :before :name before1)

(advise matu (write-line "after0:") :when :after :name after0)

(advise matu (write-line "after1:") :when :after :name after1)

(matu 8) ;>> before1: ;>> before0: ;>> around1 ==> ;>> around0 ==> ;>> 8 ;>> around0 <== ;>> around1 <== ;>> after0: ;>> after1: ;>> ;=> NIL

 またメソッドにも適用可能です。

(defmethod bamatu (x y) t)

(defmethod bamatu ((x integer) (y list)) (list x y))

(bamatu 1 1) ;=> T

(bamatu 1 '(1 2 3)) ;=> (1 (1 2 3))

(advise (:method bamatu (integer list)) (destructuring-bind (x y) (:do-it) `(:integer ,x :list ,y)) :when :around :name type-annot)

(bamatu 1 1) ;=> T

(bamatu 1 '(1 2 3)) ;=> (:INTEGER 1 :LIST (1 2 3))

 LispWorksやAllegro CLのようにマクロには適用できませんが、マクロ展開関数に適用すれば、できないこともないですね。

(defmacro mydefun (name (&rest args) &body body)
  `(defun ,name (,@args) ,@body))

(setf (fdefinition 'mydefun-expander) (macro-function 'mydefun))

(advise mydefun-expander (destructuring-bind (def name args &body body) (first arglist) (declare (ignore def args body)) `(progn (declaim (inline ,name)) ,(:do-it))) :when :around :name inline)

(setf (macro-function 'mydefun) (fdefinition 'mydefun-expander))

(mydefun foo (n) n) ;==> (PROGN (DECLAIM (INLINE FOO)) (DEFUN FOO (N) N))

まとめ

 今回は、Clozure CL: Advisingを紹介してみました。
ここ最近Advice機能を比較している感じですが、微妙に似ていつつも微妙に違いますね。

vlc.pltの紹介

Posted 2014-09-10 00:00:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の253日目です。

vlc.pltとはなにか

 vlc.pltは、Neil Van Dyke作のVLCをRacketから操作するためのライブラリです。

パッケージ情報

パッケージ名vlc.plt
PLaneTPLaneT Package Repository : PLaneT > neil > vlc.plt

インストール方法

 Racket上から、

(require (planet neil/vlc:1:5))

でOKです。

試してみる

 VLCのRC(リモートコントロール)機能をRacketから使えるようにしたもののようです。VLCの再生関係は大体操作できます。

;; VLC起動
(start-vlc)

;; YouTubeの曲をキューに入れる (vlc-enqueue "https://www.youtube.com/watch?v=QH2-TGUlwu4")

;; 再生開始 (vlc-play)

;; タイトル取得 (vlc-get-title) ;=> "Nyan Cat [original]"

;; 止めてみる (vlc-pause)

;; 再開 (vlc-pause)

;; 特定の場所をループ (let loop ((cnt 3)) (if (zero? cnt) #f (begin (vlc-seek 31) (sleep 30) (loop (- n 1)))))

;; 現在の再生箇所 (vlc-get-time) ;=> 55

;; 再生停止 (vlc-stop)

;; VLC終了 (vlc-shutdown)

まとめ

 今回は、vlc.pltを紹介してみました。
自分は、VLCでYouTube上の音楽を再生させるのに、xspfの曲目リストをCommon Lispで生成した後にVLCで再生させていましたが、処理系から直にコントロールできた方が楽で良いですね。

isbnの紹介

Posted 2014-09-08 20:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の252日目です。

isbnとはなにか

 isbnは、ISBNをChickenで扱うためのライブラリです。isbndb.comと、openlibrary.orgに問い合わせる機能もあります。

パッケージ情報

パッケージ名isbn
Chicken eggs:isbn - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install isbn

すれば、

(use isbn)
(use isbndb)
(use openlibrary)

が使えます。

試してみる

 isbnのユーティリティとしては、(use isbn)すると、

  • isbn10->isbn13
  • isbn-type
  • normalize-isbn
  • valid-isbn?
  • isbn13->isbn10

が使えるようになります。動作としては、

(valid-isbn? "978-1555580445") 
;=> #t

(normalize-isbn "978-1555580445") ;=> "9781555580445"

(isbn13->isbn10 "9781555580445") ;=> "15555804411"

(isbn10->isbn13 "4895013634") ;=> "9784895013635" (isbn13->isbn10 "9784895013635") ;=> "4895013634" (isbn-type "4895013634") ;=> 10

というところ。

 また、isbndb.comとopenlibrary.orgに問い合せも可能ですが、利用するには、それぞれ、

(use isbndb) or (use openlibrary)

とします。
isbndbの方がどうも上手く動かないので、openlibraryので試してみましたが、動作は、

(pp (isbn->alist "978-1555580445")) 
;>> ((title . "LISP style & design")
;>>  (authors ("Molly M. Miller"))
;>>  (publisher ("Digital Press"))
;>>  (publishing-date . "1990")
;>>  (number-of-pages . 214)
;>>  (cover-urls
;>>    ("small" . "https://covers.openlibrary.org/b/id/4096488-S.jpg")
;>>    ("large" . "https://covers.openlibrary.org/b/id/4096488-L.jpg")
;>>    ("medium" . "https://covers.openlibrary.org/b/id/4096488-M.jpg"))
;>>  (isbn-numbers (("1555580440")))) 

という風にisbnからalist形式で情報が引き出せます。残念ながら日本の書籍の登録は殆ど無いようですが。

まとめ

 今回は、isbnを紹介してみました。
文献一覧などを作成する場合に便利そうですね。

pcallの紹介

Posted 2014-09-08 14:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の251日目です。

pcallとはなにか

 pcallは、Marijn Haverbeke氏作のCommon Lispの並列実行のライブラリです。

パッケージ情報

パッケージ名pcall
Quicklisp
Quickdocspcall | Quickdocs
CL Test Grid: ビルド状況pcall | CL Test Grid

インストール方法

(ql:quickload :pcall)

試してみる

 どんな関数があるかは、Quickdocsで確認できます。

 pcallはスレッドプールを利用してスレッドを管理しています。使い勝手もシンプルで使い易い感じです。

(defun fib (n)
  (if (< n 2)
      n
      (+ (fib (- n 1)) (fib (- n 2)))))

(fib 40) ;=> 102334155 #|------------------------------------------------------------| Evaluation took: 1.958 seconds of real time 2.024000 seconds of total run time (2.024000 user, 0.000000 system) 103.37% CPU 6,448,324,307 processor cycles 0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

(let ((f40 (pcall:pcall (lambda () (fib 40)))) (f39 (pcall:pcall (lambda () (fib 39)))) (f38 (pcall:pcall (lambda () (fib 38)))) (f37 (pcall:pcall (lambda () (fib 37))))) (+ (pcall:join f40) (pcall:join f39) (pcall:join f38) (pcall:join f37))) ;=> 228826127 #|------------------------------------------------------------| Evaluation took: 1.975 seconds of real time 4.504000 seconds of total run time (4.504000 user, 0.000000 system) 228.05% CPU 6,502,994,861 processor cycles 24,592 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

(pcall (lambda...の省略フォームとして、pexecがあります。

(let ((f40 (pcall:pexec (fib 40)))
      (f39 (pcall:pexec (fib 39)))
      (f38 (pcall:pexec (fib 38)))
      (f37 (pcall:pexec (fib 37))))
  (+ (pcall:join f40)
     (pcall:join f39)
     (pcall:join f38)
     (pcall:join f37)))
;=> 228826127
#|------------------------------------------------------------|
Evaluation took:
  1.968 seconds of real time
  5.072000 seconds of total run time (5.072000 user, 0.000000 system)
  257.72% CPU
  6,482,446,806 processor cycles
  33,344 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

さらに、pletというletと似た感じの並列実行のためのフォームがあります。

(pcall:plet ((f40 (fib 40))
             (f39 (fib 39))
             (f38 (fib 38))
             (f37 (fib 37)))
  (+ f40 f39 f38 f37))
;=> 228826127
#|------------------------------------------------------------|
Evaluation took:
  1.972 seconds of real time
  4.580000 seconds of total run time (4.580000 user, 0.000000 system)
  232.25% CPU
  6,495,339,957 processor cycles
  0 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

これは、symbol-macroletを利用したフォームに展開されます。

(LET ((#:F401235
       (PCALL:PEXEC
         (FIB 40)))
      (#:F391236
       (PCALL:PEXEC
         (FIB 39)))
      (#:F381237
       (PCALL:PEXEC
         (FIB 38)))
      (#:F371238
       (PCALL:PEXEC
         (FIB 37))))
  (SYMBOL-MACROLET ((F40 (PCALL:JOIN #:F401235))
                    (F39 (PCALL:JOIN #:F391236))
                    (F38 (PCALL:JOIN #:F381237))
                    (F37 (PCALL:JOIN #:F371238)))
    (+ F40 F39 F38 F37)))

 スレッドプールのサイズの取得と変更には、thread-pool-sizeを利用します。

(setf (pcall:thread-pool-size) 7)
;=>  NIL

(pcall:thread-pool-size)
;=>  7

また、局所的にスレッドプールを変更するためのwith-local-thread-poolというフォームも用意されています。

(pcall:with-local-thread-pool (:size 1)
  (pcall:plet ((f40 (fib 40))
               (f39 (fib 39))
               (f38 (fib 38))
               (f37 (fib 37))
               (f36 (fib 36))
               (f35 (fib 35))
               (f34 (fib 34)))
    (+ f40 f39 f38 f37 f36 f35 f34)))
;=> 258686831
#|------------------------------------------------------------|
Evaluation took:
  4.943 seconds of real time
  4.896000 seconds of total run time (4.896000 user, 0.000000 system)
  99.05% CPU
  16,273,648,911 processor cycles
  34,944 bytes consed

Intel(R) Xeon(R) CPU E3-1230 v3 @ 3.30GHz |------------------------------------------------------------|#

まとめ

 今回は、pcallを紹介してみました。
並列実行のライブラリも色々ありますが、pcallはシンプルにまとまっているので使い易そうですね。

yasosの紹介

Posted 2014-09-07 02:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の250日目です。

yasosとはなにか

 yasosは、Kenneth Dickey氏のyasosをJuergen Lorenz氏がChickenで動くようにしたものです。

パッケージ情報

パッケージ名yasos
Chicken eggs:yasos - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install yasos

すれば、

(use yasos)

(require-extension yasos)

試してみる

 yasosについては、Ken Dickey氏のScheming with Objectsに詳しいですが、クロージャーをオブジェクトとし、それに継承を加えてオブジェクト指向システムを構成したものです。

仕組みとしては非常にシンプルなので、これを読んだ人は自作してみたくなるかもしれません。

 ということで今回もBankAccountで比較です。

(define-predicate bank-account?)

(define-operation (dollars a))

(define-operation (set-dollars! a i))

(define-operation (deposit! a i))

(define-operation (withdraw! a i))

(define (make-bank-account #!key (the-dollars 0)) (object ((bank-account? self) #t)

((dollars self) the-dollars)

((set-dollars! self i) (set! the-dollars i) (dollars self))

((deposit! self i) (set-dollars! self (+ (dollars self) i)))

((withdraw! self i) (set-dollars! self (max 0 (- (dollars self) i))))))

(define *my-account* (make-bank-account the-dollars: 200))

(bank-account? *my-account*) ;=> #t

(dollars *my-account*) ;=> 200

(deposit! *my-account* 50) ;=> 250

(withdraw! *my-account* 100) ;=> 150

(withdraw! *my-account* 200) ;=> 0

(define-predicate stock-account?)

(define-operation (num-shares a))

(define-operation (price-per-share a))

(define (make-stock-account #!key (the-dollars 0) (the-num-shares 0) (the-price-per-share 30)) (object-with-ancestors ((ba (make-bank-account the-dollars: the-dollars)))

((stock-account? self) #t)

((dollars self) (* the-num-shares the-price-per-share))

((set-dollars! self i) (set! the-num-shares (/ i the-price-per-share)) (dollars self))

((num-shares self) the-num-shares)

((price-per-share self) the-price-per-share)))

(define *my-stock* (make-stock-account the-num-shares: 10))

(dollars *my-stock*) ;=> 300

(set-dollars! *my-stock* 600) ;=> 600

(deposit! *my-stock* 60) ;=> 660

(num-shares *my-stock*) ;=> 22

(withdraw! *my-stock* 120) ;=> 540

(num-shares *my-stock*) ;=> 18

 仕組みもシンプルで書法もシンプルです。
the-と付いているのは、名前の衝突を回避するためで、この辺はSchemeらしいといえばSchemeらしい気がします。

まとめ

 今回は、yasosを紹介してみました。
Chicken以外の処理系では、SLIB経由で導入することが多いようですが、SLIBが使えない場合でも全体で150行足らずなので移植するのは難しくなさそうです。

chicken-slimeの紹介

Posted 2014-09-05 23:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の249日目です。

chicken-slimeとはなにか

 chicken-slimeは、Emacs上のCommon Lisp開発環境でお馴染のSLIMEをChickenに対応させるもので、swankの部分がChickenで書かれ、slime側も若干のEmacs Lispが追加されています。

パッケージ情報

パッケージ名chicken-slime
Chicken eggs:slime - The Chicken Scheme wiki

インストール方法

 chicken-slimeには、chicken-docsが必要で、さらにChickenのドキュメントが必要です。
まずはchicken-docの環境の整備で

$ sudo chicken-install chicken-doc
$ sudo chicken-install chicken-doc-admin

としてchicken-docをインストールし、

$ mkdir /usr/local/share/chicken/chicken-doc

でドキュメントのリポジトリのためのディレクトリを作成し、

$ chicken-doc-admin -i
$ svn co --username anonymous --password "" http://code.call-cc.org/svn/chicken-eggs/wiki
$ chicken-doc-admin -m wiki/man/4
$ chicken-doc-admin -e wiki/eggref/4

でドキュメント環境を構築します。あとは

$ sudo chicken-install slime

とすればインストール完了です。

試してみる

 Emacs側の一番シンプルな設定は、

(add-to-list 'load-path "/usr/local/lib/chicken/6/")

(autoload 'chicken-slime "chicken-slime" "SWANK backend for Chicken" t)

(add-hook 'scheme-mode-hook (lambda () (slime-mode t)))

(setq slime-csi-path "/usr/local/bin/csi")

位のところです。
これで M-x chicken-slime でSLIMEが起動します。4005番ポートで起動するのでCommon LispでSLIMEを利用中の場合は、競合しないように調整しましょう。

 ちょっと使ってみた感想ですが、大体の関数の引数は表示されるし、簡単な補完も効くし、ドキュメントも簡単に参照できるしで結構使える感じです。対応していない大き目の機能と言えば、マクロの展開があるでしょうか。

まとめ

 今回は、chicken-slimeを紹介してみました。
思っていたより使える感じでした。しばらくChickenではSLIMEを使ってみようかなと思います。

CMUCL: fwrappersの紹介

Posted 2014-09-05 14:45:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の248日目です。

CMUCL: fwrappersとはなにか

 CMUCL: fwrappersは、CMUCLが提供する関数へのラッパー(アドバイス)機能です。

パッケージ情報

パッケージ名CMUCL: fwrappers
ドキュメントDesign Choices and Extensions: Function Wrappers

インストール方法

 CMUCL 18e以降のバージョンでは標準機能として使えます。

試してみる

 用意されているユーティリティは

  • fwrapper-type
  • fwrapper-user-data
  • fwrapper-constructor
  • push-fwrapper
  • update-fwrapper
  • funwrap
  • fwrapper-next
  • call-next-function
  • update-fwrappers
  • set-fwrappers
  • define-fwrapper
  • delete-fwrapper
  • fwrap
  • do-fwrappers
  • find-fwrapper
  • fwrapper
  • list-fwrappers
  • last-fwrapper

のようなところですが、Allegro CLのfwrapperに名前も機能も似ています。

大体のところは同じなのですが、CMUCLの場合コンパイル時とインタプリタ時での動作が微妙に違っているようです。また、スペシャル変数に関数を入れて呼び出したりしてもラッパーが効かなかったりします。

(defun bamatu (x)
  (format t "~A~%" x))

(defvar *bamatu-old* #'bamatu)

(funcall *bamatu-old* 42) ;>> 42 ;>> ;=> NIL

(fwrappers:define-fwrapper bamatu-wrapper (x) (format t "before~%") (fwrappers:call-next-function) (format t "after~%"))

(bamatu 42) ;>> 42 ;>> ;=> NIL

(fwrappers:fwrap 'bamatu 'bamatu-wrapper :type 'w1) ;=> NIL

(bamatu 42) ;>> before ;>> 42 ;>> after ;>> ;=> NIL

(fwrappers:list-fwrappers 'bamatu) ;=> (#<FWRAPPERS:FWRAPPER W1 {5927DA89}>)

(fwrappers:fwrap 'bamatu 'bamatu-wrapper :type 'w2) ;=> NIL

(bamatu 42) ;>> before ;>> before ;>> 42 ;>> after ;>> after ;>> ;=> NIL

(fwrappers:list-fwrappers 'bamatu) ;=> (#<FWRAPPERS:FWRAPPER W2 {59BC93D1}> #<FWRAPPERS:FWRAPPER W1 {5927DA89}>)

(fwrappers:funwrap 'bamatu :type 'w1) ;=> NIL

(bamatu 42) ;>> before ;>> 42 ;>> after ;>> ;=> NIL

(fwrappers:list-fwrappers 'bamatu) ;=> (#<FWRAPPERS:FWRAPPER W2 {59BC93D1}>)

(eq *bamatu-old* #'bamatu) ;=> T

(bamatu 42) ;>> before ;>> 42 ;>> after ;>> ;=> NIL

(funcall #'bamatu 42) ;>> 42 ;>> ;=> NIL

(funcall *bamatu-old* 42) ;>> 42 ;>> ;=> NIL

(defun mahalito () (funcall #'bamatu 42))

(defun mogref () (funcall *bamatu-old* 42))

(mahalito) ;>> before ;>> 42 ;>> after ;>> ;=> NIL

(mogref) ;>> 42 ;>> ;=> NIL

まとめ

 今回は、CMUCL: fwrappersを紹介してみました。
SBCLでは、encapsulateが似たような機能を提供していますが、これは、CMUCLでfwrapperより前に提供されていた機能みたいです。この辺りも調べてみたいところ。

LispWorks: Adviceの紹介

Posted 2014-09-04 14:15:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の247日目です。

LispWorks: Adviceとはなにか

 LispWorks: Adviceは、LispWorksが提供するCommon LispでAdvice機能が使える拡張です。

パッケージ情報

パッケージ名LispWorks: Advice
ドキュメンテーション 6 The Advice Facility

インストール方法

 LispWorksに標準で添付されてきます。defadviceは、lispworks(lw)パッケージに属していますが、cl-userからも使えるようになっています。

試してみる

(matu 8)
;>> >>8<<
;=> NIL
           

のような関数があったとすると、before、after、aroundを全部付けた関数は、

(defadvice (matu around0 :around) (n)
  (prog2 (write-line "around0 ==>")
         (call-next-advice n)
         (write-line "around0 <==")))

(defadvice (matu around1 :around) (n) (prog2 (write-line "around1 ==>") (call-next-advice n) (write-line "around1 <==")))

(defadvice (matu before0 :before) (n) (write-line "before0:"))

(defadvice (matu before1 :before) (n) (write-line "before1:"))

(defadvice (matu after0 :after) (n) (write-line "after0:"))

(defadvice (matu after1 :after) (n) (write-line "after1:"))

(matu 8) ;>> around1 ==> ;>> around0 ==> ;>> before1: ;>> before0: ;>> >>8<< ;>> after0: ;>> after1: ;>> around0 <== ;>> around1 <== ;=> NIL

こんな感じの動作になります。
後で追加したものの方がより外側に適用されますが、aroundではcall-next-adviceを使って本体を呼び出すことになります。大体のところはCLOSの標準のメソッド結合と同じ感覚ですね。

 Adviceの削除には、delete-adviceとremove-adviceがありますが、delete-adviceだとクォートがいりません。

(delete-advice matu after1)

 defadviceはマクロとメソッドにも使えて、マクロだと展開をフックすることになり、

(defmacro mydefun (name (&rest args) &body body)
  `(defun ,name (,@args) ,@body))

(defadvice (mydefun inline :around) (form env) (destructuring-bind (def name args &body body) form (declare (ignore def args body)) `(progn (declaim (inline ,name)) ,(call-next-advice form env))))

(mydefun foo (n) n) ;===> (PROGN (DECLAIM (INLINE FOO)) (DEFUN FOO (N) N))

メソッドの方は、どれに特定化するかを指定可能です。

(defmethod bamatu (x y) t)

(defmethod bamatu ((x integer) (y list)) (list x y))

(bamatu 1 1) ;=> T

(bamatu 1 '(1 2 3)) ;=> (1 (1 2 3))

(defadvice ((method bamatu (integer list)) type-annot :around) (x y) (destructuring-bind (x y) (call-next-advice x y) `(:integer ,x :list ,y)))

(bamatu 1 1) ;=> T

(bamatu 1 '(1 2 3)) ;=> (:INTEGER 1 :LIST (1 2 3))

まとめ

 今回は、LispWorks: Adviceを紹介してみました。
Advice機構は古の1970年代のINTERLISPから存在しますが、一度、歴代のAdvice機構をサポートする処理系を並べて比較してみたいところです。

Older entries (223 remaining)