#:g1: frontpage

 

clawkの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の265日目です。

clawkとはなにか

 clawkは、Kenneth Michael Parker氏作のCommon Lisp上でawkのような操作を実現するライブラリです。

パッケージ情報

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

インストール方法

(ql:quickload :clawk)

試してみる

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

 プログラミング言語AWKの初っ端にある例ですが、こんなファイル(名前 時給 労働時間)があったとして

Beth    4.00    0
Dan     3.75    0
Kathy   4.00    10
Mark    5.00    20
Mary    5.50    22
Suzie   4.25    18

これの人数、支払いの合計、支払いの平均を集計するにはawkだと、

{ pay = pay + $2 * $3 }
END { print NR, "employees"
      print "total pay is", pay
      print "average pay is", pay/NR
    }

みたいな感じですが、ファイルを開くのを含めて同じようなものを書くとCommon Lispでは、

(with-open-file (in "/tmp/emp.data")
  (let ((employees 0)
        (pay 0))
    (loop :for line := (read-line in nil) :while line
          :do (incf employees)
              (destructuring-bind (name w h) 
                                  (ppcre:split "\\s+" line)
                (declare (ignore name))
                (incf pay (* (read-from-string w)
                             (read-from-string h)))))
    (format t "~A employees~%" employees)
    (format t "total pay is ~A~%" pay)
    (format t "average pay is ~A~%" (/ pay employees))))
;>>  6 employees
;>>  total pay is 337.5
;>>  average pay is 56.25
;>>  
;=>  NIL

こんな感じです。
これを、clawkを使って書くと

(let ((pay 0) (employees 0))
  (for-file-fields ("/tmp/emp.data" (name w h))
    (declare (ignore name))
    (incf pay ($* w h))
    (incf employees))
  (format t "~A employees~%" employees)
  (format t "total pay is ~A~%" pay)
  (format t "average pay is ~A~%" (/ pay employees)))
;>>  6 employees
;>>  total pay is 337.5
;>>  average pay is 56.25
;>>  
;=>  NIL

とまあawkっぽく書けます。

CL上でawk風の記述を支援するユーティリティ

 便利に使えるユーティリティ関数が定義されていて、CLとawkが融合したような感じで書けます。

(for-file-fields ("/tmp/emp.data")
  ($print $3 $2 $1 " :" *nf*))
;>>  
;>>  0 4.00 Beth  : 3 
;>>  0 3.75 Dan  : 3 
;>>  10 4.00 Kathy  : 3 
;>>  20 5.00 Mark  : 3 
;>>  22 5.50 Mary  : 3 
;>>  18 4.25 Suzie  : 3 
;=>  NIL

 awkのプログラムだと、BEGIN、本体、ENDという構成がありますが、

(defawk foo ()
  (begin ($print "begin!"))
  (t ($print $3 $2 $1 " :" *nf*))
  (end ($print "end!")))


(with-input-from-string (s (format nil "foo~%bar~%baz"))
  (foo s))
;>>  
;>>  begin! 
;>>    foo  : 1 
;>>    bar  : 1 
;>>    baz  : 1 
;>>  end! 
;=>  NIL

という感じに記述もできます。

 また、正規表現用にリーダーマクロが定義されていて、#/.../で記述することが可能です。

(*:defreadtable :awk
  (:merge :standard)
  (:dispatch-macro-char #\# #\` #'clawk::|#`-reader|)
  (:dispatch-macro-char #\# #\/ #'clawk::|#/-reader|)
  (:case :upcase))


(*:in-readtable :awk)


(for-file-fields ("/tmp/emp.data")
  (match-when
   (#/th/
    ($print $3 $2 $1 " :" *nf*))))
;>>  
;>>  0 4.00 Beth  : 3 
;>>  10 4.00 Kathy  : 3 
;=>  NIL

 さらに、#`...`でシェルコマンドを実行した結果を処理できるようですが、どうもコードを追加しないとLispWorksでしか動かないようです。

(for-stream-lines (#`ls /tmp/`)
  ($print *FNR* " " $0))

まとめ

 今回は、clawkを紹介してみました。
素直にawkを使えば良いんじゃないのかという話もありますが、ソースを眺めると、#+Generaという記述があるように元々はSymbolicsのLispマシン上でawk的なことをやりたかった、という記事をどっかで読んだ記憶があります。

INTERLISP: Advisingの紹介

Posted 2014-09-21 12:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の264日目です。

INTERLISP: Advisingとはなにか

 INTERLISP: Advisingは、INTERLISPのアドバイス機構です。

パッケージ情報

参考マニュアルInterlisp Reference Manual(1974)

インストール方法

 INTERLISP-10や、Interlisp-Dでは標準の機能です。

試してみる

 アドバイス機構を紹介するのも何回目かという感じですが、今回は、元祖INTERLISPのアドバイスの紹介です。
どうも本当の元祖は、INTERLISPに先行するBBN-LISPみたいですが、1966-1972年のマニュアルでは記載を見付けられなかったので1974年のINTERLISPで確認しました。
試した環境は、pdp-10で稼動するINTERLISP-10です。
REPLを開くとHiと挨拶をしてくれる処理系です(Xmasメッセージもあり)

 さて機能ですが、こんな感じの関数があったとすれば、

(DEFINEQ (matu (X)
           (PRIN1 '>>)
           (SPACES 1)
           (PRIN1 X)
           (TERPRI)))


(matu 8)
;>> >> 8
(ADVISE 'matu 'BEFORE '(PROGN
                        (PRIN1 '..before0:)
                        (TERPRI)))


(ADVISE 'matu 'BEFORE
        '(PROGN
          (PRIN1 '..before0:)
          (TERPRI)))


(advise 'matu '(PROGN
                (PRIN1 '..before1:)
                (TERPRI)))


(advise 'matu
        'AFTER
        '(PROGN
          (PRIN1 '..after0:)
          (TERPRI)))


(ADVISE 'matu
        'AFTER
        '(PROGN
          (PRIN1 '..after1:)
          (TERPRI)))


(ADVISE 'matu
        'AROUND
        '(PROGN
          (PRIN1 '==>around0:)
          (TERPRI)
          *
          (PRIN1 '>==around0:)
          (TERPRI)))


(ADVISE 'matu
        'AROUND
        '(PROGN
          (PRIN1 '==>around1:)
          (TERPRI)
          *
          (PRIN1 '>==around1:)
          (TERPRI)))

こんな感じにアドバイスをつけると、

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

こんな感じになります。
上記では、アドバイスの順番を指定していないですが、指定しない場合は、後に追加になります。
これは、(first top)/(last bottom end)で前後を指定可能になっています。

(DEFINEQ (zzz () (PRINT 'zzz)))

(ADVISE 'zzz 'BEFORE 'TOP '(PRINT 'hello1))
(ADVISE 'zzz 'BEFORE 'TOP '(PRINT 'hello2))

(zzz)
;>> hello2
;>> hello1
;>> zzz
;=> zzz

 面白いのが、関数内の関数にもアドバイスがかけられることで、

(DEFINEQ
  (foo () (PRIN1 'foo) (TERPRI))
  (bar () (PRIN1 'bar)(TERPRI))
  (baz () (PRIN1 'baz)(TERPRI))
  (makanito () (foo) (bar) (baz)))

 こんな感じの定義がある場合、

(ADVISE '((foo baz) IN makanito)
        'AROUND '(PROGN
                  (PRIN1 '>>)
                  (TERPRI)
                  *
                  (PRIN1 '<<)
                  (TERPRI)))

という定義で

(makanito)
;>> >>
;>> foo
;>> <<
;>> bar
;>> >>
;>> baz
;>> <<
;=> NIL

makanito内のfooとbazにアドバイスをかけることができます。
アドバイスの削除は、unadviseで、削除します。

(unadvise 'zzz)

まとめ

 今回は、INTERLISP: Advisingを紹介してみました。
上記のコード例を見てINTERLISPは標準状態の入力時でCommon Lispのようにcaseの変換をしないのに気付いたでしょうか。
大文字小文字はそのまま反映されるため標準関数は大文字で入力する必要があるということで、Common Lispでいうリードテーブルを:preserveモードにした時の挙動と同じということなんですが、一々大文字で入力しなくてもDWIM機能で対話的に修正してくれます(といっても面倒臭いですが)。
ただし、BEFORE、AFTER等の識別子は、DWIM機能が働いてくれなかったりするので気をつける必要があるみたいです。

Clozure CL: Static Variablesの紹介

Posted 2014-09-19 12:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の262日目です。

Clozure CL: Static Variablesとはなにか

 Clozure CL: Static Variablesは、Clozure CLの機能でスレッドの違いによらないグローバルな変数を実現するものです。

パッケージ情報

パッケージ名Clozure CL: Static Variables
参考サイトClozure CL: 4.8. Static Variables

インストール方法

 Clozure CL標準で提供されていて、CCLパッケージ内で定義されています。シンボルはエクスポートされていますが、cl-userには標準状態でインポートされています。

試してみる

 Clozure CLでのStatic Variableの定義は、スレッド間でも共通のグローバル変数で、束縛構文による束縛は禁止で代入しかできない変数です。
他の処理系だとLispマシンの時代から、大体defglobalとか、なんとか-globallyという名前で提供されています。

 提供されている機能は、マニュアルによるとdefstaticのみですが、兄弟にdefstaticvarというものもあるようです。
これらは、defparameterとdefvarの関係で、destaticvarの方がdefvarにあたります。

(defstatic **foo** 42)


(let ((**foo** 8))
  **foo**)
;!> **FOO** is declared static and can not be bound


(setq **foo** 8)
;=>  8


(defvar **bar** 42)


(defstaticvar **bar** 84)


**bar**
;=>  42

 defstaticvarではdefvarのでの宣言のように未束縛のままにしておくというのができないのが謎ですが、何か理由があるのでしょうか。
ちなみに、処理系の実装を眺める限りでは、未束縛のStatic Variableは作ろうと思えば作れるようです。

(defvar **baz**)

(ccl::%symbol-bits '**baz** 20)         ;20は、Static Variableのフラグ


(boundp '**baz**)
;=>  NIL


(let ((**baz** 42))
  **baz**)
;!> **BAZ** is declared static and can not be bound

まとめ

 今回は、Clozure CL: Static Variablesを紹介してみました。
Lispマシンにあった機能が脈々と受け継がれていたり、浮上してきたりするのは面白いところですね。

srfi-4-comprehensionsの紹介

Posted 2014-09-18 07:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の261日目です。

srfi-4-comprehensionsとはなにか

 srfi-4-comprehensionsは、Sebastian Egner氏作の単一型のベクタをSRFI 42で扱えるようにするためのライブラリです。

パッケージ情報

パッケージ名srfi-4-comprehensions
Chicken eggs:srfi-4-comprehensions - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install srfi-4-comprehensions

すれば、

(use srfi-42 srfi-4-comprehensions)

で使えます。

試してみる

 srfi-4-comprehensionsで拡張されているのは、vector-ecと、vector-of-length-ecです。
これらの動作は

(vector-ec (: e '#(1 2 3 4 5)) (* 2 e))
;=> #(2 4 6 8 10)


(vector-of-length-ec 5 (: e '#(1 2 3 4 5)) (* 2 e))
;=> #(2 4 6 8 10)

みたいな感じですが、これらがそれぞれ、

  • s8vector
  • u8vector
  • s16vector
  • u16vector
  • s32vector
  • u32vector
  • s64vector
  • u64vector
  • f64vector
  • f32vector

の型ごとに定義されています。
動作は下記のようなところですが、vector-なんとか-ec のvectorは返り値の型のことなので、標準で定義されていないlistやvector以外は、入力でも別途指定する必要があります。

(u8vector-ec (: e '#(1 2 3 4 5)) (* 2 e))
;=> #u8(2 4 6 8 10)


(u8vector-ec (:u8vector e '#u8(1 2 3 4 5)) (* 2 e))
;=> #u8(2 4 6 8 10)


(let* ((vec '#u8(1 2 3 4 5))
       (len (u8vector-length vec)))
  (u8vector-of-length-ec len (:u8vector e vec) (* 2 e)))
;=> #u8(2 4 6 8 10)

 ちなみに、vector-ecとvector-of-length-ecの違いですが、前者がリストに出力してからベクタに変換するのに対して、後者は長さが与えられているのでベクタを作成して埋めていくので効率が良い、というところみたいです。

まとめ

 今回は、srfi-4-comprehensionsを紹介してみました。
型ごとに関数が別だと分かり易い反面、面倒臭いですね。

cartesian-product-switchの紹介

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

(LISP Library 365参加エントリ)

 LISP Library 365 の260日目です。

cartesian-product-switchとはなにか

 cartesian-product-switchは、HexstreamことJean-Philippe Paradis氏のデカルト積的な分岐をする構文のライブラリです。

パッケージ情報

パッケージ名cartesian-product-switch
Quicklisp
プロジェクトサイトcartesian-product-switch: Hexstreamsoft
CLiKiCLiki: cartesian-product-switch
Quickdocscartesian-product-switch | Quickdocs
CL Test Grid: ビルド状況cartesian-product-switch | CL Test Grid

インストール方法

(ql:quickload :cartesian-product-switch)

試してみる

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

 名前からして大体想像が付く感じですが、こんな感じのマクロです。

(let ((x 1) (y 2) (z 3))
  (cp-switch:cartesian-product-switch ((case x 1 2 3)
                                       (case y 1 2 3)
                                       (case z 1 2 3))
    0 1 2
    3 4 5
    6 7 8

    9 10 11
    12 13 14
    15 16 17

    18 19 20
    21 22 23
    24 25 26
    (t (error "~x = A, y = ~A, z = ~A" x y z))))
;=>  5

これは、こんな感じに展開されます。

(BLOCK #:CARTESIAN-PRODUCT-SWITCH1424
  (TAGBODY
    (RETURN-FROM #:CARTESIAN-PRODUCT-SWITCH1424
      (ECASE
          (+ (* 9 (OR (CASE X (1 0) (2 1) (3 2)) (GO #:ELSE1425)))
             (* 3 (OR (CASE Y (1 0) (2 1) (3 2)) (GO #:ELSE1425)))
             (* 1 (OR (CASE Z (1 0) (2 1) (3 2)) (GO #:ELSE1425))))
        (0 0)
        (1 1)
        (2 2)
        (3 3)
        (4 4)
        (5 5)
        (6 6)
        (7 7)
        (8 8)
        (9 9)
        (10 10)
        (11 11)
        (12 12)
        (13 13)
        (14 14)
        (15 15)
        (16 16)
        (17 17)
        (18 18)
        (19 19)
        (20 20)
        (21 21)
        (22 22)
        (23 23)
        (24 24)
        (25 25)
        (26 26)))
   #:ELSE1425
    (RETURN-FROM #:CARTESIAN-PRODUCT-SWITCH1424
      (PROGN (ERROR "~x = A, y = ~A, z = ~A" X Y Z)))))

このcaseの部分を書き換えることによって他の構文もサポートしていますが、標準では

  • case
  • ccase
  • ecase
  • typecase
  • ctypecase
  • etypecase
  • if
  • cond
  • svref

がサポートされています。cp-switch:defineによってユーザーが定義することも可能とのこと。

まとめ

 今回は、cartesian-product-switchを紹介してみました。
一発物は紹介が楽で良いです。

serapeumの紹介

Posted 2014-09-16 14:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の259日目です。

serapeumとはなにか

 serapeumは、Paul M. Rodriguez氏作のユーティリティ集ですがAlexandriaと併用して使うことを意図しているものだそうです。

パッケージ情報

パッケージ名serapeum
Quicklisp
QuickdocsQuickdocs

インストール方法

(ql:quickload :serapeum)

試してみる

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

 定義されているユーティリティは下記のように結構沢山あります。
これらのシンボルは、alexandriaとは競合しないものが選択されているとのことで、一緒に:use :alexandria :serapeum できるとのことです。
リファレンスがあるので詳細はそちらを参照のこと。

  • *hook*
  • ->
  • @
  • add-hook
  • and-let*
  • append1
  • array-index-row-major
  • assocadr
  • assocdr
  • assort
  • batches
  • bcond
  • bestn
  • bits
  • blankp
  • bound-value
  • box
  • build-path
  • callf
  • callf2
  • car-safe
  • case-let
  • case-using
  • cdr-safe
  • check-the
  • class-name-safe
  • clear-queue
  • collapse-whitespace
  • collecting
  • comment
  • concat
  • cond-every
  • cond-let
  • date-leap-year-p
  • def
  • defalias
  • defcondition
  • defconst
  • defplace
  • defsubst
  • delete-file-if-exists
  • delq
  • deltas
  • deq
  • dict
  • dict*
  • distinct
  • drop
  • dsu-sort
  • dynamic-closure
  • ecase-let
  • econd
  • econd-failure
  • econd-let
  • efface
  • ellipsize
  • enq
  • ensure
  • ensure2
  • escape
  • eval-and-compile
  • example
  • expand-declaration
  • expand-macro
  • expand-macro-recursively
  • extrema
  • fbind
  • fbind*
  • fbindrec
  • fbindrec*
  • fdec
  • file-size
  • file=
  • filter
  • filter-map
  • finc
  • find-class-safe
  • find-keyword
  • firstn
  • flip
  • flip-hash-table
  • fmt
  • frequencies
  • front
  • gcp
  • gcs
  • get-unix-time
  • grow
  • growf
  • halves
  • hash-fold
  • hash-table-set
  • href
  • href-default
  • ignoring
  • in
  • inconsistent-graph
  • inconsistent-graph-constraints
  • intersperse
  • interval
  • invalid-number
  • invalid-number-reason
  • invalid-number-value
  • juxt
  • keep
  • leaf-map
  • leaf-walk
  • length<
  • length<=
  • length>
  • length>=
  • letrec
  • letrec*
  • letrec-restriction-violation
  • lines
  • longer
  • longest
  • lret
  • lret*
  • make
  • make-octet-vector
  • map-tree
  • mapcar-into
  • mapconcat
  • maphash-return
  • mapply
  • maybe-invoke-restart
  • memq
  • merge-tables
  • monitor
  • mvlet
  • mvlet*
  • nix
  • nlet
  • no
  • nor
  • nstring-invert-case
  • nstring-upcase-initials
  • nsubseq
  • nth-arg
  • nthrest
  • nub
  • occurs
  • occurs-if
  • octet
  • octet-vector
  • octet-vector-p
  • octets
  • op
  • ordering
  • parse-declarations
  • parse-float
  • parse-number
  • parse-positive-real-number
  • parse-real-number
  • partition
  • partition-declarations
  • partitions
  • plist-keys
  • plist-values
  • pop-assoc
  • pophash
  • powerset
  • prune
  • prune-if
  • qconc
  • qlen
  • qlist
  • queue
  • queue-empty-p
  • queuep
  • random-in-range
  • rassocar
  • remove-hook
  • round-to
  • run-hook-with-args
  • run-hook-with-args-until-failure
  • run-hook-with-args-until-success
  • run-hooks
  • runs
  • scan
  • select
  • selector
  • set-hash-table
  • shrink
  • shrinkf
  • single
  • slice
  • special-variable-p
  • split-sequence
  • split-sequence-if
  • split-sequence-if-not
  • standard/context
  • string$=
  • string*=
  • string-case
  • string-containsp
  • string-ecase
  • string-gensym
  • string-invert-case
  • string-prefixp
  • string-replace-all
  • string-suffixp
  • string-tokenp
  • string-upcase-initials
  • string^=
  • string~=
  • summing
  • swaphash
  • synchronized
  • take
  • throttle
  • time-since
  • time-until
  • tokens
  • toposort
  • trim-whitespace
  • unbits
  • unbox
  • undisplace-array
  • universal-to-unix
  • unix-to-universal
  • unoctets
  • unsplice
  • vect
  • vector=
  • walk-tree
  • whitespace
  • whitespacep
  • with-string
  • with-thunk
  • with-timing
  • words
  • write-stream-into-file
  • ~>
  • ~>>

 この中でfbindというのが面白そうなので、ちょっと試してみました。
これは(setf fdefinition)のローカル版という感じですが、LISP-2だとこれを実現するのはなかなか厄介です。
とりあえず、こんな感じで書けます。

(serapeum:fbind ((add1 (lambda (n) (+ 1 n))))
  (add1 8))
;=>  9


(serapeum:fbind ((add1 #'1+))
  (add1 8))
;=>  9

それぞれ

;==>
(LET ()
  (LET ()
    (FLET ((ADD1 (N)
             (+ 1 N)))
      (ADD1 8))))

;==>
(LET ()
  (LET ((#:ADD11318 (ALEXANDRIA:ENSURE-FUNCTION #'1+)))
    (DECLARE (FUNCTION #:ADD11318))
    (FLET ((ADD1 (&REST SERAPEUM::ARGS)
             (DECLARE (DYNAMIC-EXTENT SERAPEUM::ARGS))
             (APPLY #:ADD11318 SERAPEUM::ARGS)))
      (ADD1 8))))

こんな感じに展開されますが、fletに展開されるようです。
後者は、関数の情報を元に展開している訳ではないので、可変長引数として扱う他ないのかなと思いますが、やはりこういうのは処理系内部の機能を使わない限り効率の良いものを作るのは難しそうです。
とはいえ、前者のようにfletにきっちり嵌ると、

; disassembly for LATUMAPIC (assembled 11 bytes)
;        MOV EDX, 18                      ; no-arg-parsing entry point
;        MOV RSP, RBP
;        CLC
;        POP RBP
;        RET

のように定数を返す関数というところまで畳みこめたりはするようです。

まとめ

 今回は、serapeumを紹介してみました。
メジャーなユーティリティライブラリと併用する、というのはなかなか新しいスタイルですね。

foof-loopの紹介

Posted 2014-09-15 13:30:00 GMT

(LISP Library 365参加エントリ)

 LISP Library 365 の258日目です。

foof-loopとはなにか

 foof-loopは、Taylor R. Campbell氏作の繰り返し構文のマクロで、Chickenに移植されたものです。

パッケージ情報

パッケージ名foof-loop
Chicken eggs:foof-loop: A Simple, Extensible Scheme Looping Facility - The Chicken Scheme wiki

インストール方法

$ sudo chicken-install foof-loop

すれば、

(use foof-loop)

で使えます。

試してみる

 Common LispのLOOPとnamed letとdoを足したような構文ですが、(末尾再帰でない)再帰で書いたり

(define (mapcar fn list)
  (loop rec ((for e (in-list list)))
        => '()
        (cons (fn e) (rec))))

お馴染のconsしてreverse!で書いたり、

(define (mapcar fn list)
  (loop ((for e (in-list list))
         (with ans '() (cons (fn e) ans)))
        => (reverse! ans)))

累積用の構文を使ったり

(define (mapcar fn list)
  (loop ((for e (in-list list))
         (for ans (listing (fn e))))
        => ans))

と色々できます。

 作者による詳しいドキュメンテーションとScheme48 Iterate、SRFI 42、Named let、DOとの比較があるので、詳しくはそちらを参照して下さい。

まとめ

 今回は、foof-loopを紹介してみました。
SRFI 42もCommon LispのLOOPっぽいですが、これもなかなかですね。

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機能を比較している感じですが、微妙に似ていつつも微妙に違いますね。

Older entries (1780 remaining)